diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index 808699fe7..6deff72d6 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/src/Simplex/Messaging/Crypto.hs @@ -22,6 +22,7 @@ module Simplex.Messaging.Crypto generateKeyPair, publicKey, publicKeySize, + validKeySize, safePrivateKey, sign, verify, @@ -189,6 +190,13 @@ publicKey = PublicKey . R.private_pub . rsaPrivateKey publicKeySize :: PublicKey -> Int publicKeySize = R.public_size . rsaPublicKey +validKeySize :: Int -> Bool +validKeySize = \case + 128 -> True + 256 -> True + 512 -> True + _ -> False + data Header = Header { aesKey :: Key, ivBytes :: IV, diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 30d20ec5a..3a1cbcbcf 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -121,6 +121,7 @@ data ErrorType data CommandError = PROHIBITED + | KEY_SIZE | SYNTAX | NO_AUTH | HAS_AUTH @@ -225,12 +226,17 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate decodeParseValidate :: Either TransportError RawTransmission -> m SignedTransmissionOrError decodeParseValidate = \case Right (signature, corrId, queueId, command) -> - let decodedTransmission = liftM2 (,corrId,,command) (decode signature) (decode queueId) + let decodedTransmission = liftM2 (,corrId,,command) (validSig =<< decode signature) (decode queueId) in either (const $ tError corrId) tParseValidate decodedTransmission Left _ -> tError "" + validSig :: ByteString -> Either String ByteString + validSig sig + | B.null sig || C.validKeySize (B.length sig) = Right sig + | otherwise = Left "invalid signature size" + tError :: ByteString -> m SignedTransmissionOrError - tError corrId = return (C.Signature B.empty, (CorrId corrId, B.empty, Left BLOCK)) + tError corrId = return (C.Signature "", (CorrId corrId, "", Left BLOCK)) tParseValidate :: RawTransmission -> m SignedTransmissionOrError tParseValidate t@(sig, corrId, queueId, command) = do diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index d0d736673..0f9eb8c1d 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -107,29 +107,46 @@ verifyTransmission :: forall m. (MonadUnliftIO m, MonadReader Env m) => SignedTr verifyTransmission (sig, t@(corrId, queueId, cmd)) = do (corrId,queueId,) <$> case cmd of Cmd SBroker _ -> return $ smpErr INTERNAL -- it can only be client command, because `fromClient` was used - Cmd SRecipient (NEW k) -> return $ verifySignature k + Cmd SRecipient (NEW k) -> pure $ verifySignature k Cmd SRecipient _ -> verifyCmd SRecipient $ verifySignature . recipientKey Cmd SSender (SEND _) -> verifyCmd SSender $ verifySend sig . senderKey Cmd SSender PING -> return cmd where verifyCmd :: SParty p -> (QueueRec -> Cmd) -> m Cmd verifyCmd party f = do - (aKey, _) <- asks serverKeyPair -- any public key can be used to mitigate timing attack st <- asks queueStore q <- atomically $ getQueue st party queueId - pure $ either (const $ fakeVerify aKey) f q - fakeVerify :: C.PublicKey -> Cmd - fakeVerify aKey = if verify aKey then authErr else authErr + pure $ either (const $ dummyVerify authErr) f q verifySend :: C.Signature -> Maybe SenderPublicKey -> Cmd verifySend "" = maybe cmd (const authErr) verifySend _ = maybe authErr verifySignature verifySignature :: C.PublicKey -> Cmd verifySignature key = if verify key then cmd else authErr - verify :: C.PublicKey -> Bool - verify key = C.verify key sig (serializeTransmission t) - smpErr :: ErrorType -> Cmd + verify key + | C.publicKeySize key == sigLen = cryptoVerify key + | otherwise = dummyVerify False + cryptoVerify key = C.verify key sig (serializeTransmission t) smpErr = Cmd SBroker . ERR authErr = smpErr AUTH + dummyVerify :: a -> a + dummyVerify = seq $ + cryptoVerify $ case sigLen of + 128 -> dummyKey128 + 256 -> dummyKey256 + 512 -> dummyKey512 + _ -> dummyKey256 + sigLen = B.length $ C.unSignature sig + +-- 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 +dummyKey128 :: C.PublicKey +dummyKey128 = "MIIBIDANBgkqhkiG9w0BAQEFAAOCAQ0AMIIBCAKBgQC2oeA7s4roXN5K2N6022I1/2CTeMKjWH0m00bSZWa4N8LDKeFcShh8YUxZea5giAveViTRNOOVLgcuXbKvR3u24szN04xP0+KnYUuUUIIoT3YSjX0IlomhDhhSyup4BmA0gAZ+D1OaIKZFX6J8yQ1Lr/JGLEfSRsBjw8l+4hs9OwKBgQDKA+YlZvGb3BcpDwKmatiCXN7ZRDWkjXbj8VAW5zV95tSRCCVN48hrFM1H4Ju2QMMUc6kPUVX+eW4ZjdCl5blIqIHMcTmsdcmsDDCg3PjUNrwc6bv/1TcirbAKcmnKt9iurIt6eerxSO7TZUXXMUVsi7eRwb/RUNhpCrpJ/hpIOw==" + +dummyKey256 :: C.PublicKey +dummyKey256 = "MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAxwmTvaqmdTbkfUGNi8Yu0L/T4cxuOlQlx3zGZ9X9Qx0+oZjknWK+QHrdWTcpS+zH4Hi7fP6kanOQoQ90Hj6Ghl57VU1GEdUPywSw4i1/7t0Wv9uT9Q2ktHp2rqVo3xkC9IVIpL7EZAxdRviIN2OsOB3g4a/F1ZpjxcAaZeOMUugiAX1+GtkLuE0Xn4neYjCaOghLxQTdhybN70VtnkiQLx/X9NjkDIl/spYGm3tQFMyYKkP6IWoEpj0926hJ0fmlmhy8tAOhlZsb/baW5cgkEZ3E9jVVrySCgQzoLQgma610FIISRpRJbSyv26jU7MkMxiyuBiDaFOORkXFttoKbtQKBgEbDS9II2brsz+vfI7uP8atFcawkE52cx4M1UWQhqb1H3tBiRl+qO+dMq1pPQF2bW7dlZAWYzS4W/367bTAuALHBDGB8xi1P4Njhh9vaOgTvuqrHG9NJQ85BLy0qGw8rjIWSIXVmVpfrXFJ8po5l04UE258Ll2yocv3QRQmddQW9" + +dummyKey512 :: C.PublicKey +dummyKey512 = "MIICoDANBgkqhkiG9w0BAQEFAAOCAo0AMIICiAKCAgEArkCY9DuverJ4mmzDektv9aZMFyeRV46WZK9NsOBKEc+1ncqMs+LhLti9asKNgUBRbNzmbOe0NYYftrUpwnATaenggkTFxxbJ4JGJuGYbsEdFWkXSvrbWGtM8YUmn5RkAGme12xQ89bSM4VoJAGnrYPHwmcQd+KYCPZvTUsxaxgrJTX65ejHN9BsAn8XtGViOtHTDJO9yUMD2WrJvd7wnNa+0ugEteDLzMU++xS98VC+uA1vfauUqi3yXVchdfrLdVUuM+JE0gUEXCgzjuHkaoHiaGNiGhdPYoAJJdOKQOIHAKdk7Th6OPhirPhc9XYNB4O8JDthKhNtfokvFIFlC4QBRzJhpLIENaEBDt08WmgpOnecZB/CuxkqqOrNa8j5K5jNrtXAI67W46VEC2jeQy/gZwb64Zit2A4D00xXzGbQTPGj4ehcEMhLx5LSCygViEf0w0tN3c3TEyUcgPzvECd2ZVpQLr9Z4a07Ebr+YSuxcHhjg4Rg1VyJyOTTvaCBGm5X2B3+tI4NUttmikIHOYpBnsLmHY2BgfH2KcrIsDyAhInXmTFr/L2+erFarUnlfATd2L8Ti43TNHDedO6k6jI5Gyi62yPwjqPLEIIK8l+pIeNfHJ3pPmjhHBfzFcQLMMMXffHWNK8kWklrQXK+4j4HiPcTBvlO1FEtG9nEIZhUCgYA4a6WtI2k5YNli1C89GY5rGUY7RP71T6RWri/D3Lz9T7GvU+FemAyYmsvCQwqijUOur0uLvwSP8VdxpSUcrjJJSWur2hrPWzWlu0XbNaeizxpFeKbQP+zSrWJ1z8RwfAeUjShxt8q1TuqGqY10wQyp3nyiTGvS+KwZVj5h5qx8NQ==" client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m () client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} = @@ -157,7 +174,7 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} = where createQueue :: QueueStore -> RecipientPublicKey -> m Transmission createQueue st rKey = - mkResp corrId B.empty <$> addSubscribe + checkKeySize rKey addSubscribe where addSubscribe = addQueueRetry 3 >>= \case @@ -189,7 +206,14 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} = secureQueue_ :: QueueStore -> SenderPublicKey -> m Transmission secureQueue_ st sKey = do withLog $ \s -> logSecureQueue s queueId sKey - okResp <$> atomically (secureQueue st queueId sKey) + atomically . checkKeySize sKey $ either ERR (const OK) <$> secureQueue st queueId sKey + + checkKeySize :: Monad m' => C.PublicKey -> m' (Command 'Broker) -> m' Transmission + checkKeySize key action = + mkResp corrId queueId + <$> if C.validKeySize $ C.publicKeySize key + then action + else pure . ERR $ CMD KEY_SIZE suspendQueue_ :: QueueStore -> m Transmission suspendQueue_ st = do diff --git a/src/Simplex/Messaging/errors.md b/src/Simplex/Messaging/errors.md index 6fba8bed4..05f5ca279 100644 --- a/src/Simplex/Messaging/errors.md +++ b/src/Simplex/Messaging/errors.md @@ -9,9 +9,10 @@ ### ErrorType (Protocol.hs) -- BLOCK - incorrect block format or encoding +- BLOCK - incorrect block format, encoding or signature size - CMD error - command is unknown or has invalid syntax, where `error` can be: - PROHIBITED - server response sent from client or vice versa + - KEY_SIZE - bad RSA key size in NEW or KEY commands (only 1024, 2048 and 4096 bits keys are allowed) - SYNTAX - error parsing command - NO_AUTH - transmission has no required credentials (signature or queue ID) - HAS_AUTH - transmission has not allowed credentials diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 743d55671..8afe04594 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -89,7 +89,7 @@ testCreateSecure = (sId2, sId) #== "same queue ID in response 2" let keyCmd = "KEY " <> C.serializePubKey sPub - Resp "bcda" _ err2 <- sendRecv h ("12345678", "bcda", rId, keyCmd) + Resp "bcda" _ err2 <- sendRecv h (sampleSig, "bcda", rId, keyCmd) (err2, ERR AUTH) #== "rejects KEY with wrong signature" Resp "cdab" _ err3 <- signSendRecv h rKey ("cdab", sId, keyCmd) @@ -135,7 +135,7 @@ testCreateDelete = Resp "" _ (MSG _ _ msg1) <- tGet fromServer rh (msg1, "hello") #== "delivers message" - Resp "abcd" _ err1 <- sendRecv rh ("12345678", "abcd", rId, "OFF") + Resp "abcd" _ err1 <- sendRecv rh (sampleSig, "abcd", rId, "OFF") (err1, ERR AUTH) #== "rejects OFF with wrong signature" Resp "bcda" _ err2 <- signSendRecv rh rKey ("bcda", sId, "OFF") @@ -157,7 +157,7 @@ testCreateDelete = Resp "cdab" _ (MSG _ _ msg) <- signSendRecv rh rKey ("cdab", rId, "SUB") (msg, "hello") #== "accepts SUB when suspended and delivers the message again (because was not ACKed)" - Resp "dabc" _ err5 <- sendRecv rh ("12345678", "dabc", rId, "DEL") + Resp "dabc" _ err5 <- sendRecv rh (sampleSig, "dabc", rId, "DEL") (err5, ERR AUTH) #== "rejects DEL with wrong signature" Resp "abcd" _ err6 <- signSendRecv rh rKey ("abcd", sId, "DEL") @@ -334,64 +334,83 @@ testWithStoreLog = testTiming :: Spec testTiming = - it "should have similar time for auth error whether queue exists or not" $ - smpTest2 \rh sh -> do + it "should have similar time for auth error, whether queue exists or not, for all key sizes" $ + smpTest2 \rh sh -> + mapM_ + (testSameTiming rh sh) + [ (128, 128, 100), + (128, 256, 25), + -- (128, 512, 15), + (256, 128, 100), + (256, 256, 25) + -- (256, 512, 15), + -- (512, 128, 100), + -- (512, 256, 25), + -- (512, 512, 15) + ] + where + timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const + similarTime t1 t2 = abs (t1 - t2) / t1 < 0.2 `shouldBe` True + testSameTiming :: THandle -> THandle -> (Int, Int, Int) -> Expectation + testSameTiming rh sh (senderKeySize, badKeySize, n) = do (rPub, rKey) <- C.generateKeyPair rsaKeySize Resp "abcd" "" (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializePubKey rPub) - (sPub, sKey) <- C.generateKeyPair rsaKeySize + (sPub, sKey) <- C.generateKeyPair senderKeySize let keyCmd = "KEY " <> C.serializePubKey sPub Resp "dabc" _ OK <- signSendRecv rh rKey ("dabc", rId, keyCmd) + (_, badKey) <- C.generateKeyPair badKeySize Resp "bcda" _ OK <- signSendRecv sh sKey ("bcda", sId, "SEND 5 hello ") - - timeNoQueue <- timeRepeat 25 $ do - Resp "dabc" _ (ERR AUTH) <- signSendRecv sh sKey ("dabc", rId, "SEND 5 hello ") + timeWrongKey <- timeRepeat n $ do + Resp "cdab" _ (ERR AUTH) <- signSendRecv sh badKey ("cdab", sId, "SEND 5 hello ") return () - timeWrongKey <- timeRepeat 25 $ do - Resp "cdab" _ (ERR AUTH) <- signSendRecv sh rKey ("cdab", sId, "SEND 5 hello ") + timeNoQueue <- timeRepeat n $ do + Resp "dabc" _ (ERR AUTH) <- signSendRecv sh badKey ("dabc", "1234", "SEND 5 hello ") return () - abs (timeNoQueue - timeWrongKey) / timeNoQueue < 0.15 `shouldBe` True - where - timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const + Resp "" _ (MSG _ _ "hello") <- tGet fromServer rh + similarTime timeNoQueue timeWrongKey samplePubKey :: ByteString samplePubKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj+toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP+Tm4sokaFDTIG3QJFzOjC+/9nW4MUjAOFll9PCp9kaEFHJ/YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju/f6kAayvYKW3/lbJNXCmyinAccBosO08/0sUxvtuniIo18kfYJE0UmP1ReCjhMP+O+yOmwZJini/QelJk/Pez8IIDDWnY1qYQsN/q7ocjakOYrpGG7mig6JMFpDJtD6istR" +sampleSig :: ByteString +sampleSig = "\128\207*\159eq\220i!\"\157\161\130\184\226\246\232_\\\170`\180\160\230sI\154\197\211\252\SUB\246\206ELL\t9K\ESC\196?\128\215%\222\148\NAK;9\155f\164\217e\242\156\CAN9\253\r\170\174'w\211\228?\205)\215\150\255\247z\DC115\DC1{\bn\145\rKD,K\230\202d8\233\167|7y\t_S\EM\248\EOT\216\172\167d\181\224)\137\ACKo\197j#c\217\243\228.\167\228\205\144\vr\134" + 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 " <> samplePubKey) >#> ("", "cdab", "", "ERR CMD SYNTAX") + it "no parameters" $ (sampleSig, "bcda", "", "NEW") >#> ("", "bcda", "", "ERR CMD SYNTAX") + it "many parameters" $ (sampleSig, "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") + it "queue ID" $ (sampleSig, "abcd", "12345678", "NEW " <> samplePubKey) >#> ("", "abcd", "12345678", "ERR CMD HAS_AUTH") describe "KEY" do - 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 " <> samplePubKey) >#> ("", "dabc", "12345678", "ERR CMD SYNTAX") + it "valid syntax" $ (sampleSig, "bcda", "12345678", "KEY " <> samplePubKey) >#> ("", "bcda", "12345678", "ERR AUTH") + it "no parameters" $ (sampleSig, "cdab", "12345678", "KEY") >#> ("", "cdab", "12345678", "ERR CMD SYNTAX") + it "many parameters" $ (sampleSig, "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") + it "no queue ID" $ (sampleSig, "bcda", "", "KEY " <> samplePubKey) >#> ("", "bcda", "", "ERR CMD NO_AUTH") noParamsSyntaxTest "SUB" noParamsSyntaxTest "ACK" noParamsSyntaxTest "OFF" noParamsSyntaxTest "DEL" describe "SEND" do - it "valid syntax 1" $ ("1234", "cdab", "12345678", "SEND 5 hello ") >#> ("", "cdab", "12345678", "ERR AUTH") - it "valid syntax 2" $ ("1234", "dabc", "12345678", "SEND 11 hello there ") >#> ("", "dabc", "12345678", "ERR AUTH") - it "no parameters" $ ("1234", "abcd", "12345678", "SEND") >#> ("", "abcd", "12345678", "ERR CMD SYNTAX") - it "no queue ID" $ ("1234", "bcda", "", "SEND 5 hello ") >#> ("", "bcda", "", "ERR CMD NO_QUEUE") - it "bad message body 1" $ ("1234", "cdab", "12345678", "SEND 11 hello ") >#> ("", "cdab", "12345678", "ERR CMD SYNTAX") - it "bad message body 2" $ ("1234", "dabc", "12345678", "SEND hello ") >#> ("", "dabc", "12345678", "ERR CMD SYNTAX") - it "bigger body" $ ("1234", "abcd", "12345678", "SEND 4 hello ") >#> ("", "abcd", "12345678", "ERR CMD SYNTAX") + it "valid syntax 1" $ (sampleSig, "cdab", "12345678", "SEND 5 hello ") >#> ("", "cdab", "12345678", "ERR AUTH") + it "valid syntax 2" $ (sampleSig, "dabc", "12345678", "SEND 11 hello there ") >#> ("", "dabc", "12345678", "ERR AUTH") + it "no parameters" $ (sampleSig, "abcd", "12345678", "SEND") >#> ("", "abcd", "12345678", "ERR CMD SYNTAX") + it "no queue ID" $ (sampleSig, "bcda", "", "SEND 5 hello ") >#> ("", "bcda", "", "ERR CMD NO_QUEUE") + it "bad message body 1" $ (sampleSig, "cdab", "12345678", "SEND 11 hello ") >#> ("", "cdab", "12345678", "ERR CMD SYNTAX") + it "bad message body 2" $ (sampleSig, "dabc", "12345678", "SEND hello ") >#> ("", "dabc", "12345678", "ERR CMD SYNTAX") + it "bigger body" $ (sampleSig, "abcd", "12345678", "SEND 4 hello ") >#> ("", "abcd", "12345678", "ERR CMD SYNTAX") describe "PING" do it "valid syntax" $ ("", "abcd", "", "PING") >#> ("", "abcd", "", "PONG") describe "broker response not allowed" do - it "OK" $ ("1234", "bcda", "12345678", "OK") >#> ("", "bcda", "12345678", "ERR CMD PROHIBITED") + it "OK" $ (sampleSig, "bcda", "12345678", "OK") >#> ("", "bcda", "12345678", "ERR CMD PROHIBITED") where noParamsSyntaxTest :: ByteString -> Spec noParamsSyntaxTest cmd = describe (B.unpack cmd) do - it "valid syntax" $ ("1234", "abcd", "12345678", cmd) >#> ("", "abcd", "12345678", "ERR AUTH") - it "wrong terminator" $ ("1234", "bcda", "12345678", cmd <> "=") >#> ("", "bcda", "12345678", "ERR CMD SYNTAX") + it "valid syntax" $ (sampleSig, "abcd", "12345678", cmd) >#> ("", "abcd", "12345678", "ERR AUTH") + it "wrong terminator" $ (sampleSig, "bcda", "12345678", cmd <> "=") >#> ("", "bcda", "12345678", "ERR CMD SYNTAX") it "no signature" $ ("", "cdab", "12345678", cmd) >#> ("", "cdab", "12345678", "ERR CMD NO_AUTH") - it "no queue ID" $ ("1234", "dabc", "", cmd) >#> ("", "dabc", "", "ERR CMD NO_AUTH") + it "no queue ID" $ (sampleSig, "dabc", "", cmd) >#> ("", "dabc", "", "ERR CMD NO_AUTH")