save keys as binary to db, remove legacy encoding (#114)

* save keys as binary to db, remove legacy encoding

* import list

apps/smp-server/Main.hs

@@ -127,7 +127,7 @@ confirm msg = do
   when (map toLower ok /= "y") exitFailure
 
 publicKeyHash :: C.PublicKey -> B.ByteString
-publicKeyHash = C.serializeKeyHash . C.getKeyHash . C.binaryEncodePubKey
+publicKeyHash = C.serializeKeyHash . C.getKeyHash . C.encodePubKey
 
 openStoreLog :: IniOpts -> IO (Maybe (StoreLog 'ReadMode))
 openStoreLog IniOpts {enableStoreLog, storeLogFile = f}

src/Simplex/Messaging/Crypto.hs

@@ -33,7 +33,7 @@ module Simplex.Messaging.Crypto
     decryptAES,
     serializePrivKey,
     serializePubKey,
-    binaryEncodePubKey,
+    encodePubKey,
     serializeKeyHash,
     getKeyHash,
     privKeyP,
@@ -50,7 +50,6 @@ module Simplex.Messaging.Crypto
   )
 where
 
-import Control.Applicative ((<|>))
 import Control.Exception (Exception)
 import Control.Monad.Except
 import Control.Monad.Trans.Except
@@ -60,7 +59,6 @@ import qualified Crypto.Error as CE
 import Crypto.Hash (Digest, SHA256 (..), digestFromByteString, hash)
 import Crypto.Number.Generate (generateMax)
 import Crypto.Number.Prime (findPrimeFrom)
-import Crypto.Number.Serialize (os2ip)
 import qualified Crypto.PubKey.RSA as R
 import qualified Crypto.PubKey.RSA.OAEP as OAEP
 import qualified Crypto.PubKey.RSA.PSS as PSS
@@ -72,7 +70,7 @@ import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (bimap, first)
 import qualified Data.ByteArray as BA
-import Data.ByteString.Base64
+import Data.ByteString.Base64 (decode, encode)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Internal (c2w, w2c)
@@ -86,8 +84,8 @@ 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, base64StringP, parseAll)
-import Simplex.Messaging.Util (liftEitherError)
+import Simplex.Messaging.Parsers (base64P, parseAll)
+import Simplex.Messaging.Util (liftEitherError, (<$?>))
 
 newtype PublicKey = PublicKey {rsaPublicKey :: R.PublicKey} deriving (Eq, Show)
 
@@ -112,21 +110,21 @@ instance PrivateKey FullPrivateKey where
   mkPrivateKey = FullPrivateKey
 
 instance IsString FullPrivateKey where
-  fromString = parseString decodePrivKey
+  fromString = parseString (decode >=> decodePrivKey)
 
 instance IsString PublicKey where
-  fromString = parseString decodePubKey
+  fromString = parseString (decode >=> decodePubKey)
 
 parseString :: (ByteString -> Either String a) -> (String -> a)
 parseString parse = either error id . parse . B.pack
 
-instance ToField SafePrivateKey where toField = toField . serializePrivKey
+instance ToField SafePrivateKey where toField = toField . encodePrivKey
 
-instance ToField PublicKey where toField = toField . serializePubKey
+instance ToField PublicKey where toField = toField . encodePubKey
 
-instance FromField SafePrivateKey where fromField = keyFromField privKeyP
+instance FromField SafePrivateKey where fromField = keyFromField binaryPrivKeyP
 
-instance FromField PublicKey where fromField = keyFromField pubKeyP
+instance FromField PublicKey where fromField = keyFromField binaryPubKeyP
 
 keyFromField :: Typeable k => Parser k -> FieldParser k
 keyFromField p = \case
@@ -336,35 +334,22 @@ verify :: PublicKey -> Signature -> ByteString -> Bool
 verify (PublicKey k) (Signature sig) msg = PSS.verify pssParams k msg sig
 
 serializePubKey :: PublicKey -> ByteString
-serializePubKey k = "rsa:" <> encodePubKey k
+serializePubKey = ("rsa:" <>) . encode . encodePubKey
 
 serializePrivKey :: PrivateKey k => k -> ByteString
-serializePrivKey pk = "rsa:" <> encodePrivKey pk
+serializePrivKey = ("rsa:" <>) . encode . encodePrivKey
 
 pubKeyP :: Parser PublicKey
-pubKeyP = keyP decodePubKey <|> legacyPubKeyP
+pubKeyP = decodePubKey <$?> ("rsa:" *> base64P)
 
 binaryPubKeyP :: Parser PublicKey
-binaryPubKeyP = either fail pure . binaryDecodePubKey =<< A.takeByteString
+binaryPubKeyP = decodePubKey <$?> A.takeByteString
 
 privKeyP :: PrivateKey k => Parser k
-privKeyP = keyP decodePrivKey <|> legacyPrivKeyP
+privKeyP = decodePrivKey <$?> ("rsa:" *> base64P)
 
-keyP :: (ByteString -> Either String k) -> Parser k
-keyP dec = either fail pure . dec =<< ("rsa:" *> base64StringP)
-
-legacyPubKeyP :: Parser PublicKey
-legacyPubKeyP = do
-  (public_size, public_n, public_e) <- legacyKeyParser_
-  return . PublicKey $ R.PublicKey {public_size, public_n, public_e}
-
-legacyPrivKeyP :: PrivateKey k => Parser k
-legacyPrivKeyP = _privateKey . safeRsaPrivateKey <$> legacyKeyParser_
-
-legacyKeyParser_ :: Parser (Int, Integer, Integer)
-legacyKeyParser_ = (,,) <$> (A.decimal <* ",") <*> (intP <* ",") <*> intP
-  where
-    intP = os2ip <$> base64P
+binaryPrivKeyP :: PrivateKey k => Parser k
+binaryPrivKeyP = decodePrivKey <$?> A.takeByteString
 
 safePrivateKey :: (Int, Integer, Integer) -> SafePrivateKey
 safePrivateKey = SafePrivateKey . safeRsaPrivateKey
@@ -387,34 +372,28 @@ safeRsaPrivateKey (size, n, d) =
     }
 
 encodePubKey :: PublicKey -> ByteString
