extract authenticator to Crypto module

src/Simplex/FileTransfer/Server.hs

@@ -48,7 +48,7 @@ import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (CorrId, RcvPublicDhKey, RcvPublicAuthKey, RecipientId, TransmissionAuth)
-import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdSignature)
+import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.Transport.Buffer (trimCR)
@@ -266,7 +266,7 @@ verifyXFTPTransmission tAuth authorized fId cmd =
           Right (fr, k) -> XFTPReqCmd fId fr cmd `verifyWith` k
           _ -> dummyVerifyCmd Nothing authorized tAuth `seq` VRFailed
     -- TODO verify with DH authorization
-    req `verifyWith` k = if verifyCmdSignature Nothing tAuth authorized k then VRVerified req else VRFailed
+    req `verifyWith` k = if verifyCmdAuthorization Nothing tAuth authorized k then VRVerified req else VRFailed
 
 processXFTPRequest :: HTTP2Body -> XFTPRequest -> M (FileResponse, Maybe ServerFile)
 processXFTPRequest HTTP2Body {bodyPart} = \case

src/Simplex/Messaging/Client.hs

@@ -720,18 +720,18 @@ mkTransmission ProtocolClient {sessionId, thVersion = v, thAuth, client_ = PClie
 
 authTransmission :: Maybe THandleAuth -> Maybe C.APrivateAuthKey -> CorrId -> ByteString -> Either TransportError SentRawTransmission
 authTransmission thAuth pKey_ (CorrId corrId) t = case pKey_ of
-  Nothing -> Right (TAuthNone, t)
-  Just pKey -> (,t) <$> authorize pKey
+  Nothing -> Right (TANone, t)
+  Just pKey -> (,t) <$> authenticate pKey
   where
-    authorize :: C.APrivateAuthKey -> Either TransportError TransmissionAuth
-    authorize (C.APrivateAuthKey a pk) = case a of
+    authenticate :: C.APrivateAuthKey -> Either TransportError TransmissionAuth
+    authenticate (C.APrivateAuthKey a pk) = case a of
       C.SX25519 -> case thAuth of
-        Just THandleAuth {peerPubKey} -> Right $ TAuthEncHash $ C.cbEncryptNoPad (C.dh' peerPubKey pk) (C.cbNonce corrId) (C.sha512Hash t)
+        Just THandleAuth {peerPubKey} -> Right $ TAAuthenticator $ C.cbAuthenticate peerPubKey pk (C.cbNonce corrId) t
         Nothing -> Left TENoServerAuth
       C.SEd25519 -> sign pk
       C.SEd448 -> sign pk
     sign :: forall a. (C.AlgorithmI a, C.SignatureAlgorithm a) => C.PrivateKey a -> Either TransportError TransmissionAuth
-    sign pk = Right $ TAuthSignature $ C.ASignature (C.sAlgorithm @a) (C.sign' pk t)
+    sign pk = Right $ TASignature $ C.ASignature (C.sAlgorithm @a) (C.sign' pk t)
 
 $(J.deriveJSON (enumJSON $ dropPrefix "HM") ''HostMode)
 

src/Simplex/Messaging/Crypto.hs

@@ -97,6 +97,12 @@ module Simplex.Messaging.Crypto
     verify',
     validSignatureSize,
 
+    -- * crypto_box authenticator, as discussed in https://groups.google.com/g/sci.crypt/c/73yb5a9pz2Y/m/LNgRO7IYXOwJ
+    CbAuthenticator (..),
+    cbAuthenticatorSize,
+    cbAuthenticate,
+    cbVerify,
+
     -- * DH derivation
     dh',
     dhBytes',
@@ -181,7 +187,7 @@ import Crypto.Cipher.AES (AES256)
 import qualified Crypto.Cipher.Types as AES
 import qualified Crypto.Cipher.XSalsa as XSalsa
 import qualified Crypto.Error as CE
-import Crypto.Hash (Digest, SHA256 (..), SHA512, hash)
+import Crypto.Hash (Digest, SHA256 (..), SHA512 (..), hash, hashDigestSize)
 import qualified Crypto.MAC.Poly1305 as Poly1305
 import qualified Crypto.PubKey.Curve25519 as X25519
 import qualified Crypto.PubKey.Curve448 as X448
@@ -1231,6 +1237,20 @@ sbDecryptNoPad_ secret (CbNonce nonce) packet
     (rs, msg) = xSalsa20 secret nonce c
     tag = Poly1305.auth rs c
 
+-- type for authentication scheme using NaCl @crypto_box@ over the sha512 digest of the message.
+newtype CbAuthenticator = CbAuthenticator ByteString deriving (Eq, Show)
+
+cbAuthenticatorSize :: Int
+cbAuthenticatorSize = hashDigestSize SHA512 + authTagSize -- 64 + 16 = 80 bytes
+
+-- create crypto_box authenticator for a message.
+cbAuthenticate :: PublicKeyX25519 -> PrivateKeyX25519 -> CbNonce -> ByteString -> CbAuthenticator
+cbAuthenticate k pk nonce msg = CbAuthenticator $ cbEncryptNoPad (dh' k pk) nonce (sha512Hash msg)
+
+-- verify crypto_box authenticator for a message.
+cbVerify :: PublicKeyX25519 -> PrivateKeyX25519 -> CbNonce -> CbAuthenticator -> ByteString -> Bool
+cbVerify k pk nonce (CbAuthenticator s) authorized = cbDecryptNoPad (dh' k pk) nonce s == Right (sha512Hash authorized)
+
 newtype CbNonce = CryptoBoxNonce {unCbNonce :: ByteString}
   deriving (Eq, Show)
 

src/Simplex/Messaging/Notifications/Server.hs

@@ -369,7 +369,7 @@ receive th@THandle {thAuth} NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever
 send :: Transport c => THandle c -> NtfServerClient -> IO ()
 send h@THandle {thVersion = v} NtfServerClient {sndQ, sessionId, sndActiveAt} = forever $ do
   t <- atomically $ readTBQueue sndQ
-  void . liftIO $ tPut h [Right (TAuthNone, encodeTransmission v sessionId t)]
+  void . liftIO $ tPut h [Right (TANone, encodeTransmission v sessionId t)]
   atomically . writeTVar sndActiveAt =<< liftIO getSystemTime
 
 -- instance Show a => Show (TVar a) where
@@ -384,7 +384,7 @@ verifyNtfTransmission auth_ (tAuth, authorized, (corrId, entId, _)) cmd = do
     NtfCmd SToken c@(TNEW tkn@(NewNtfTkn _ k _)) -> do
       r_ <- atomically $ getNtfTokenRegistration st tkn
       pure $
-        if verifyCmdSignature auth_ tAuth authorized k
+        if verifyCmdAuthorization auth_ tAuth authorized k
           then case r_ of
             Just t@NtfTknData {tknVerifyKey}
               | k == tknVerifyKey -> verifiedTknCmd t c
@@ -421,7 +421,7 @@ verifyNtfTransmission auth_ (tAuth, authorized, (corrId, entId, _)) cmd = do
     verifyToken t_ positiveVerificationResult =
       pure $ case t_ of
         Just t@NtfTknData {tknVerifyKey} ->
-          if verifyCmdSignature auth_ tAuth authorized tknVerifyKey
+          if verifyCmdAuthorization auth_ tAuth authorized tknVerifyKey
             then positiveVerificationResult t
             else VRFailed
         _ -> dummyVerifyCmd auth_ authorized tAuth `seq` VRFailed

src/Simplex/Messaging/Protocol.hs

@@ -249,7 +249,7 @@ type Signed = ByteString
 
 -- | unparsed SMP transmission with signature.
 data RawTransmission = RawTransmission
-  { authorization :: ByteString, -- signature or encrypted transmission hash
+  { authenticator :: ByteString, -- signature or encrypted transmission hash
     authorized :: ByteString, -- authorized transmission
     sessId :: SessionId,
     corrId :: ByteString,
@@ -259,31 +259,31 @@ data RawTransmission = RawTransmission
   deriving (Show)
 
 data TransmissionAuth
-  = TAuthNone
-  | TAuthSignature C.ASignature
-  | TAuthEncHash ByteString
+  = TANone
+  | TASignature C.ASignature
+  | TAAuthenticator C.CbAuthenticator
   deriving (Eq, Show)
 
 isAuthNone :: TransmissionAuth -> Bool
 isAuthNone = \case
-  TAuthNone -> True
+  TANone -> True
   _ -> False
 
 -- this encoding is backwards compatible with v6 that used Maybe C.ASignature instead of TAuthorization
 tAuthBytes :: TransmissionAuth -> ByteString
 tAuthBytes = \case
-  TAuthNone -> ""
-  TAuthSignature s -> C.signatureBytes s
-  TAuthEncHash s -> s
+  TANone -> ""
+  TASignature s -> C.signatureBytes s
+  TAAuthenticator (C.CbAuthenticator s) -> s
 
 decodeTAuthBytes :: ByteString -> Either String TransmissionAuth
 decodeTAuthBytes s
-  | B.null s = Right TAuthNone
-  | B.length s == 64 + 16 = Right $ TAuthEncHash s
-  | otherwise = TAuthSignature <$> C.decodeSignature s
+  | B.null s = Right TANone
+  | B.length s == C.cbAuthenticatorSize = Right $ TAAuthenticator $ C.CbAuthenticator s
+  | otherwise = TASignature <$> C.decodeSignature s
 
 instance IsString TransmissionAuth where
-  fromString = parseString $ B64.decode >=> C.decodeSignature >=> pure . maybe TAuthNone TAuthSignature
+  fromString = parseString $ B64.decode >=> C.decodeSignature >=> pure . maybe TANone TASignature
 
 -- | unparsed sent SMP transmission with signature, without session ID.
 type SignedRawTransmission = (TransmissionAuth, SessionId, ByteString, ByteString)
@@ -1075,16 +1075,16 @@ data CommandError
 -- | SMP transmission parser.
 transmissionP :: Parser RawTransmission
 transmissionP = do
-  authorization <- smpP
+  authenticator <- smpP
   authorized <- A.takeByteString
-  either fail pure $ parseAll (trn authorization authorized) authorized
+  either fail pure $ parseAll (trn authenticator authorized) authorized
   where
-    trn authorization authorized = do
+    trn authenticator authorized = do
       sessId <- smpP
       corrId <- smpP
       entityId <- smpP
       command <- A.takeByteString
-      pure RawTransmission {authorization, authorized, sessId, corrId, entityId, command}
+      pure RawTransmission {authenticator, authorized, sessId, corrId, entityId, command}
 
 class (ProtocolEncoding err msg, ProtocolEncoding err (ProtoCommand msg), Show err, Show msg) => Protocol err msg | msg -> err where
   type ProtoCommand msg = cmd | cmd -> msg
@@ -1413,15 +1413,15 @@ tGet th@THandle {sessionId, thVersion = v} = L.map (tDecodeParseValidate session
 
 tDecodeParseValidate :: forall err cmd. ProtocolEncoding err cmd => SessionId -> Version -> Either TransportError RawTransmission -> SignedTransmission err cmd
 tDecodeParseValidate sessionId v = \case
-  Right RawTransmission {authorization, authorized, sessId, corrId, entityId, command}
+  Right RawTransmission {authenticator, authorized, sessId, corrId, entityId, command}
     | sessId == sessionId ->
-        let decodedTransmission = (,corrId,entityId,command) <$> decodeTAuthBytes authorization
+        let decodedTransmission = (,corrId,entityId,command) <$> decodeTAuthBytes authenticator
          in either (const $ tError corrId) (tParseValidate authorized) decodedTransmission
-    | otherwise -> (TAuthNone, "", (CorrId corrId, "", Left $ fromProtocolError @err @cmd PESession))
+    | otherwise -> (TANone, "", (CorrId corrId, "", Left $ fromProtocolError @err @cmd PESession))
   Left _ -> tError ""
   where
     tError :: ByteString -> SignedTransmission err cmd
-    tError corrId = (TAuthNone, "", (CorrId corrId, "", Left $ fromProtocolError @err @cmd PEBlock))
+    tError corrId = (TANone, "", (CorrId corrId, "", Left $ fromProtocolError @err @cmd PEBlock))
 
     tParseValidate :: ByteString -> SignedRawTransmission -> SignedTransmission err cmd
     tParseValidate signed t@(sig, corrId, entityId, command) =

src/Simplex/Messaging/Server.hs

@@ -32,7 +32,7 @@ module Simplex.Messaging.Server
   ( runSMPServer,
     runSMPServerBlocking,
     disconnectTransport,
-    verifyCmdSignature,
+    verifyCmdAuthorization,
     dummyVerifyCmd,
     randomId,
   )
@@ -443,7 +443,7 @@ send h@THandle {thVersion = v} Client {sndQ, sessionId, sndActiveAt} = do
   forever $ do
     ts <- atomically $ L.sortWith tOrder <$> readTBQueue sndQ
     -- TODO we can authorize responses as well
-    void . liftIO . tPut h $ L.map (\t -> Right (TAuthNone, encodeTransmission v sessionId t)) ts
+    void . liftIO . tPut h $ L.map (\t -> Right (TANone, encodeTransmission v sessionId t)) ts
     atomically . writeTVar sndActiveAt =<< liftIO getSystemTime
   where
     tOrder :: Transmission BrokerMsg -> Int
@@ -470,8 +470,8 @@ data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed
 verifyTransmission :: Maybe (THandleAuth, C.CbNonce) -> TransmissionAuth -> ByteString -> QueueId -> Cmd -> M VerificationResult
 verifyTransmission auth_ tAuth authorized queueId cmd =
   case cmd of
-    Cmd SRecipient (NEW k _ _ _) -> pure $ Nothing `verified` verifyCmdSignature auth_ tAuth authorized k
-    Cmd SRecipient _ -> verifyCmd SRecipient $ verifyCmdSignature auth_ tAuth authorized . recipientKey
+    Cmd SRecipient (NEW k _ _ _) -> pure $ Nothing `verified` verifyCmdAuthorization auth_ tAuth authorized k
+    Cmd SRecipient _ -> verifyCmd SRecipient $ verifyCmdAuthorization auth_ tAuth authorized . recipientKey
     Cmd SSender SEND {} -> verifyCmd SSender $ verifyMaybe . senderKey
     Cmd SSender PING -> pure $ VRVerified Nothing
     Cmd SNotifier NSUB -> verifyCmd SNotifier $ verifyMaybe . fmap notifierKey . notifier
@@ -484,39 +484,36 @@ verifyTransmission auth_ tAuth authorized queueId cmd =
         Right q -> Just q `verified` f q
         _ -> dummyVerifyCmd auth_ authorized tAuth `seq` VRFailed
     verifyMaybe :: Maybe C.APublicAuthKey -> Bool
-    verifyMaybe = maybe (isAuthNone tAuth) $ verifyCmdSignature auth_ tAuth authorized
+    verifyMaybe = maybe (isAuthNone tAuth) $ verifyCmdAuthorization auth_ tAuth authorized
     verified q cond = if cond then VRVerified q else VRFailed
 
-verifyCmdSignature :: Maybe (THandleAuth, C.CbNonce) -> TransmissionAuth -> ByteString -> C.APublicAuthKey -> Bool
-verifyCmdSignature auth_ tAuth authorized key = case tAuth of
-  TAuthNone -> False
-  TAuthSignature sig -> verify key sig
-  TAuthEncHash s -> authorize key s
+verifyCmdAuthorization :: Maybe (THandleAuth, C.CbNonce) -> TransmissionAuth -> ByteString -> C.APublicAuthKey -> Bool
+verifyCmdAuthorization auth_ tAuth authorized key = case tAuth of
+  TANone -> False
+  TASignature sig -> verifySig key sig
+  TAAuthenticator s -> verifyAuth key s
   where
-    verify :: C.APublicAuthKey -> C.ASignature -> Bool
-    verify (C.APublicAuthKey a k) sig@(C.ASignature a' s) =
+    verifySig :: C.APublicAuthKey -> C.ASignature -> Bool
+    verifySig (C.APublicAuthKey a k) sig@(C.ASignature a' s) =
       case testEquality a a' of
         Just Refl | C.signatureSize k == C.signatureSize s -> C.verify' k s authorized
-        _ -> dummyVerifyCmd auth_ authorized (TAuthSignature sig) `seq` False
-    authorize :: C.APublicAuthKey -> ByteString -> Bool
-    authorize (C.APublicAuthKey a k) s =
+        _ -> dummyVerifyCmd auth_ authorized (TASignature sig) `seq` False
+    verifyAuth :: C.APublicAuthKey -> C.CbAuthenticator -> Bool
+    verifyAuth (C.APublicAuthKey a k) s =
       case a of
-        C.SX25519 -> authorizeCmd auth_ k s authorized
-        _ -> dummyVerifyCmd auth_ authorized (TAuthEncHash s) `seq` False
+        C.SX25519 -> verifyCmdAuth auth_ k s authorized
+        _ -> dummyVerifyCmd auth_ authorized (TAAuthenticator s) `seq` False
 
-authorizeCmd :: Maybe (THandleAuth, C.CbNonce) -> C.PublicKeyX25519 -> ByteString -> ByteString -> Bool
-authorizeCmd auth_ k s authorized = case auth_ of
-  Just (THandleAuth {privKey}, nonce) -> cbAuthorize k privKey nonce s authorized
+verifyCmdAuth :: Maybe (THandleAuth, C.CbNonce) -> C.PublicKeyX25519 -> C.CbAuthenticator -> ByteString -> Bool
+verifyCmdAuth auth_ k authenticator authorized = case auth_ of
+  Just (THandleAuth {privKey}, nonce) -> C.cbVerify k privKey nonce authenticator authorized
   Nothing -> False
 
-cbAuthorize :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> ByteString -> ByteString -> Bool
-cbAuthorize k pk nonce s authorized = C.cbDecryptNoPad (C.dh' k pk) nonce s == Right (C.sha512Hash authorized)
-
 dummyVerifyCmd :: Maybe (THandleAuth, C.CbNonce) -> ByteString -> TransmissionAuth -> Bool
 dummyVerifyCmd auth_ authorized = \case
-  TAuthNone -> False
-  TAuthSignature (C.ASignature a s) -> C.verify' (dummyPublicKey a) s authorized
-  TAuthEncHash s -> authorizeCmd auth_ dummyKeyX25519 s authorized
+  TANone -> False
+  TASignature (C.ASignature a s) -> C.verify' (dummyPublicKey a) s authorized
+  TAAuthenticator s -> verifyCmdAuth auth_ dummyKeyX25519 s authorized
 
 -- These dummy keys are used with `dummyVerify` function to mitigate timing attacks
 -- by having the same time of the response whether a queue exists or nor, for all valid key/signature sizes

tests/CoreTests/BatchingTests.hs

@@ -142,7 +142,7 @@ randomSUB sessId = do
   corrId <- atomically $ CorrId <$> C.randomBytes 3 g
   (_, rpKey) <- atomically $ C.generateSignatureKeyPair C.SEd448 g
   let s = encodeTransmission (maxVersion supportedSMPServerVRange) sessId (corrId, rId, Cmd SRecipient SUB)
-  pure $ Right (TAuthSignature $ C.sign rpKey s, s)
+  pure $ Right (TASignature $ C.sign rpKey s, s)
 
 randomSUBCmd :: ProtocolClient ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
 randomSUBCmd c = do
@@ -159,7 +159,7 @@ randomSEND sessId len = do
   (_, rpKey) <- atomically $ C.generateSignatureKeyPair C.SEd448 g
   msg <- atomically $ C.randomBytes len g
   let s = encodeTransmission (maxVersion supportedSMPServerVRange) sessId (corrId, sId, Cmd SSender $ SEND noMsgFlags msg)
-  pure $ Right (TAuthSignature $ C.sign rpKey s, s)
+  pure $ Right (TASignature $ C.sign rpKey s, s)
 
 randomSENDCmd :: ProtocolClient ErrorType BrokerMsg -> Int -> IO (PCTransmission ErrorType BrokerMsg)
 randomSENDCmd c len = do

tests/NtfClient.hs

@@ -147,8 +147,8 @@ ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
       [Right ()] <- tPut h [Right (sig, t')]
       pure ()
     tGet' h = do
-      [(TAuthNone, _, (CorrId corrId, qId, Right cmd))] <- tGet h
-      pure (TAuthNone, corrId, qId, cmd)
+      [(TANone, _, (CorrId corrId, qId, Right cmd))] <- tGet h
+      pure (TANone, corrId, qId, cmd)
 
 ntfTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation
 ntfTest _ test' = runNtfTest test' `shouldReturn` ()

tests/NtfServerTests.hs

@@ -80,9 +80,9 @@ signSendRecvNtf h@THandle {thVersion, sessionId} (C.APrivateAuthKey a pk) (corrI
   tGet1 h
   where
     authorize t = case a of
-      C.SEd25519 -> TAuthSignature . C.ASignature C.SEd25519 $ C.sign' pk t
-      C.SEd448 -> TAuthSignature . C.ASignature C.SEd448 $ C.sign' pk t
-      _ -> TAuthNone
+      C.SEd25519 -> TASignature . C.ASignature C.SEd25519 $ C.sign' pk t
+      C.SEd448 -> TASignature . C.ASignature C.SEd448 $ C.sign' pk t
+      _ -> TANone
 
 (.->) :: J.Value -> J.Key -> Either String ByteString
 v .-> key =

tests/SMPClient.hs

@@ -169,8 +169,8 @@ smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
       [Right ()] <- tPut h [Right (sig, t')]
       pure ()
     tGet' h = do
-      [(TAuthNone, _, (CorrId corrId, qId, Right cmd))] <- tGet h
-      pure (TAuthNone, corrId, qId, cmd)
+      [(TANone, _, (CorrId corrId, qId, Right cmd))] <- tGet h
+      pure (TANone, corrId, qId, cmd)
 
 smpTest :: (HasCallStack, Transport c) => TProxy c -> (HasCallStack => THandle c -> IO ()) -> Expectation
 smpTest _ test' = runSmpTest test' `shouldReturn` ()

tests/ServerTests.hs

@@ -85,9 +85,9 @@ signSendRecv h@THandle {thVersion, sessionId} (C.APrivateAuthKey a pk) (corrId,
   tGet1 h
   where
     authorize t = case a of
-      C.SEd25519 -> TAuthSignature . C.ASignature C.SEd25519 $ C.sign' pk t
-      C.SEd448 -> TAuthSignature . C.ASignature C.SEd448 $ C.sign' pk t
-      _ -> TAuthNone
+      C.SEd25519 -> TASignature . C.ASignature C.SEd25519 $ C.sign' pk t
+      C.SEd448 -> TASignature . C.ASignature C.SEd448 $ C.sign' pk t
+      _ -> TANone
 
 tPut1 :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ())
 tPut1 h t = do
@@ -898,7 +898,7 @@ sampleDhPubKey :: C.PublicKey 'C.X25519
 sampleDhPubKey = "MCowBQYDK2VuAyEAriy+HcARIhqsgSjVnjKqoft+y6pxrxdY68zn4+LjYhQ="
 
 sampleSig :: TransmissionAuth
-sampleSig = TAuthSignature "e8JK+8V3fq6kOLqco/SaKlpNaQ7i1gfOrXoqekEl42u4mF8Bgu14T5j0189CGcUhJHw2RwCMvON+qbvQ9ecJAA=="
+sampleSig = TASignature "e8JK+8V3fq6kOLqco/SaKlpNaQ7i1gfOrXoqekEl42u4mF8Bgu14T5j0189CGcUhJHw2RwCMvON+qbvQ9ecJAA=="
 
 noAuth :: (Char, Maybe BasicAuth)
 noAuth = ('A', Nothing)