From 6ceeb2c9db42e1c5383e12b4572511939ee91436 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 30 Apr 2021 09:13:18 +0100 Subject: [PATCH] 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 | 2 +- src/Simplex/Messaging/Crypto.hs | 73 +++++++++++------------------- src/Simplex/Messaging/Parsers.hs | 3 +- src/Simplex/Messaging/Transport.hs | 2 +- src/Simplex/Messaging/Util.hs | 5 +- tests/AgentTests.hs | 8 ++-- tests/AgentTests/SQLiteTests.hs | 12 ++--- tests/SMPClient.hs | 10 ++-- tests/ServerTests.hs | 17 ++++--- 9 files changed, 59 insertions(+), 73 deletions(-) diff --git a/apps/smp-server/Main.hs b/apps/smp-server/Main.hs index 3a4952ace..2de39e47c 100644 --- a/apps/smp-server/Main.hs +++ b/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} diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index a6e5a3e07..b5022e96f 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/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 diff --git a/src/Simplex/Messaging/Parsers.hs b/src/Simplex/Messaging/Parsers.hs index 4f96bae0b..25e2f32bb 100644 --- a/src/Simplex/Messaging/Parsers.hs +++ b/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 diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index f05731aa4..d70139500 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/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 diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs index b05e7ff45..2800e521e 100644 --- a/src/Simplex/Messaging/Util.hs +++ b/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 diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index ac8686439..ad0c365d0 100644 --- a/tests/AgentTests.hs +++ b/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") diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index a63073c13..46132c832 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/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), diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index c8eb3874a..00e843119 100644 --- a/tests/SMPClient.hs +++ b/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 diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index d081feb05..b1ead469c 100644 --- a/tests/ServerTests.hs +++ b/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"