-encodePubKey = encode . binaryEncodePubKey
-
-binaryEncodePubKey :: PublicKey -> ByteString
-binaryEncodePubKey = binaryEncodeKey . PubKeyRSA . rsaPublicKey
+encodePubKey = encodeKey . PubKeyRSA . rsaPublicKey
 
 encodePrivKey :: PrivateKey k => k -> ByteString
-encodePrivKey = encode . binaryEncodeKey . PrivKeyRSA . rsaPrivateKey
+encodePrivKey = encodeKey . PrivKeyRSA . rsaPrivateKey
 
-binaryEncodeKey :: ASN1Object a => a -> ByteString
-binaryEncodeKey k = toStrict . encodeASN1 DER $ toASN1 k []
+encodeKey :: ASN1Object a => a -> ByteString
+encodeKey k = toStrict . encodeASN1 DER $ toASN1 k []
 
 decodePubKey :: ByteString -> Either String PublicKey
-decodePubKey = binaryDecodePubKey <=< decode
-
-binaryDecodePubKey :: ByteString -> Either String PublicKey
-binaryDecodePubKey =
-  binaryDecodeKey >=> \case
+decodePubKey =
+  decodeKey >=> \case
     (PubKeyRSA k, []) -> Right $ PublicKey k
     r -> keyError r
 
 decodePrivKey :: PrivateKey k => ByteString -> Either String k
 decodePrivKey =
-  decode >=> binaryDecodeKey >=> \case
+  decodeKey >=> \case
     (PrivKeyRSA pk, []) -> Right $ mkPrivateKey pk
     r -> keyError r
 
-binaryDecodeKey :: ASN1Object a => ByteString -> Either String (a, [ASN1])
-binaryDecodeKey = fromASN1 <=< first show . decodeASN1 DER . fromStrict
+decodeKey :: ASN1Object a => ByteString -> Either String (a, [ASN1])
+decodeKey = fromASN1 <=< first show . decodeASN1 DER . fromStrict
 
 keyError :: (a, [ASN1]) -> Either String b
 keyError = \case

