parameterize version scopes with phantom types (#1026)

* parameterize version scopes with phantom types

* move Version to another module

* parens

src/Simplex/RemoteControl/Client.hs

@@ -68,12 +68,6 @@ import Simplex.RemoteControl.Types
 import UnliftIO
 import UnliftIO.Concurrent
 
-currentRCVersion :: Version
-currentRCVersion = 1
-
-supportedRCVRange :: VersionRange
-supportedRCVRange = mkVersionRange 1 currentRCVersion
-
 xrcpBlockSize :: Int
 xrcpBlockSize = 16384
 
@@ -181,7 +175,7 @@ connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ct
               { ca = certFingerprint caCert,
                 host,
                 port = fromIntegral portNum,
-                v = supportedRCVRange,
+                v = supportedRCPVRange,
                 app = ctrlAppInfo,
                 ts,
                 skey = fst sessKeys,
@@ -220,7 +214,7 @@ prepareHostSession
     unless (ca == tlsHostFingerprint) $ throwError RCEIdentity
     (kemCiphertext, kemSharedKey) <- liftIO $ sntrup761Enc drg kemPubKey
     let hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey
-    unless (isCompatible v supportedRCVRange) $ throwError RCEVersion
+    unless (isCompatible v supportedRCPVRange) $ throwError RCEVersion
     let keys = HostSessKeys {hybridKey, idPrivKey, sessPrivKey}
     knownHost' <- updateKnownHost ca dhPubKey
     let ctrlHello = RCCtrlHello {}
@@ -334,7 +328,7 @@ prepareHostHello
   RCInvitation {v, dh = dhPubKey}
   hostAppInfo = do
     logDebug "Preparing session"
-    case compatibleVersion v supportedRCVRange of
+    case compatibleVersion v supportedRCPVRange of
       Nothing -> throwError RCEVersion
       Just (Compatible v') -> do
         nonce <- liftIO . atomically $ C.randomCbNonce drg

src/Simplex/RemoteControl/Invitation.hs

@@ -27,7 +27,7 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Transport.Client (TransportHost)
-import Simplex.Messaging.Version (VersionRange)
+import Simplex.RemoteControl.Types (VersionRangeRCP)
 
 data RCInvitation = RCInvitation
   { -- | CA TLS certificate fingerprint of the controller.
@@ -37,7 +37,7 @@ data RCInvitation = RCInvitation
     host :: TransportHost,
     port :: Word16,
     -- | Supported version range for remote control protocol
-    v :: VersionRange,
+    v :: VersionRangeRCP,
     -- | Application information
     app :: J.Value,
     -- | Session start time in seconds since epoch

src/Simplex/RemoteControl/Types.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -17,6 +18,7 @@ import Data.ByteString (ByteString)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
+import Data.Word (Word16)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.SNTRUP761
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings
@@ -26,7 +28,8 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport (TLS)
 import Simplex.Messaging.Transport.Client (TransportHost)
 import Simplex.Messaging.Util (safeDecodeUtf8)
-import Simplex.Messaging.Version (Version, VersionRange, mkVersionRange)
+import Simplex.Messaging.Version (VersionRange, VersionScope, mkVersionRange)
+import Simplex.Messaging.Version.Internal
 import UnliftIO
 
 data RCErrorType
@@ -92,24 +95,37 @@ instance StrEncoding RCErrorType where
 
 -- * Discovery
 
-ipProbeVersionRange :: VersionRange
-ipProbeVersionRange = mkVersionRange 1 1
+data RCPVersion
+
+instance VersionScope RCPVersion
+
+type VersionRCP = Version RCPVersion
+
+type VersionRangeRCP = VersionRange RCPVersion
+
+pattern VersionRCP :: Word16 -> VersionRCP
+pattern VersionRCP v = Version v
+
+currentRCPVersion :: VersionRCP
+currentRCPVersion = VersionRCP 1
+
+supportedRCPVRange :: VersionRangeRCP
+supportedRCPVRange = mkVersionRange (VersionRCP 1) currentRCPVersion
 
 data IpProbe = IpProbe
-  { versionRange :: VersionRange,
+  { versionRange :: VersionRangeRCP,
     randomNonce :: ByteString
   }
   deriving (Show)
 
 instance Encoding IpProbe where
   smpEncode IpProbe {versionRange, randomNonce} = smpEncode (versionRange, 'I', randomNonce)
-
   smpP = IpProbe <$> (smpP <* "I") *> smpP
 
 -- * Session
 
 data RCHostHello = RCHostHello
-  { v :: Version,
+  { v :: VersionRCP,
     ca :: C.KeyHash,
     app :: J.Value,
     kem :: KEMPublicKey