mitigate timing attack to determine if queue exists (#117)

* mitigate timing attack to determine if queue exists

* remove timing for authenticated SEND command

Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>

package.yaml

@@ -87,6 +87,7 @@ tests:
       - HUnit == 1.6.*
       - random == 1.1.*
       - QuickCheck == 2.13.*
+      - timeit == 2.0.*
 
 ghc-options:
   # - -haddock

src/Simplex/Messaging/Protocol.hs

@@ -251,7 +251,7 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate
       Cmd SBroker _
         | B.null queueId -> Left $ CMD NO_QUEUE
         | otherwise -> Right cmd
-      -- NEW must NOT have signature or queue ID
+      -- NEW must have signature but NOT queue ID
       Cmd SRecipient (NEW _)
         | B.null signature -> Left $ CMD NO_AUTH
         | not (B.null queueId) -> Left $ CMD HAS_AUTH

src/Simplex/Messaging/Server.hs

@@ -108,25 +108,27 @@ 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 _ -> withQueueRec SRecipient $ verifySignature . recipientKey
-    Cmd SSender (SEND _) -> withQueueRec SSender $ verifySend sig . senderKey
+    Cmd SRecipient _ -> verifyCmd SRecipient $ verifySignature . recipientKey
+    Cmd SSender (SEND _) -> verifyCmd SSender $ verifySend sig . senderKey
     Cmd SSender PING -> return cmd
   where
-    withQueueRec :: SParty (p :: Party) -> (QueueRec -> Cmd) -> m Cmd
-    withQueueRec party f = do
+    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
-      qr <- atomically $ getQueue st party queueId
-      return $ either smpErr f qr
+      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
     verifySend :: C.Signature -> Maybe SenderPublicKey -> Cmd
     verifySend "" = maybe cmd (const authErr)
     verifySend _ = maybe authErr verifySignature
     verifySignature :: C.PublicKey -> Cmd
-    verifySignature key =
-      if C.verify key sig (serializeTransmission t)
-        then cmd
-        else authErr
-
-    smpErr e = Cmd SBroker $ ERR e
+    verifySignature key = if verify key then cmd else authErr
+    verify :: C.PublicKey -> Bool
+    verify key = C.verify key sig (serializeTransmission t)
+    smpErr :: ErrorType -> Cmd
+    smpErr = Cmd SBroker . ERR
     authErr = smpErr AUTH
 
 client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m ()

tests/ServerTests.hs

@@ -11,7 +11,7 @@ module ServerTests where
 import Control.Concurrent (ThreadId, killThread)
 import Control.Concurrent.STM
 import Control.Exception (SomeException, try)
-import Control.Monad.Except (runExceptT)
+import Control.Monad.Except (forM_, runExceptT)
 import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -20,12 +20,13 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport
 import System.Directory (removeFile)
+import System.TimeIt (timeItT)
 import System.Timeout
 import Test.HUnit
 import Test.Hspec
 
 rsaKeySize :: Int
-rsaKeySize = 1024 `div` 8
+rsaKeySize = 2048 `div` 8
 
 serverTests :: Spec
 serverTests = do
@@ -37,6 +38,7 @@ serverTests = do
     describe "duplex communication over 2 SMP connections" testDuplex
     describe "switch subscription to another SMP queue" testSwitchSub
   describe "Store log" testWithStoreLog
+  describe "Timing of AUTH error" testTiming
 
 pattern Resp :: CorrId -> QueueId -> Command 'Broker -> SignedTransmissionOrError
 pattern Resp corrId queueId command <- ("", (corrId, queueId, Right (Cmd SBroker command)))
@@ -330,6 +332,29 @@ testWithStoreLog =
         Right l -> pure l
         Left (_ :: SomeException) -> logSize
 
+testTiming :: Spec
+testTiming =
+  it "should have similar time for auth error whether queue exists or not" $
+    smpTest2 \rh sh -> do
+      (rPub, rKey) <- C.generateKeyPair rsaKeySize
+      Resp "abcd" "" (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
+
+      (sPub, sKey) <- C.generateKeyPair rsaKeySize
+      let keyCmd = "KEY " <> C.serializePubKey sPub
+      Resp "dabc" _ OK <- signSendRecv rh rKey ("dabc", rId, keyCmd)
+
+      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 ")
+        return ()
+      timeWrongKey <- timeRepeat 25 $ do
+        Resp "cdab" _ (ERR AUTH) <- signSendRecv sh rKey ("cdab", sId, "SEND 5 hello ")
+        return ()
+      abs (timeNoQueue - timeWrongKey) / timeNoQueue < 0.15 `shouldBe` True
+  where
+    timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
+
 samplePubKey :: ByteString
 samplePubKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj+toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP+Tm4sokaFDTIG3QJFzOjC+/9nW4MUjAOFll9PCp9kaEFHJ/YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju/f6kAayvYKW3/lbJNXCmyinAccBosO08/0sUxvtuniIo18kfYJE0UmP1ReCjhMP+O+yOmwZJini/QelJk/Pez8IIDDWnY1qYQsN/q7ocjakOYrpGG7mig6JMFpDJtD6istR"