src/Simplex/Messaging/Parsers.hs

@@ -11,10 +11,11 @@ import qualified Data.ByteString.Char8 as B
 import Data.Char (isAlphaNum)
 import Data.Time.Clock (UTCTime)
 import Data.Time.ISO8601 (parseISO8601)
+import Simplex.Messaging.Util ((<$?>))
 import Text.Read (readMaybe)
 
 base64P :: Parser ByteString
-base64P = either fail pure . decode =<< base64StringP
+base64P = decode <$?> base64StringP
 
 base64StringP :: Parser ByteString
 base64StringP = do

src/Simplex/Messaging/Transport.hs

@@ -244,7 +244,7 @@ serverHandshake h (k, pk) = do
   where
     sendHeaderAndPublicKey_1 :: IO ()
     sendHeaderAndPublicKey_1 = do
-      let sKey = C.binaryEncodePubKey k
+      let sKey = C.encodePubKey k
           header = TransportHeader {blockSize = transportBlockSize, keySize = B.length sKey}
       B.hPut h $ binaryTransportHeader header <> sKey
     receiveEncryptedKeys_4 :: ExceptT TransportError IO ByteString

src/Simplex/Messaging/Util.hs

@@ -31,11 +31,14 @@ raceAny_ = r []
     r as (m : ms) = withAsync m $ \a -> r (a : as) ms
     r as [] = void $ waitAnyCancel as
 
