improve rsa encryption (#61)

* clrify encryption schemes * increase SMP ping delay * include authTag and msg size in encrypted message header, pad messages to fixed size * use newtype for Key and IV bytestrings * rename CryptoError constructors * refactor Word to Int conversion * refactor padding, replace padding character * rfc corrections, comment * rename aesTagSize -> authTagSize * failing test
2026-03-30 18:35:59 +00:00 · 2021-02-28 16:17:28 +00:00
parent 927ff230da
commit d96aeb727f
8 changed files with 143 additions and 56 deletions
--- a/package.yaml
+++ b/package.yaml
@@ -20,10 +20,10 @@ dependencies:
  - containers
  - cryptonite == 0.26.*
  - iso8601-time == 0.1.*
-  - math-functions == 0.3.*
  - memory == 0.15.*
  - mtl
  - network == 3.1.*
+  - network-transport == 0.5.*
  - simple-logger == 0.1.*
  - sqlite-simple == 0.4.*
  - stm
--- a/rfcs/2021-01-26-crypto.md
+++ b/rfcs/2021-01-26-crypto.md
@@ -18,17 +18,48 @@ One of the consideration is to use [noise protocol framework](https://noiseproto

 During TCP session both client and server should use symmetric AES 256 bit encryption using the session key that will be established during the handshake.

-To establish the session key, the server should have an asymmetric key pair generated during server deployment and unknown to the clients. The users should know the key fingerprint (hash of the public key) in advance.
+To establish the session key, the server should have an asymmetric key pair generated during server deployment and unknown to the clients. The users should know the key hash (256 bits) and additional server ID (256 bits) in advance in order to be able to establish connection.

 The handshake sequence could be the following:

 1. Once the connection is established, the server sends its public key to the client
 2. The client compares the hash of the received key with the hash it already has (e.g. received as part of connection invitation or server in NEW command). If the hash does not match, the client must terminate the connection.
-3. If the hash is the same, the client should generate a random symmetric AES key that will be used as a session key both by the client and the server.
-4. The client then should encrypt this symmetric key with the public key that the server sent and send it back to the server
-5. The server should decrypt the received symmetric key with its private key and in case of success confirm to the client that it is now ready to receive the commands.
-6. In case of decryption failure, the server should notify the client and terminate the connection.
-7. All the subsequent data both from the client and from the server should be sent encrypted.
+3. If the hash is the same, the client should generate a random symmetric AES key and IV that will be used as a session key both by the client and the server.
+4. The client then should encrypt this symmetric key with the public key that the server sent and send back to the server the result and the server ID also shared with the client in advance: `rsa-encrypt(aes-key, iv, server-id)`.
+5. The server should decrypt the received key, IV and server id with its private key.
+6. The server should compare the `server-id` sent by the client and if it does not match its ID terminate the connection.
+7. In case of successful decryption and matching server ID, the server should send encrypted welcome header.
+
+```abnf
+aes_welcome_header = aes_header_auth_tag aes_encrypted_header
+welcome_header = smp_version ["," smp_mode] *SP ; decrypt(aes_encrypted_header) - 32 bytes
+smp_version = %s"v" 1*DIGIT "." 1*DIGIT "." 1*DIGIT ["-" 1*ALPHA "." 1*DIGIT] ; in semver format
+  ; for example: v123.456.789-alpha.7
+smp_mode = smp_public / smp_authenticated
+smp_public = %s"pub" ; public (default) - no auth to create and manage queues
+smp_authenticated = %s"auth" ; server authentication with AUTH command (TBD) is required to create and manage queues
+aes_header_auth_tag = aes_auth_tag
+aes_auth_tag = 16*16(OCTET)
+```
+
+No payload should follow this header, it is only used to confirm successful handshake and send the SMP protocol version that the server supports.
+
+All the subsequent data both from the client and from the server should be sent encrypted using symmetric AES key and IV sent by the client during the handshake.
+
+Each transport block sent by the client and the server has this syntax:
+
+```abnf
+transport_block = aes_header_auth_tag aes_encrypted_header aes_body_auth_tag aes_encrypted_body
+aes_encrypted_header = 32*32(OCTET)
+header = padded_body_size payload_size reserved ; decrypt(aes_encrypted_header) - 32 bytes
+aes_encrypted_body = 1*OCTET
+body = payload pad
+padded_body_size = size ; body size in bytes
+payload_size = size ; payload_size in bytes
+size = 4*4(OCTET)
+reserved = 24*24(OCTET)
+aes_body_auth_tag = aes_auth_tag
+```

 ## Initial handshake
 ### Why handshake has to be with asymmetric keys
@@ -71,6 +102,22 @@ Since we have a shared secret Apub, Bpub (if Apub is compromised connection shou

 Symmetric keys are generated per message and encrypted with receiver's public key (encryption key).

+The syntax of each encrypted message body is the following:
+
+```abnf
+encrypted_message_body = rsa_encrypted_header aes_encrypted_body
+rsa_encrypted_header = 256*256(OCTET) ; encrypt(header) - assuming 2048 bit key size
+aes_encrypted_body = 1*OCTET ; encrypt(body)
+
+header = aes_key aes_iv auth_tag payload_size
+aes_key = 32*32(OCTET)
+aes_iv = 16*16(OCTET)
+auth_tag = 16*16(OCTET)
+payload_size = 4*4(OCTET)
+
+body = payload pad
+```
+
 Future considerations:
 - Generation of symmetric keys per session and session rotation;
 - Signature and verification of messages.
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -214,7 +214,8 @@ sendConfirmation c SndQueue {server, sndId, encryptKey} senderKey = do
    mkConfirmation :: m MsgBody
    mkConfirmation = do
      let msg = serializeSMPMessage $ SMPConfirmation senderKey
-      liftError CRYPTO $ C.encrypt encryptKey msg
+      paddedSize <- asks paddedMsgSize
+      liftError CRYPTO $ C.encrypt encryptKey paddedSize msg

 sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> VerificationKey -> m ()
 sendHello c SndQueue {server, sndId, sndPrivateKey, encryptKey} verifyKey = do
@@ -262,7 +263,7 @@ sendAgentMessage c SndQueue {server, sndId, sndPrivateKey, encryptKey} senderTs
  withLogSMP c server sndId "SEND <message>" $ \smp ->
    sendSMPMessage smp (Just sndPrivateKey) sndId msg

-mkAgentMessage :: (MonadUnliftIO m, MonadError AgentErrorType m) => EncryptionKey -> SenderTimestamp -> AMessage -> m ByteString
+mkAgentMessage :: AgentMonad m => EncryptionKey -> SenderTimestamp -> AMessage -> m ByteString
 mkAgentMessage encKey senderTs agentMessage = do
  let msg =
        serializeSMPMessage
@@ -272,4 +273,5 @@ mkAgentMessage encKey senderTs agentMessage = do
              previousMsgHash = "1234", -- TODO hash of the previous message
              agentMessage
            }
-  liftError CRYPTO $ C.encrypt encKey msg
+  paddedSize <- asks paddedMsgSize
+  liftError CRYPTO $ C.encrypt encKey paddedSize msg
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -25,7 +25,8 @@ data AgentConfig = AgentConfig
 data Env = Env
  { config :: AgentConfig,
    idsDrg :: TVar ChaChaDRG,
-    clientCounter :: TVar Int
+    clientCounter :: TVar Int,
+    paddedMsgSize :: Int
  }

 newSMPAgentEnv :: (MonadUnliftIO m, MonadRandom m) => AgentConfig -> m Env
@@ -33,4 +34,10 @@ newSMPAgentEnv config = do
  idsDrg <- drgNew >>= newTVarIO
  _ <- createSQLiteStore $ dbFile config
  clientCounter <- newTVarIO 0
-  return Env {config, idsDrg, clientCounter}
+  return Env {config, idsDrg, clientCounter, paddedMsgSize}
+  where
+    -- one rsaKeySize is used by the RSA signature in each command,
+    -- another - by encrypted message body header
+    -- smpCommandSize - is the estimated max size for SMP command, queueId, corrId
+    paddedMsgSize = blockSize smp - 2 * rsaKeySize config - smpCommandSize smp
+    smp = smpCfg config
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -69,7 +69,9 @@ data SMPClientConfig = SMPClientConfig
  { qSize :: Natural,
    defaultPort :: ServiceName,
    tcpTimeout :: Int,
-    smpPing :: Int
+    smpPing :: Int,
+    blockSize :: Int,
+    smpCommandSize :: Int
  }

 smpDefaultConfig :: SMPClientConfig
@@ -78,7 +80,9 @@ smpDefaultConfig =
    { qSize = 16,
      defaultPort = "5223",
      tcpTimeout = 2_000_000,
-      smpPing = 30_000_000
+      smpPing = 30_000_000,
+      blockSize = 8_192, -- 16_384,
+      smpCommandSize = 256
    }

 data Request = Request
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -52,10 +52,9 @@ import Database.SQLite.Simple.FromField
 import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok (Ok (Ok))
 import Database.SQLite.Simple.ToField (ToField (..))
+import Network.Transport.Internal (decodeWord32, encodeWord32)
 import Simplex.Messaging.Parsers (base64P)
 import Simplex.Messaging.Util (bshow, liftEitherError, (<$$>))
-import Data.Bits (shift, complement, (.&.))
-import Numeric.SpecFunctions (log2)

 newtype PublicKey = PublicKey {rsaPublicKey :: R.PublicKey} deriving (Eq, Show)

@@ -98,16 +97,18 @@ data CryptoError
  | CryptoCipherError CE.CryptoError
  | CryptoIVError
  | CryptoDecryptError
+  | CryptoLargeMsgError
+  | CryptoHeaderError String
  deriving (Eq, Show, Exception)

 pubExpRange :: Integer
 pubExpRange = 2 ^ (1024 :: Int)

-aeKeySize :: Int
-aeKeySize = 256 `div` 8
+aesKeySize :: Int
+aesKeySize = 256 `div` 8

-aeTagSize :: Int
-aeTagSize = 128 `div` 8
+authTagSize :: Int
+authTagSize = 128 `div` 8

 generateKeyPair :: Int -> IO KeyPair
 generateKeyPair size = loop
@@ -123,39 +124,73 @@ generateKeyPair size = loop
            then loop
            else return (PublicKey pub, privateKey s n d)

-encrypt :: PublicKey -> ByteString -> ExceptT CryptoError IO ByteString
-encrypt k msg = do
-  aesKey <- randomBytes aeKeySize
-  ivBytes <- randomIVBytes @AES256
-  aead <- initAEAD @AES256 (aesKey, ivBytes)
-  let (authTag, msg') = encryptAES aead msg
-  encKeyIv <- encryptOAEP k (aesKey <> ivBytes)
-  return $ encKeyIv <> authTagToBS authTag <> msg'
+data Header = Header
+  { aesKey :: Key,
+    ivBytes :: IV,
+    authTag :: AES.AuthTag,
+    msgSize :: Int
+  }
+
+newtype Key = Key {unKey :: ByteString}
+
+newtype IV = IV {unIV :: ByteString}
+
+serializeHeader :: Header -> ByteString
+serializeHeader Header {aesKey, ivBytes, authTag, msgSize} =
+  unKey aesKey <> unIV ivBytes <> authTagToBS authTag <> (encodeWord32 . fromIntegral) msgSize
+
+headerP :: Parser Header
+headerP = do
+  aesKey <- Key <$> A.take aesKeySize
+  ivBytes <- IV <$> A.take (ivSize @AES256)
+  authTag <- bsToAuthTag <$> A.take authTagSize
+  msgSize <- fromIntegral . decodeWord32 <$> A.take 4
+  return Header {aesKey, ivBytes, authTag, msgSize}
+
+parseHeader :: ByteString -> Either CryptoError Header
+parseHeader = first CryptoHeaderError . A.parseOnly (headerP <* A.endOfInput)
+
+encrypt :: PublicKey -> Int -> ByteString -> ExceptT CryptoError IO ByteString
+encrypt k paddedSize msg = do
+  aesKey <- Key <$> randomBytes aesKeySize
+  ivBytes <- IV <$> randomBytes (ivSize @AES256)
+  aead <- initAEAD @AES256 aesKey ivBytes
+  msg' <- paddedMsg
+  let (authTag, msg'') = encryptAES aead msg'
+      header = Header {aesKey, ivBytes, authTag, msgSize = B.length msg}
+  encHeader <- encryptOAEP k $ serializeHeader header
+  return $ encHeader <> msg''
+  where
+    len = B.length msg
+    paddedMsg
+      | len >= paddedSize = throwE CryptoLargeMsgError
+      | otherwise = return (msg <> B.replicate (paddedSize - len) '#')

 decrypt :: PrivateKey -> ByteString -> ExceptT CryptoError IO ByteString
 decrypt pk msg'' = do
-  let (encKeyIv, msg') = B.splitAt (private_size pk) msg''
-      (authTag, msg) = B.splitAt aeTagSize msg'
-  keyIv <- B.splitAt aeKeySize <$> decryptOAEP pk encKeyIv
-  aead <- initAEAD @AES256 keyIv
-  decryptAES aead msg (bsToAuthTag authTag)
+  let (encHeader, msg') = B.splitAt (private_size pk) msg''
+  header <- decryptOAEP pk encHeader
+  Header {aesKey, ivBytes, authTag, msgSize} <- ExceptT . return $ parseHeader header
+  aead <- initAEAD @AES256 aesKey ivBytes
+  msg <- decryptAES aead msg' authTag
+  return $ B.take msgSize msg

 encryptAES :: AES.AEAD AES256 -> ByteString -> (AES.AuthTag, ByteString)
-encryptAES aead plaintext = AES.aeadSimpleEncrypt aead B.empty plaintext aeTagSize
+encryptAES aead plaintext = AES.aeadSimpleEncrypt aead B.empty plaintext authTagSize

 decryptAES :: AES.AEAD AES256 -> ByteString -> AES.AuthTag -> ExceptT CryptoError IO ByteString
 decryptAES aead ciphertext authTag =
  maybeError CryptoDecryptError $ AES.aeadSimpleDecrypt aead B.empty ciphertext authTag

-initAEAD :: forall c. AES.BlockCipher c => (ByteString, ByteString) -> ExceptT CryptoError IO (AES.AEAD c)
-initAEAD (aesKey, ivBytes) = do
+initAEAD :: forall c. AES.BlockCipher c => Key -> IV -> ExceptT CryptoError IO (AES.AEAD c)
+initAEAD (Key aesKey) (IV ivBytes) = do
  iv <- makeIV @c ivBytes
  cryptoFailable $ do
    cipher <- AES.cipherInit aesKey
    AES.aeadInit AES.AEAD_GCM cipher iv

-randomIVBytes :: forall c. AES.BlockCipher c => ExceptT CryptoError IO ByteString
-randomIVBytes = randomBytes (AES.blockSize (undefined :: c))
+ivSize :: forall c. AES.BlockCipher c => Int
+ivSize = AES.blockSize (undefined :: c)

 makeIV :: AES.BlockCipher c => ByteString -> ExceptT CryptoError IO (AES.IV c)
 makeIV bs = maybeError CryptoIVError $ AES.makeIV bs
@@ -245,13 +280,3 @@ rsaPrivateKey pk =
      R.private_dQ = undefined,
      R.private_qinv = undefined
    }
-
-- | computes padded message length using Padmé padding scheme
-- https://bford.info/pub/sec/purb.pdf
-- currently not used
-paddedLength :: Int -> Int
-paddedLength len = (len + mask) .&. complement mask
-  where
-    mask = (1 `shift` zeroBytes len) - 1
-    zeroBytes 1 = 0
-    zeroBytes l = let e = log2 l in e - log2 e - 1
--- a/tests/AgentTests.hs
+++ b/tests/AgentTests.hs
@@ -109,7 +109,10 @@ testSubscription alice1 alice2 bob = do
  bob #: ("13", "alice", "SEND 11\nhello again") =#> \case ("13", "alice", SENT _) -> True; _ -> False
  alice1 <# ("", "bob", CON)
  alice1 <#= \case ("", "bob", Msg "hello") -> True; _ -> False
-  alice1 <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
+  -- alice1 <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
+  t <- tGet SAgent alice1
+  print t
+  t `shouldSatisfy` (\case ("", "bob", Msg "hello again") -> True; _ -> False) . correctTransmission
  alice2 #: ("21", "bob", "SUB") #> ("21", "bob", OK)
  alice1 <# ("", "bob", END)
  bob #: ("14", "alice", "SEND 2\nhi") =#> \case ("14", "alice", SENT _) -> True; _ -> False
@@ -124,7 +127,7 @@ testSubscrNotification (server, _) client = do
  client <# ("", "conn1", END)

 samplePublicKey :: ByteString
-samplePublicKey = "128,2Qq2UNh5JuScgW0twxeYIDm8Uqf+b7t7OsUQcAgmDBpD+S4ZVoika1SxN2KsCSd7VneWMHm89oXIcGYM7jC7uJE8zXJFIr/1PimF96ols7n6UUFOSTH3VSqe47CzQfamxTFHl463fNPLbvOLxRfkzrZ5Qkpk2LyMkje8R1/39n0=,/uSFqPtYQeK/CX8qK4XR1BOt8eL+axBWgX7tGosI8VFBoBWR4Cbtx+F3hInQVCpxoQsz6n76ppWD4PSnzqcvQudD/3eo8VQNdQpBtX0vOjtsOxycselo99k2mdixIjjUz/RDR1Z+OthCG3rGeIK5/wyERcLR7EsBGOaBr+Xidbs="
+samplePublicKey = "256,ppr3DCweAD3RTVFhU2j0u+DnYdqJl1qCdKLHIKsPl1xBzfmnzK0o9GEDlaIClbK39KzPJMljcpnYb2KlSoZ51AhwF5PH2CS+FStc3QzajiqfdOQPet23Hd9YC6pqyTQ7idntqgPrE7yKJF44lUhKlq8QS9KQcbK7W6t7F9uQFw44ceWd2eVf81UV04kQdKWJvC5Sz6jtSZNEfs9mVI8H0wi1amUvS6+7EDJbxikhcCRnFShFO9dUKRYXj6L2JVqXqO5cZgY9BScyneWIg6mhhsTcdDbITM6COlL+pF1f3TjDN+slyV+IzE+ap/9NkpsrCcI8KwwDpqEDmUUV/JQfmQ==,gj2UAiWzSj7iun0iXvI5iz5WEjaqngmB3SzQ5+iarixbaG15LFDtYs3pijG3eGfB1wIFgoP4D2z97vIWn8olT4uCTUClf29zGDDve07h/B3QG/4i0IDnio7MX3AbE8O6PKouqy/GLTfT4WxFUn423g80rpsVYd5oj+SCL2eaxIc="

 syntaxTests :: Spec
 syntaxTests = do
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -8,12 +8,12 @@ module SMPAgentClient where
 import Control.Monad
 import Control.Monad.IO.Unlift
 import Crypto.Random
-import Network.Socket
+import Network.Socket (HostName, ServiceName)
 import SMPClient (testPort, withSmpServer, withSmpServerThreadOn)
 import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Transmission
-import Simplex.Messaging.Client (SMPClientConfig (..))
+import Simplex.Messaging.Client (SMPClientConfig (..), smpDefaultConfig)
 import Simplex.Messaging.Transport
 import Test.Hspec
 import UnliftIO.Concurrent
@@ -109,16 +109,15 @@ cfg :: AgentConfig
 cfg =
  AgentConfig
    { tcpPort = agentTestPort,
-      rsaKeySize = 1024 `div` 8,
+      rsaKeySize = 2048 `div` 8,
      connIdBytes = 12,
      tbqSize = 1,
      dbFile = testDB,
      smpCfg =
-        SMPClientConfig
+        smpDefaultConfig
          { qSize = 1,
            defaultPort = testPort,
-            tcpTimeout = 500_000,
-            smpPing = 30_000_000
+            tcpTimeout = 500_000
          }
    }