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

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

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

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

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