-infixl 4 <$$>
+infixl 4 <$$>, <$?>
 
 (<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
 (<$$>) = fmap . fmap
 
+(<$?>) :: MonadFail m => (a -> Either String b) -> m a -> m b
+f <$?> m = m >>= either fail pure . f
+
 bshow :: Show a => a -> ByteString
 bshow = B.pack . show
 

tests/AgentTests.hs

@@ -13,7 +13,7 @@ import Control.Concurrent
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import SMPAgentClient
-import SMPClient (teshKeyHashStr)
+import SMPClient (testKeyHashStr)
 import Simplex.Messaging.Agent.Transmission
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import System.IO (Handle)
@@ -128,7 +128,7 @@ testSubscrNotification (server, _) client = do
   client <# ("", "conn1", END)
 
 samplePublicKey :: ByteString
-samplePublicKey = "256,ppr3DCweAD3RTVFhU2j0u+DnYdqJl1qCdKLHIKsPl1xBzfmnzK0o9GEDlaIClbK39KzPJMljcpnYb2KlSoZ51AhwF5PH2CS+FStc3QzajiqfdOQPet23Hd9YC6pqyTQ7idntqgPrE7yKJF44lUhKlq8QS9KQcbK7W6t7F9uQFw44ceWd2eVf81UV04kQdKWJvC5Sz6jtSZNEfs9mVI8H0wi1amUvS6+7EDJbxikhcCRnFShFO9dUKRYXj6L2JVqXqO5cZgY9BScyneWIg6mhhsTcdDbITM6COlL+pF1f3TjDN+slyV+IzE+ap/9NkpsrCcI8KwwDpqEDmUUV/JQfmQ==,gj2UAiWzSj7iun0iXvI5iz5WEjaqngmB3SzQ5+iarixbaG15LFDtYs3pijG3eGfB1wIFgoP4D2z97vIWn8olT4uCTUClf29zGDDve07h/B3QG/4i0IDnio7MX3AbE8O6PKouqy/GLTfT4WxFUn423g80rpsVYd5oj+SCL2eaxIc="
+samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj+toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP+Tm4sokaFDTIG3QJFzOjC+/9nW4MUjAOFll9PCp9kaEFHJ/YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju/f6kAayvYKW3/lbJNXCmyinAccBosO08/0sUxvtuniIo18kfYJE0UmP1ReCjhMP+O+yOmwZJini/QelJk/Pez8IIDDWnY1qYQsN/q7ocjakOYrpGG7mig6JMFpDJtD6istR"
 
 syntaxTests :: Spec
 syntaxTests = do
@@ -139,8 +139,8 @@ syntaxTests = do
       -- TODO: add tests with defined connection alias
       xit "only server" $ ("211", "", "NEW localhost") >#>= \case ("211", "", "INV" : _) -> True; _ -> False
       it "with port" $ ("212", "", "NEW localhost:5000") >#>= \case ("212", "", "INV" : _) -> True; _ -> False
-      xit "with keyHash" $ ("213", "", "NEW localhost#" <> teshKeyHashStr) >#>= \case ("213", "", "INV" : _) -> True; _ -> False
-      it "with port and keyHash" $ ("214", "", "NEW localhost:5000#" <> teshKeyHashStr) >#>= \case ("214", "", "INV" : _) -> True; _ -> False
+      xit "with keyHash" $ ("213", "", "NEW localhost#" <> testKeyHashStr) >#>= \case ("213", "", "INV" : _) -> True; _ -> False
+      it "with port and keyHash" $ ("214", "", "NEW localhost:5000#" <> testKeyHashStr) >#>= \case ("214", "", "INV" : _) -> True; _ -> False
     describe "invalid" do
       -- TODO: add tests with defined connection alias
       it "no parameters" $ ("221", "", "NEW") >#> ("221", "", "ERR CMD SYNTAX")

tests/AgentTests/SQLiteTests.hs

@@ -13,7 +13,7 @@ import Data.Time
 import Data.Word (Word32)
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
-import SMPClient (teshKeyHash)
+import SMPClient (testKeyHash)
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
 import Simplex.Messaging.Agent.Transmission
@@ -101,7 +101,7 @@ testForeignKeysEnabled = do
 rcvQueue1 :: RcvQueue
 rcvQueue1 =
   RcvQueue
-    { server = SMPServer "smp.simplex.im" (Just "5223") teshKeyHash,
+    { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
       rcvId = "1234",
       connAlias = "conn1",
       rcvPrivateKey = C.safePrivateKey (1, 2, 3),
@@ -115,7 +115,7 @@ rcvQueue1 =
 sndQueue1 :: SndQueue
 sndQueue1 =
   SndQueue
-    { server = SMPServer "smp.simplex.im" (Just "5223") teshKeyHash,
+    { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
       sndId = "3456",
       connAlias = "conn1",
       sndPrivateKey = C.safePrivateKey (1, 2, 3),
@@ -177,7 +177,7 @@ testGetAllConnAliases = do
 testGetRcvQueue :: SpecWith SQLiteStore
 testGetRcvQueue = do
   it "should get RcvQueue" $ \store -> do
-    let smpServer = SMPServer "smp.simplex.im" (Just "5223") teshKeyHash
+    let smpServer = SMPServer "smp.simplex.im" (Just "5223") testKeyHash
     let recipientId = "1234"
     createRcvConn store rcvQueue1
       `returnsResult` ()
@@ -232,7 +232,7 @@ testUpgradeRcvConnToDuplex = do
       `returnsResult` ()
     let anotherSndQueue =
           SndQueue
-            { server = SMPServer "smp.simplex.im" (Just "5223") teshKeyHash,
+            { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
               sndId = "2345",
               connAlias = "conn1",
               sndPrivateKey = C.safePrivateKey (1, 2, 3),
@@ -254,7 +254,7 @@ testUpgradeSndConnToDuplex = do
       `returnsResult` ()
     let anotherRcvQueue =
           RcvQueue
-            { server = SMPServer "smp.simplex.im" (Just "5223") teshKeyHash,
+            { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash,
               rcvId = "3456",
               connAlias = "conn1",
               rcvPrivateKey = C.safePrivateKey (1, 2, 3),

tests/SMPClient.hs

@@ -32,11 +32,11 @@ testHost = "localhost"
 testPort :: ServiceName
 testPort = "5000"
 
-teshKeyHashStr :: B.ByteString
-teshKeyHashStr = "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
+testKeyHashStr :: B.ByteString
+testKeyHashStr = "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
 
-teshKeyHash :: Maybe C.KeyHash
-teshKeyHash = Just "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
+testKeyHash :: Maybe C.KeyHash
+testKeyHash = Just "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
 
 testStoreLogFile :: FilePath
 testStoreLogFile = "tests/tmp/smp-server-store.log"
@@ -44,7 +44,7 @@ testStoreLogFile = "tests/tmp/smp-server-store.log"
 testSMPClient :: MonadUnliftIO m => (THandle -> m a) -> m a
 testSMPClient client =
   runTCPClient testHost testPort $ \h ->
-    liftIO (runExceptT $ clientHandshake h teshKeyHash) >>= \case
+    liftIO (runExceptT $ clientHandshake h testKeyHash) >>= \case
       Right th -> client th
       Left e -> error $ show e
 

tests/ServerTests.hs

@@ -330,20 +330,23 @@ testWithStoreLog =
         Right l -> pure l
         Left (_ :: SomeException) -> logSize
 
+samplePubKey :: ByteString
+samplePubKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj+toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP+Tm4sokaFDTIG3QJFzOjC+/9nW4MUjAOFll9PCp9kaEFHJ/YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju/f6kAayvYKW3/lbJNXCmyinAccBosO08/0sUxvtuniIo18kfYJE0UmP1ReCjhMP+O+yOmwZJini/QelJk/Pez8IIDDWnY1qYQsN/q7ocjakOYrpGG7mig6JMFpDJtD6istR"
+
 syntaxTests :: Spec
 syntaxTests = do
   it "unknown command" $ ("", "abcd", "1234", "HELLO") >#> ("", "abcd", "1234", "ERR CMD SYNTAX")
   describe "NEW" do
     it "no parameters" $ ("1234", "bcda", "", "NEW") >#> ("", "bcda", "", "ERR CMD SYNTAX")
-    it "many parameters" $ ("1234", "cdab", "", "NEW 1 2") >#> ("", "cdab", "", "ERR CMD SYNTAX")
-    it "no signature" $ ("", "dabc", "", "NEW 3,1234,1234") >#> ("", "dabc", "", "ERR CMD NO_AUTH")
-    it "queue ID" $ ("1234", "abcd", "12345678", "NEW 3,1234,1234") >#> ("", "abcd", "12345678", "ERR CMD HAS_AUTH")
+    it "many parameters" $ ("1234", "cdab", "", "NEW 1 " <> samplePubKey) >#> ("", "cdab", "", "ERR CMD SYNTAX")
+    it "no signature" $ ("", "dabc", "", "NEW " <> samplePubKey) >#> ("", "dabc", "", "ERR CMD NO_AUTH")
+    it "queue ID" $ ("1234", "abcd", "12345678", "NEW " <> samplePubKey) >#> ("", "abcd", "12345678", "ERR CMD HAS_AUTH")
   describe "KEY" do
-    it "valid syntax" $ ("1234", "bcda", "12345678", "KEY 3,4567,4567") >#> ("", "bcda", "12345678", "ERR AUTH")
+    it "valid syntax" $ ("1234", "bcda", "12345678", "KEY " <> samplePubKey) >#> ("", "bcda", "12345678", "ERR AUTH")
     it "no parameters" $ ("1234", "cdab", "12345678", "KEY") >#> ("", "cdab", "12345678", "ERR CMD SYNTAX")
-    it "many parameters" $ ("1234", "dabc", "12345678", "KEY 1 2") >#> ("", "dabc", "12345678", "ERR CMD SYNTAX")
-    it "no signature" $ ("", "abcd", "12345678", "KEY 3,4567,4567") >#> ("", "abcd", "12345678", "ERR CMD NO_AUTH")
-    it "no queue ID" $ ("1234", "bcda", "", "KEY 3,4567,4567") >#> ("", "bcda", "", "ERR CMD NO_AUTH")
+    it "many parameters" $ ("1234", "dabc", "12345678", "KEY 1 " <> samplePubKey) >#> ("", "dabc", "12345678", "ERR CMD SYNTAX")
+    it "no signature" $ ("", "abcd", "12345678", "KEY " <> samplePubKey) >#> ("", "abcd", "12345678", "ERR CMD NO_AUTH")
+    it "no queue ID" $ ("1234", "bcda", "", "KEY " <> samplePubKey) >#> ("", "bcda", "", "ERR CMD NO_AUTH")
   noParamsSyntaxTest "SUB"
   noParamsSyntaxTest "ACK"
   noParamsSyntaxTest "OFF"