From 057d5eeb2478a737667aecb3d19fdb084c62ef18 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sun, 24 Oct 2021 21:03:41 +0100 Subject: [PATCH 01/13] AES encription with auth tag after cypher text (the order in WebCrypto etc.); upgrade GHC to 8.10.7 (#197) --- package.yaml | 2 +- simplexmq.cabal | 10 ++++------ src/Simplex/Messaging/Transport.hs | 6 +++--- stack.yaml | 2 +- 4 files changed, 9 insertions(+), 11 deletions(-) diff --git a/package.yaml b/package.yaml index 85eb6eb29..03f60c6de 100644 --- a/package.yaml +++ b/package.yaml @@ -37,7 +37,7 @@ dependencies: - cryptonite >= 0.27 && < 0.30 - direct-sqlite == 2.3.* - directory == 1.3.* - - file-embed == 0.0.14.* + - file-embed >= 0.0.14.0 && <= 0.0.15.0 - filepath == 1.4.* - generic-random >= 1.3 && < 1.5 - iso8601-time == 0.1.* diff --git a/simplexmq.cabal b/simplexmq.cabal index 82e187ce0..aeea86e98 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -3,8 +3,6 @@ cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack --- --- hash: 706d2f9155c3f3be0f08ea0d6c8954c0e2b9a6e22615f7b19499a3a349af7cc9 name: simplexmq version: 0.4.1 @@ -78,7 +76,7 @@ library , cryptonite >=0.27 && <0.30 , direct-sqlite ==2.3.* , directory ==1.3.* - , file-embed ==0.0.14.* + , file-embed >=0.0.14.0 && <=0.0.15.0 , filepath ==1.4.* , generic-random >=1.3 && <1.5 , iso8601-time ==0.1.* @@ -123,7 +121,7 @@ executable smp-agent , cryptonite >=0.27 && <0.30 , direct-sqlite ==2.3.* , directory ==1.3.* - , file-embed ==0.0.14.* + , file-embed >=0.0.14.0 && <=0.0.15.0 , filepath ==1.4.* , generic-random >=1.3 && <1.5 , iso8601-time ==0.1.* @@ -170,7 +168,7 @@ executable smp-server , cryptostore ==0.2.* , direct-sqlite ==2.3.* , directory ==1.3.* - , file-embed ==0.0.14.* + , file-embed >=0.0.14.0 && <=0.0.15.0 , filepath ==1.4.* , generic-random >=1.3 && <1.5 , ini ==0.4.* @@ -227,7 +225,7 @@ test-suite smp-server-test , cryptonite >=0.27 && <0.30 , direct-sqlite ==2.3.* , directory ==1.3.* - , file-embed ==0.0.14.* + , file-embed >=0.0.14.0 && <=0.0.15.0 , filepath ==1.4.* , generic-random >=1.3 && <1.5 , hspec ==2.7.* diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index f881af3ec..06382563c 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -191,7 +191,7 @@ instance Transport TCP where transportName _ = "TCP" getServerConnection = fmap TCP . getSocketHandle getClientConnection = getServerConnection - closeConnection = hClose . tcpHandle + closeConnection (TCP h) = hClose h `E.catch` \(_ :: E.SomeException) -> pure () cGet = B.hGet . tcpHandle cPut = B.hPut . tcpHandle getLn = fmap trimCR . B.hGetLine . tcpHandle @@ -310,7 +310,7 @@ tPutEncrypted :: Transport c => THandle c -> ByteString -> IO (Either TransportE tPutEncrypted THandle {connection = c, sndKey, blockSize} block = encryptBlock sndKey (blockSize - C.authTagSize) block >>= \case Left _ -> pure $ Left TEEncrypt - Right (authTag, msg) -> Right <$> cPut c (C.authTagToBS authTag <> msg) + Right (authTag, msg) -> Right <$> cPut c (msg <> C.authTagToBS authTag) -- | Receive and decrypt block from SMP encrypted transport. tGetEncrypted :: Transport c => THandle c -> IO (Either TransportError ByteString) @@ -327,7 +327,7 @@ encryptBlock k@SessionKey {aesKey} size block = do decryptBlock :: SessionKey -> ByteString -> IO (Either C.CryptoError ByteString) decryptBlock k@SessionKey {aesKey} block = do - let (authTag, msg') = B.splitAt C.authTagSize block + let (msg', authTag) = B.splitAt (B.length block - C.authTagSize) block ivBytes <- makeNextIV k runExceptT $ C.decryptAES aesKey ivBytes msg' (C.bsToAuthTag authTag) diff --git a/stack.yaml b/stack.yaml index 70267dd80..945175a35 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,7 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: lts-18.0 +resolver: lts-18.13 # User packages to be built. # Various formats can be used as shown in the example below. From 227d83d0e79b54b6df35f7f6fb0eb3a27fff24ee Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sun, 14 Nov 2021 18:52:29 +0000 Subject: [PATCH 02/13] SMP commands for notifications (NKEY/NID and NSUB/NMSG) with separate queue ID and key (#199) * SMP commands for notifications (LSTN, NTFY) with separate queue IDs and keys * rename Notifier types * remove notify key and id from NEW and IDS commands (TODO add other commands) * fix StoreLog serialization * add commands for managing notifications * add notification subscribers to server state, add notifier ID and key to store log * add notifier ID and key to the queue * refactor END notification to work for both types of subscriptions, deliver message notification (NMSG) * process NSUB command - subscribe to message notifications * test for message notifications * fix SMP client function for NSUB command * fix parse/serialize NID command * refactor use ifM * check duplicate notifier ID only against other notifier IDs * refactor getQueue * test notifier ID and key with store log * Update src/Simplex/Messaging/Client.hs Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> * Update src/Simplex/Messaging/Server.hs Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> * store log: s/NOTIFY/NOTIFIER/ Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> --- protocol/simplex-messaging.md | 81 +++++++++++- src/Simplex/Messaging/Client.hs | 19 ++- src/Simplex/Messaging/Protocol.hs | 45 ++++++- src/Simplex/Messaging/Server.hs | 122 ++++++++++++------ src/Simplex/Messaging/Server/Env/STM.hs | 24 +++- src/Simplex/Messaging/Server/QueueStore.hs | 7 +- .../Messaging/Server/QueueStore/STM.hs | 48 +++++-- src/Simplex/Messaging/Server/StoreLog.hs | 17 ++- src/Simplex/Messaging/Util.hs | 10 ++ tests/SMPClient.hs | 6 + tests/ServerTests.hs | 60 +++++++-- 11 files changed, 356 insertions(+), 83 deletions(-) diff --git a/protocol/simplex-messaging.md b/protocol/simplex-messaging.md index 884ae98ec..7818773d6 100644 --- a/protocol/simplex-messaging.md +++ b/protocol/simplex-messaging.md @@ -11,7 +11,8 @@ - [SMP qualities and features](#smp-qualities-and-features) - [Cryptographic algorithms](#cryptographic-algorithms) - [Simplex queue IDs](#simplex-queue-ids) -- [Server privacy requirements](#server-privacy-requirements) +- [Server security requirements](#server-security-requirements) +- [Message delivery notifications](#message-delivery-notifications) - [SMP commands](#smp-commands) - [Correlating responses with commands](#correlating-responses-with-commands) - [Command authentication](#command-authentication) @@ -20,14 +21,19 @@ - [Create queue command](#create-queue-command) - [Subscribe to queue](#subscribe-to-queue) - [Secure queue command](#secure-queue-command) + - [Enable notifications command](#enable-notifications-command) - [Acknowledge message delivery](#acknowledge-message-delivery) - [Suspend queue](#suspend-queue) - [Delete queue](#delete-queue) - [Sender commands](#sender-commands) - [Send message](#send-message) + - [Notifier commands](#notifier-commands) + - [Subscribe to queue notifications](#subscribe-to-queue-notifications) - [Server messages](#server-messages) - [Queue IDs response](#queue-ids-response) - [Deliver queue message](#deliver-queue-message) + - [Notifier queue ID response](#notifier-queue-id-response) + - [Deliver message notification](#deliver-message-notification) - [Subscription END notification](#subscription-end-notification) - [Error responses](#error-responses) - [OK response](#ok-response) @@ -280,11 +286,14 @@ Simplex messaging clients need to cryptographically sign commands for the follow - create the queue (`NEW`) - subscribe to queue (`SUB`) - secure the queue (`KEY`) + - enable queue notifications (`NKEY`) - acknowledge received messages (`ACK`) - suspend the queue (`OFF`) - delete the queue (`DEL`) - With the sender's key `SK` (server to verify): - send messages (`SEND`) +- With the optional notifier's key: + - subscribe to message notifications (`NSUB`) To sign and verify commands, clients and servers MUST use RSA-PSS algorithm defined in [RFC3447][2]. @@ -319,6 +328,18 @@ Simplex messaging server implementations MUST NOT create, store or send to any o - Any other information that may compromise privacy or [forward secrecy][4] of communication between clients using simplex messaging servers. +## Message delivery notifications + +Supporting message delivery while the client mobile app is not running requires sending push notifications with the device token. All alternative mechanisms for background message delivery are unreliable, particularly on iOS platform. Obviously, supporting push notification delivery by simply subscribing to messages would reduce meta-data privacy as it allows to see all queues that a given device uses. + +To protect the privacy of the recipients, there are several commands in SMP protocol that allow enabling and subscribing to message notifications from SMP queues, using separate set of "notifier keys" and via separate queue IDs - as long as SMP server is not compromised, these notifier queue IDs cannot be correlated with recipient or sender queue IDs. + +The clients can optionally instruct a dedicated push notification server to subscribe to notifications and deliver push notifications to the device, which can then retrieve the messages in the background and send local notifications to the user - this is out of scope of SMP protocol. The commands that SMP protocol provides to allow it: + +- `enableNotifications` (`"NKEY"`) with `notifierId` (`"NID"`) response - see [Enable notifications command](#enable-notifications-command). +- `subscribeNotifications` (`"NSUB"`) - see [Subscribe to queue notifications](#subscribe-to-queue-notifications). +- `messageNotification` (`"NMSG"`) - see [Deliver message notification](#deliver-message-notification). + ## SMP commands Commands syntax below is provided using [ABNF][8] with [case-sensitive strings extension][8a]. @@ -328,9 +349,11 @@ Each transmission between the client and the server must have this format/syntax ```abnf transmission = [signature] SP signed SP pad ; pad to the fixed block size signed = [corrId] SP [queueId] SP cmd -cmd = ping / recipientCmd / send / serverMsg -recipientCmd = create / subscribe / secure / acknowledge / suspend / delete -serverMsg = pong / queueIds / message / unsubscribed / ok / error +cmd = ping / recipientCmd / send / subscribeNotifications / serverMsg +recipientCmd = create / subscribe / secure / enableNotifications / + acknowledge / suspend / delete +serverMsg = pong / queueIds / message / notifierId / messageNotification / + unsubscribed / ok / error corrId = 1*(%x21-7F) ; any characters other than control/whitespace queueId = encoded ; empty queue ID is used with "create" command signature = encoded @@ -414,6 +437,26 @@ senderKey = %s"rsa:" x509encoded ; the sender's RSA public key for this queue Once the queue is secured only signed messages can be sent to it. +#### Enable notifications command + +This command is sent by the recipient to the server to add notifier's key to the queue, to allow push notifications server to receive notifications when the message arrives, via a separate queue ID, without receiving message content. + +```abnf +enableNotifications = %s"NKEY" SP notifierKey +notifierKey = %s"rsa:" x509encoded ; the notifier's RSA public key for this queue +``` + +The server will respond with `notifierId` response if notifications were enabled and the notifier's key was successfully added to the queue: + +```abnf +notifierId = %s"NID" SP notifierId +recipientId = encoded +``` + +This response is sent with the recipient's queue ID (the second part of the transmission). + +To receive the message notifications, `subscribeNotifications` command ("NSUB") must be sent signed with the notifier's key. + #### Acknowledge message delivery The recipient should send the acknowledgement of message delivery once the message was stored in the client, to notify the server that the message should be deleted: @@ -491,6 +534,20 @@ clientBody = *OCTET `clientHeader` in the initial unsigned message is used to transmit sender's server key and can be used in the future revisions of SMP protocol for other purposes. +### Notifier commands + +#### Subscribe to queue notifications + +The push notifications server (notifier) must use this command to start receiving message notifications from the queue: + +```abnf +subscribeNotifications = %s"NSUB" +``` + +If subscription is successful the server must respond with `ok` response if no messages are available. The notifier will be receiving the message notifications from this queue until the transport connection is closed or until another transport connection subscribes to notifications from the same simplex queue - in this case the first subscription should be cancelled and [subscription END notification](#subscription-end-notification) delivered. + +The first message notification will be delivered either immediately or as soon as the message is available. + ### Server messages #### Queue IDs response @@ -515,6 +572,22 @@ timestamp = `binaryMsg` - see syntax in [Send message](#send-message) +#### Notifier queue ID response + +Server must respond with this message when queue notifications are enabled. + +See its syntax in [Enable notifications command](#enable-notifications-command) + +#### Deliver message notification + +The server must deliver message notifications to all simplex queues that were subscribed with `subscribeNotifications` command ("NSUB") on the currently open transport connection. The syntax for the message notification delivery is: + +```abnf +messageNotification = %s"NMSG" +``` + +Message notification does not contain any message data or meta-data, it only notifies that the message is available. + #### Subscription END notification When another transport connection is subscribed to the same simplex queue, the server should unsubscribe and to send the notification to the previously subscribed transport connection: diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index 87b340aae..f39dc2e05 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -30,7 +30,9 @@ module Simplex.Messaging.Client -- * SMP protocol command functions createSMPQueue, subscribeSMPQueue, + subscribeSMPQueueNotifications, secureSMPQueue, + enableSMPQueueNotifications, sendSMPMessage, ackSMPMessage, suspendSMPQueue, @@ -263,7 +265,7 @@ createSMPQueue :: createSMPQueue c rpKey rKey = -- TODO add signing this request too - requires changes in the server sendSMPCommand c (Just rpKey) "" (Cmd SRecipient $ NEW rKey) >>= \case - Cmd _ (IDS rId sId) -> return (rId, sId) + Cmd _ (IDS rId sId) -> pure (rId, sId) _ -> throwE SMPUnexpectedResponse -- | Subscribe to the SMP queue. @@ -277,12 +279,27 @@ subscribeSMPQueue c@SMPClient {smpServer, msgQ} rpKey rId = lift . atomically $ writeTBQueue msgQ (smpServer, rId, cmd) _ -> throwE SMPUnexpectedResponse +-- | Subscribe to the SMP queue notifications. +-- +-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#subscribe-to-queue-notifications +subscribeSMPQueueNotifications :: SMPClient -> NotifierPrivateKey -> NotifierId -> ExceptT SMPClientError IO () +subscribeSMPQueueNotifications = okSMPCommand $ Cmd SNotifier NSUB + -- | Secure the SMP queue by adding a sender public key. -- -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#secure-queue-command secureSMPQueue :: SMPClient -> RecipientPrivateKey -> RecipientId -> SenderPublicKey -> ExceptT SMPClientError IO () secureSMPQueue c rpKey rId senderKey = okSMPCommand (Cmd SRecipient $ KEY senderKey) c rpKey rId +-- | Enable notifications for the queue for push notifications server. +-- +-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#enable-notifications-command +enableSMPQueueNotifications :: SMPClient -> RecipientPrivateKey -> RecipientId -> NotifierPublicKey -> ExceptT SMPClientError IO NotifierId +enableSMPQueueNotifications c rpKey rId notifierKey = + sendSMPCommand c (Just rpKey) rId (Cmd SRecipient $ NKEY notifierKey) >>= \case + Cmd _ (NID nId) -> pure nId + _ -> throwE SMPUnexpectedResponse + -- | Send SMP message. -- -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#send-message diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 85d6e8369..02056acc4 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -39,10 +39,13 @@ module Simplex.Messaging.Protocol QueueId, RecipientId, SenderId, + NotifierId, RecipientPrivateKey, RecipientPublicKey, SenderPrivateKey, SenderPublicKey, + NotifierPrivateKey, + NotifierPublicKey, Encoded, MsgId, MsgBody, @@ -85,7 +88,7 @@ import Simplex.Messaging.Util import Test.QuickCheck (Arbitrary (..)) -- | SMP protocol participants. -data Party = Broker | Recipient | Sender +data Party = Broker | Recipient | Sender | Notifier deriving (Show) -- | Singleton types for SMP protocol participants. @@ -93,6 +96,7 @@ data SParty :: Party -> Type where SBroker :: SParty Broker SRecipient :: SParty Recipient SSender :: SParty Sender + SNotifier :: SParty Notifier deriving instance Show (SParty a) @@ -124,6 +128,9 @@ type RecipientId = QueueId -- | SMP queue ID for the sender. type SenderId = QueueId +-- | SMP queue ID for notifications. +type NotifierId = QueueId + -- | SMP queue ID on the server. type QueueId = Encoded @@ -133,15 +140,20 @@ data Command (a :: Party) where NEW :: RecipientPublicKey -> Command Recipient SUB :: Command Recipient KEY :: SenderPublicKey -> Command Recipient + NKEY :: NotifierPublicKey -> Command Recipient ACK :: Command Recipient OFF :: Command Recipient DEL :: Command Recipient -- SMP sender commands SEND :: MsgBody -> Command Sender PING :: Command Sender + -- SMP notification subscriber commands + NSUB :: Command Notifier -- SMP broker commands (responses, messages, notifications) IDS :: RecipientId -> SenderId -> Command Broker MSG :: MsgId -> UTCTime -> MsgBody -> Command Broker + NID :: NotifierId -> Command Broker + NMSG :: Command Broker END :: Command Broker OK :: Command Broker ERR :: ErrorType -> Command Broker @@ -178,6 +190,12 @@ type SenderPrivateKey = C.SafePrivateKey -- | Sender's public key used by SMP server to verify authorization of SMP commands. type SenderPublicKey = C.PublicKey +-- | Private key used by push notifications server to authorize (sign) LSTN command. +type NotifierPrivateKey = C.SafePrivateKey + +-- | Public key used by SMP server to verify authorization of LSTN command sent by push notifications server. +type NotifierPublicKey = C.PublicKey + -- | SMP message server ID. type MsgId = Encoded @@ -240,12 +258,16 @@ commandP = <|> "IDS " *> idsResp <|> "SUB" $> Cmd SRecipient SUB <|> "KEY " *> keyCmd + <|> "NKEY " *> nKeyCmd + <|> "NID " *> nIdsResp <|> "ACK" $> Cmd SRecipient ACK <|> "OFF" $> Cmd SRecipient OFF <|> "DEL" $> Cmd SRecipient DEL <|> "SEND " *> sendCmd <|> "PING" $> Cmd SSender PING + <|> "NSUB" $> Cmd SNotifier NSUB <|> "MSG " *> message + <|> "NMSG" $> Cmd SBroker NMSG <|> "END" $> Cmd SBroker END <|> "OK" $> Cmd SBroker OK <|> "ERR " *> serverError @@ -253,7 +275,9 @@ commandP = where newCmd = Cmd SRecipient . NEW <$> C.pubKeyP idsResp = Cmd SBroker <$> (IDS <$> (base64P <* A.space) <*> base64P) + nIdsResp = Cmd SBroker . NID <$> base64P keyCmd = Cmd SRecipient . KEY <$> C.pubKeyP + nKeyCmd = Cmd SRecipient . NKEY <$> C.pubKeyP sendCmd = do size <- A.decimal <* A.space Cmd SSender . SEND <$> A.take size <* A.space @@ -275,14 +299,23 @@ serializeCommand :: Cmd -> ByteString serializeCommand = \case Cmd SRecipient (NEW rKey) -> "NEW " <> C.serializePubKey rKey Cmd SRecipient (KEY sKey) -> "KEY " <> C.serializePubKey sKey - Cmd SRecipient cmd -> bshow cmd + Cmd SRecipient (NKEY nKey) -> "NKEY " <> C.serializePubKey nKey + Cmd SRecipient SUB -> "SUB" + Cmd SRecipient ACK -> "ACK" + Cmd SRecipient OFF -> "OFF" + Cmd SRecipient DEL -> "DEL" Cmd SSender (SEND msgBody) -> "SEND " <> serializeMsg msgBody Cmd SSender PING -> "PING" + Cmd SNotifier NSUB -> "NSUB" Cmd SBroker (MSG msgId ts msgBody) -> B.unwords ["MSG", encode msgId, B.pack $ formatISO8601Millis ts, serializeMsg msgBody] Cmd SBroker (IDS rId sId) -> B.unwords ["IDS", encode rId, encode sId] + Cmd SBroker (NID nId) -> "NID " <> encode nId Cmd SBroker (ERR err) -> "ERR " <> serializeErrorType err - Cmd SBroker resp -> bshow resp + Cmd SBroker NMSG -> "NMSG" + Cmd SBroker END -> "END" + Cmd SBroker OK -> "OK" + Cmd SBroker PONG -> "PONG" where serializeMsg msgBody = bshow (B.length msgBody) <> " " <> msgBody <> " " @@ -350,7 +383,7 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate tCredentials :: RawTransmission -> Cmd -> Either ErrorType Cmd tCredentials (signature, _, queueId, _) cmd = case cmd of -- IDS response must not have queue ID - Cmd SBroker (IDS _ _) -> Right cmd + Cmd SBroker IDS {} -> Right cmd -- ERR response does not always have queue ID Cmd SBroker (ERR _) -> Right cmd -- PONG response must not have queue ID @@ -362,7 +395,7 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate | B.null queueId -> Left $ CMD NO_QUEUE | otherwise -> Right cmd -- NEW must have signature but NOT queue ID - Cmd SRecipient (NEW _) + Cmd SRecipient NEW {} | B.null signature -> Left $ CMD NO_AUTH | not (B.null queueId) -> Left $ CMD HAS_AUTH | otherwise -> Right cmd @@ -375,6 +408,6 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate | B.null queueId && B.null signature -> Right cmd | otherwise -> Left $ CMD HAS_AUTH -- other client commands must have both signature and queue ID - Cmd SRecipient _ + Cmd _ _ | B.null signature || B.null queueId -> Left $ CMD NO_AUTH | otherwise -> Right cmd diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 8c475f9d1..3d4cd634c 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -35,6 +35,7 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Functor (($>)) import qualified Data.Map.Strict as M +import Data.Maybe (isNothing) import Data.Time.Clock import Network.Socket (ServiceName) import qualified Simplex.Messaging.Crypto as C @@ -72,20 +73,38 @@ runSMPServerBlocking started cfg@ServerConfig {transports} = do smpServer :: (MonadUnliftIO m', MonadReader Env m') => m' () smpServer = do s <- asks server - raceAny_ (serverThread s : map runServer transports) + raceAny_ + ( serverThread s subscribedQ subscribers subscriptions cancelSub : + serverThread s ntfSubscribedQ notifiers ntfSubscriptions (\_ -> pure ()) : + map runServer transports + ) `finally` withLog closeStoreLog runServer :: (MonadUnliftIO m', MonadReader Env m') => (ServiceName, ATransport) -> m' () runServer (tcpPort, ATransport t) = runTransportServer started tcpPort (runClient t) - serverThread :: MonadUnliftIO m' => Server -> m' () - serverThread Server {subscribedQ, subscribers} = forever . atomically $ do - (rId, clnt) <- readTBQueue subscribedQ - cs <- readTVar subscribers - case M.lookup rId cs of - Just Client {rcvQ} -> writeTBQueue rcvQ (CorrId B.empty, rId, Cmd SBroker END) - Nothing -> return () - writeTVar subscribers $ M.insert rId clnt cs + serverThread :: + forall m' s. + MonadUnliftIO m' => + Server -> + (Server -> TBQueue (QueueId, Client)) -> + (Server -> TVar (M.Map QueueId Client)) -> + (Client -> TVar (M.Map QueueId s)) -> + (s -> m' ()) -> + m' () + serverThread s subQ subs clientSubs unsub = forever $ do + atomically updateSubscribers >>= mapM_ unsub + where + updateSubscribers :: STM (Maybe s) + updateSubscribers = do + (qId, clnt) <- readTBQueue $ subQ s + serverSubs <- readTVar $ subs s + writeTVar (subs s) $ M.insert qId clnt serverSubs + join <$> mapM (endPreviousSubscriptions qId) (M.lookup qId serverSubs) + endPreviousSubscriptions :: QueueId -> Client -> STM (Maybe s) + endPreviousSubscriptions qId c = do + writeTBQueue (rcvQ c) (CorrId B.empty, qId, Cmd SBroker END) + stateTVar (clientSubs c) $ \ss -> (M.lookup qId ss, M.delete qId ss) runClient :: (Transport c, MonadUnliftIO m, MonadReader Env m) => TProxy c -> c -> m () runClient _ h = do @@ -134,17 +153,18 @@ verifyTransmission (sig, t@(corrId, queueId, cmd)) = do Cmd SBroker _ -> return $ smpErr INTERNAL -- it can only be client command, because `fromClient` was used Cmd SRecipient (NEW k) -> pure $ verifySignature k Cmd SRecipient _ -> verifyCmd SRecipient $ verifySignature . recipientKey - Cmd SSender (SEND _) -> verifyCmd SSender $ verifySend sig . senderKey + Cmd SSender (SEND _) -> verifyCmd SSender $ verifyMaybe sig . senderKey Cmd SSender PING -> return cmd + Cmd SNotifier NSUB -> verifyCmd SNotifier $ verifyMaybe sig . fmap snd . notifier where verifyCmd :: SParty p -> (QueueRec -> Cmd) -> m Cmd verifyCmd party f = do st <- asks queueStore q <- atomically $ getQueue st party queueId pure $ either (const $ dummyVerify authErr) f q - verifySend :: C.Signature -> Maybe SenderPublicKey -> Cmd - verifySend "" = maybe cmd (const authErr) - verifySend _ = maybe authErr verifySignature + verifyMaybe :: C.Signature -> Maybe SenderPublicKey -> Cmd + verifyMaybe "" = maybe cmd (const authErr) + verifyMaybe _ = maybe authErr verifySignature verifySignature :: C.PublicKey -> Cmd verifySignature key = if verify key then cmd else authErr verify key @@ -178,48 +198,43 @@ 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} = +client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server {subscribedQ, ntfSubscribedQ, notifiers} = forever $ atomically (readTBQueue rcvQ) >>= processCommand - >>= atomically . writeTBQueue sndQ + >>= atomically . writeTBQueue sndQ' where processCommand :: Transmission -> m Transmission processCommand (corrId, queueId, cmd) = do st <- asks queueStore case cmd of - Cmd SBroker END -> unsubscribeQueue $> (corrId, queueId, cmd) - Cmd SBroker _ -> return (corrId, queueId, cmd) + Cmd SBroker _ -> pure (corrId, queueId, cmd) Cmd SSender command -> case command of SEND msgBody -> sendMessage st msgBody PING -> return (corrId, queueId, Cmd SBroker PONG) + Cmd SNotifier NSUB -> subscribeNotifications Cmd SRecipient command -> case command of NEW rKey -> createQueue st rKey SUB -> subscribeQueue queueId ACK -> acknowledgeMsg KEY sKey -> secureQueue_ st sKey + NKEY nKey -> addQueueNotifier_ st nKey OFF -> suspendQueue_ st DEL -> delQueueAndMsgs st where createQueue :: QueueStore -> RecipientPublicKey -> m Transmission - createQueue st rKey = - checkKeySize rKey addSubscribe + createQueue st rKey = checkKeySize rKey $ addQueueRetry 3 where - addSubscribe = - addQueueRetry 3 >>= \case - Left e -> return $ ERR e - Right (rId, sId) -> do - withLog (`logCreateById` rId) - subscribeQueue rId $> IDS rId sId - - addQueueRetry :: Int -> m (Either ErrorType (RecipientId, SenderId)) - addQueueRetry 0 = return $ Left INTERNAL + addQueueRetry :: Int -> m (Command 'Broker) + addQueueRetry 0 = pure $ ERR INTERNAL addQueueRetry n = do - ids <- getIds + ids@(rId, sId) <- getIds atomically (addQueue st rKey ids) >>= \case Left DUPLICATE_ -> addQueueRetry $ n - 1 - Left e -> return $ Left e - Right _ -> return $ Right ids + Left e -> pure $ ERR e + Right _ -> do + withLog (`logCreateById` rId) + subscribeQueue rId $> IDS rId sId logCreateById :: StoreLog 'WriteMode -> RecipientId -> IO () logCreateById s rId = @@ -237,6 +252,20 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} = withLog $ \s -> logSecureQueue s queueId sKey atomically . checkKeySize sKey $ either ERR (const OK) <$> secureQueue st queueId sKey + addQueueNotifier_ :: QueueStore -> NotifierPublicKey -> m Transmission + addQueueNotifier_ st nKey = checkKeySize nKey $ addNotifierRetry 3 + where + addNotifierRetry :: Int -> m (Command 'Broker) + addNotifierRetry 0 = pure $ ERR INTERNAL + addNotifierRetry n = do + nId <- randomId =<< asks (queueIdBytes . config) + atomically (addQueueNotifier st queueId nId nKey) >>= \case + Left DUPLICATE_ -> addNotifierRetry $ n - 1 + Left e -> pure $ ERR e + Right _ -> do + withLog $ \s -> logAddNotifier s queueId nId nKey + pure $ NID nId + checkKeySize :: Monad m' => C.PublicKey -> m' (Command 'Broker) -> m' Transmission checkKeySize key action = mkResp corrId queueId @@ -264,11 +293,13 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} = writeTVar subscriptions $ M.insert rId s subs return s - unsubscribeQueue :: m () - unsubscribeQueue = do - sub <- atomically . stateTVar subscriptions $ - \cs -> (M.lookup queueId cs, M.delete queueId cs) - mapM_ cancelSub sub + subscribeNotifications :: m Transmission + subscribeNotifications = atomically $ do + subs <- readTVar ntfSubscriptions + when (isNothing $ M.lookup queueId subs) $ do + writeTBQueue ntfSubscribedQ (queueId, clnt) + writeTVar ntfSubscriptions $ M.insert queueId () subs + pure ok acknowledgeMsg :: m Transmission acknowledgeMsg = @@ -300,9 +331,20 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} = quota <- asks $ msgQueueQuota . config atomically $ do q <- getMsgQueue ms (recipientId qr) quota - isFull q >>= \case - False -> writeMsg q msg $> ok - True -> pure $ err QUOTA + ifM (isFull q) (pure $ err QUOTA) $ do + trySendNotification + writeMsg q msg + pure ok + where + trySendNotification :: STM () + trySendNotification = + forM_ (notifier qr) $ \(nId, _) -> + mapM_ (writeNtf nId) . M.lookup nId =<< readTVar notifiers + + writeNtf :: NotifierId -> Client -> STM () + writeNtf nId Client {sndQ} = + unlessM (isFullTBQueue sndQ) $ + writeTBQueue sndQ $ mkResp (CorrId B.empty) nId NMSG deliverMessage :: (MsgQueue -> STM (Maybe Message)) -> RecipientId -> Sub -> m Transmission deliverMessage tryPeek rId = \case @@ -326,7 +368,7 @@ client clnt@Client {subscriptions, rcvQ, sndQ} Server {subscribedQ} = subscriber :: MsgQueue -> m () subscriber q = atomically $ do msg <- peekMsg q - writeTBQueue sndQ $ mkResp (CorrId B.empty) rId (msgCmd msg) + writeTBQueue sndQ' $ mkResp (CorrId B.empty) rId (msgCmd msg) setSub (\s -> s {subThread = NoSub}) void setDelivered diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index 5c397096b..5a0ebacea 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -46,11 +46,14 @@ data Env = Env data Server = Server { subscribedQ :: TBQueue (RecipientId, Client), - subscribers :: TVar (Map RecipientId Client) + subscribers :: TVar (Map RecipientId Client), + ntfSubscribedQ :: TBQueue (NotifierId, Client), + notifiers :: TVar (Map NotifierId Client) } data Client = Client { subscriptions :: TVar (Map RecipientId Sub), + ntfSubscriptions :: TVar (Map NotifierId ()), rcvQ :: TBQueue Transmission, sndQ :: TBQueue Transmission } @@ -66,14 +69,17 @@ newServer :: Natural -> STM Server newServer qSize = do subscribedQ <- newTBQueue qSize subscribers <- newTVar M.empty - return Server {subscribedQ, subscribers} + ntfSubscribedQ <- newTBQueue qSize + notifiers <- newTVar M.empty + return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers} newClient :: Natural -> STM Client newClient qSize = do subscriptions <- newTVar M.empty + ntfSubscriptions <- newTVar M.empty rcvQ <- newTBQueue qSize sndQ <- newTBQueue qSize - return Client {subscriptions, rcvQ, sndQ} + return Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} newSubscription :: STM Sub newSubscription = do @@ -94,7 +100,17 @@ newEnv config = do restoreQueues :: QueueStore -> StoreLog 'ReadMode -> m (StoreLog 'WriteMode) restoreQueues queueStore s = do (queues, s') <- liftIO $ readWriteStoreLog s - atomically $ modifyTVar queueStore $ \d -> d {queues, senders = M.foldr' addSender M.empty queues} + atomically $ + modifyTVar queueStore $ \d -> + d + { queues, + senders = M.foldr' addSender M.empty queues, + notifiers = M.foldr' addNotifier M.empty queues + } pure s' addSender :: QueueRec -> Map SenderId RecipientId -> Map SenderId RecipientId addSender q = M.insert (senderId q) (recipientId q) + addNotifier :: QueueRec -> Map NotifierId RecipientId -> Map NotifierId RecipientId + addNotifier q = case notifier q of + Nothing -> id + Just (nId, _) -> M.insert nId (recipientId q) diff --git a/src/Simplex/Messaging/Server/QueueStore.hs b/src/Simplex/Messaging/Server/QueueStore.hs index 79eb2daee..a59a60446 100644 --- a/src/Simplex/Messaging/Server/QueueStore.hs +++ b/src/Simplex/Messaging/Server/QueueStore.hs @@ -8,10 +8,11 @@ module Simplex.Messaging.Server.QueueStore where import Simplex.Messaging.Protocol data QueueRec = QueueRec - { recipientId :: QueueId, - senderId :: QueueId, + { recipientId :: RecipientId, + senderId :: SenderId, recipientKey :: RecipientPublicKey, senderKey :: Maybe SenderPublicKey, + notifier :: Maybe (NotifierId, NotifierPublicKey), status :: QueueStatus } @@ -21,6 +22,7 @@ class MonadQueueStore s m where addQueue :: s -> RecipientPublicKey -> (RecipientId, SenderId) -> m (Either ErrorType ()) getQueue :: s -> SParty (a :: Party) -> QueueId -> m (Either ErrorType QueueRec) secureQueue :: s -> RecipientId -> SenderPublicKey -> m (Either ErrorType ()) + addQueueNotifier :: s -> RecipientId -> NotifierId -> NotifierPublicKey -> m (Either ErrorType ()) suspendQueue :: s -> RecipientId -> m (Either ErrorType ()) deleteQueue :: s -> RecipientId -> m (Either ErrorType ()) @@ -31,5 +33,6 @@ mkQueueRec recipientKey (recipientId, senderId) = senderId, recipientKey, senderKey = Nothing, + notifier = Nothing, status = QueueActive } diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs index 86caff78f..a4da5ec10 100644 --- a/src/Simplex/Messaging/Server/QueueStore/STM.hs +++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs @@ -19,13 +19,14 @@ import UnliftIO.STM data QueueStoreData = QueueStoreData { queues :: Map RecipientId QueueRec, - senders :: Map SenderId RecipientId + senders :: Map SenderId RecipientId, + notifiers :: Map NotifierId RecipientId } type QueueStore = TVar QueueStoreData newQueueStore :: STM QueueStore -newQueueStore = newTVar QueueStoreData {queues = M.empty, senders = M.empty} +newQueueStore = newTVar QueueStoreData {queues = M.empty, senders = M.empty, notifiers = M.empty} instance MonadQueueStore QueueStore STM where addQueue :: QueueStore -> RecipientPublicKey -> (RecipientId, SenderId) -> STM (Either ErrorType ()) @@ -42,22 +43,47 @@ instance MonadQueueStore QueueStore STM where return $ Right () getQueue :: QueueStore -> SParty (p :: Party) -> QueueId -> STM (Either ErrorType QueueRec) - getQueue store SRecipient rId = do - cs <- readTVar store - return $ getRcpQueue cs rId - getQueue store SSender sId = do - cs <- readTVar store - let rId = M.lookup sId $ senders cs - return $ maybe (Left AUTH) (getRcpQueue cs) rId - getQueue _ SBroker _ = - return $ Left INTERNAL + getQueue st party qId = do + cs <- readTVar st + pure $ case party of + SRecipient -> getRcpQueue cs qId + SSender -> getPartyQueue cs senders + SNotifier -> getPartyQueue cs notifiers + SBroker -> Left INTERNAL + where + getPartyQueue :: + QueueStoreData -> + (QueueStoreData -> Map QueueId RecipientId) -> + Either ErrorType QueueRec + getPartyQueue cs recipientIds = + case M.lookup qId $ recipientIds cs of + Just rId -> getRcpQueue cs rId + Nothing -> Left AUTH + secureQueue :: QueueStore -> RecipientId -> SenderPublicKey -> STM (Either ErrorType ()) secureQueue store rId sKey = updateQueues store rId $ \cs c -> case senderKey c of Just _ -> (Left AUTH, cs) _ -> (Right (), cs {queues = M.insert rId c {senderKey = Just sKey} (queues cs)}) + addQueueNotifier :: QueueStore -> RecipientId -> NotifierId -> NotifierPublicKey -> STM (Either ErrorType ()) + addQueueNotifier store rId nId nKey = do + cs@QueueStoreData {queues, notifiers} <- readTVar store + if M.member nId notifiers + then pure $ Left DUPLICATE_ + else case M.lookup rId queues of + Nothing -> pure $ Left AUTH + Just q -> case notifier q of + Just _ -> pure $ Left AUTH + _ -> do + writeTVar store $ + cs + { queues = M.insert rId q {notifier = Just (nId, nKey)} queues, + notifiers = M.insert nId rId notifiers + } + pure $ Right () + suspendQueue :: QueueStore -> RecipientId -> STM (Either ErrorType ()) suspendQueue store rId = updateQueues store rId $ \cs c -> diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs index 8dd468442..9f7fb5552 100644 --- a/src/Simplex/Messaging/Server/StoreLog.hs +++ b/src/Simplex/Messaging/Server/StoreLog.hs @@ -14,6 +14,7 @@ module Simplex.Messaging.Server.StoreLog closeStoreLog, logCreateQueue, logSecureQueue, + logAddNotifier, logDeleteQueue, readWriteStoreLog, ) @@ -50,36 +51,44 @@ data StoreLog (a :: IOMode) where data StoreLogRecord = CreateQueue QueueRec | SecureQueue QueueId SenderPublicKey + | AddNotifier QueueId NotifierId NotifierPublicKey | DeleteQueue QueueId storeLogRecordP :: Parser StoreLogRecord storeLogRecordP = "CREATE " *> createQueueP <|> "SECURE " *> secureQueueP + <|> "NOTIFIER " *> addNotifierP <|> "DELETE " *> (DeleteQueue <$> base64P) where createQueueP = CreateQueue <$> queueRecP secureQueueP = SecureQueue <$> base64P <* A.space <*> C.pubKeyP + addNotifierP = + AddNotifier <$> base64P <* A.space <*> base64P <* A.space <*> C.pubKeyP queueRecP = do recipientId <- "rid=" *> base64P <* A.space senderId <- "sid=" *> base64P <* A.space recipientKey <- "rk=" *> C.pubKeyP <* A.space senderKey <- "sk=" *> optional C.pubKeyP - pure QueueRec {recipientId, senderId, recipientKey, senderKey, status = QueueActive} + notifier <- optional $ (,) <$> (" nid=" *> base64P) <*> (" nk=" *> C.pubKeyP) + pure QueueRec {recipientId, senderId, recipientKey, senderKey, notifier, status = QueueActive} serializeStoreLogRecord :: StoreLogRecord -> ByteString serializeStoreLogRecord = \case CreateQueue q -> "CREATE " <> serializeQueue q SecureQueue rId sKey -> "SECURE " <> encode rId <> " " <> C.serializePubKey sKey + AddNotifier rId nId nKey -> B.unwords ["NOTIFIER", encode rId, encode nId, C.serializePubKey nKey] DeleteQueue rId -> "DELETE " <> encode rId where - serializeQueue QueueRec {recipientId, senderId, recipientKey, senderKey} = + serializeQueue QueueRec {recipientId, senderId, recipientKey, senderKey, notifier} = B.unwords [ "rid=" <> encode recipientId, "sid=" <> encode senderId, "rk=" <> C.serializePubKey recipientKey, "sk=" <> maybe "" C.serializePubKey senderKey ] + <> maybe "" serializeNotifier notifier + serializeNotifier (nId, nKey) = " nid=" <> encode nId <> " nk=" <> C.serializePubKey nKey openWriteStoreLog :: FilePath -> IO (StoreLog 'WriteMode) openWriteStoreLog f = WriteStoreLog f <$> openFile f WriteMode @@ -110,6 +119,9 @@ logCreateQueue s = writeStoreLogRecord s . CreateQueue logSecureQueue :: StoreLog 'WriteMode -> QueueId -> SenderPublicKey -> IO () logSecureQueue s qId sKey = writeStoreLogRecord s $ SecureQueue qId sKey +logAddNotifier :: StoreLog 'WriteMode -> QueueId -> NotifierId -> NotifierPublicKey -> IO () +logAddNotifier s qId nId nKey = writeStoreLogRecord s $ AddNotifier qId nId nKey + logDeleteQueue :: StoreLog 'WriteMode -> QueueId -> IO () logDeleteQueue s = writeStoreLogRecord s . DeleteQueue @@ -141,6 +153,7 @@ readQueues (ReadStoreLog _ h) = LB.hGetContents h >>= returnResult . procStoreLo procLogRecord m = \case CreateQueue q -> M.insert (recipientId q) q m SecureQueue qId sKey -> M.adjust (\q -> q {senderKey = Just sKey}) qId m + AddNotifier qId nId nKey -> M.adjust (\q -> q {notifier = Just (nId, nKey)}) qId m DeleteQueue qId -> M.delete qId m printError :: LogParsingError -> IO () printError (e, s) = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs index 5bd05c4a9..d558a636a 100644 --- a/src/Simplex/Messaging/Util.hs +++ b/src/Simplex/Messaging/Util.hs @@ -1,4 +1,5 @@ {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -42,6 +43,9 @@ f <$?> m = m >>= either fail pure . f bshow :: Show a => a -> ByteString bshow = B.pack . show +maybeWord :: (a -> ByteString) -> Maybe a -> ByteString +maybeWord f = maybe "" $ B.cons ' ' . f + liftIOEither :: (MonadIO m, MonadError e m) => IO (Either e a) -> m a liftIOEither a = liftIO a >>= liftEither @@ -53,3 +57,9 @@ liftEitherError f a = liftIOEither (first f <$> a) tryError :: MonadError e m => m a -> m (Either e a) tryError action = (Right <$> action) `catchError` (pure . Left) + +ifM :: Monad m => m Bool -> m a -> m a -> m a +ifM ba t f = ba >>= \b -> if b then t else f + +unlessM :: Monad m => m Bool -> m () -> m () +unlessM b = ifM b $ pure () diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index 58a5d5163..6892baaea 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -161,6 +161,12 @@ smpTest3 _ test' = smpTestN 3 _test _test [h1, h2, h3] = test' h1 h2 h3 _test _ = error "expected 3 handles" +smpTest4 :: Transport c => TProxy c -> (THandle c -> THandle c -> THandle c -> THandle c -> IO ()) -> Expectation +smpTest4 _ test' = smpTestN 4 _test + where + _test [h1, h2, h3, h4] = test' h1 h2 h3 h4 + _test _ = error "expected 4 handles" + tPutRaw :: Transport c => THandle c -> RawTransmission -> IO () tPutRaw h (sig, corrId, queueId, command) = do let t = B.intercalate " " [corrId, queueId, command] diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index a3d93093b..3d328a4af 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -39,6 +39,7 @@ serverTests t = do describe "switch subscription to another SMP queue" $ testSwitchSub t describe "Store log" $ testWithStoreLog t describe "Timing of AUTH error" $ testTiming t + describe "Message notifications" $ testMessageNotifications t pattern Resp :: CorrId -> QueueId -> Command 'Broker -> SignedTransmissionOrError pattern Resp corrId queueId command <- ("", (corrId, queueId, Right (Cmd SBroker command))) @@ -272,14 +273,20 @@ testWithStoreLog at@(ATransport t) = it "should store simplex queues to log and restore them after server restart" $ do (sPub1, sKey1) <- C.generateKeyPair rsaKeySize (sPub2, sKey2) <- C.generateKeyPair rsaKeySize + (nPub, nKey) <- C.generateKeyPair rsaKeySize senderId1 <- newTVarIO "" senderId2 <- newTVarIO "" + notifierId <- newTVarIO "" - withSmpServerStoreLogOn at testPort . runTest t $ \h -> do - (sId1, _, _) <- createAndSecureQueue h sPub1 + withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do + (sId1, rId, rKey) <- createAndSecureQueue h sPub1 atomically $ writeTVar senderId1 sId1 + Resp "abcd" _ (NID nId) <- signSendRecv h rKey ("abcd", rId, "NKEY " <> C.serializePubKey nPub) + atomically $ writeTVar notifierId nId + Resp "dabc" _ OK <- signSendRecv h1 nKey ("dabc", nId, "NSUB") Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, "SEND 5 hello ") Resp "" _ (MSG _ _ "hello") <- tGet fromServer h + Resp "" _ NMSG <- tGet fromServer h1 (sId2, rId2, rKey2) <- createAndSecureQueue h sPub2 atomically $ writeTVar senderId2 sId2 @@ -289,7 +296,7 @@ testWithStoreLog at@(ATransport t) = Resp "dabc" _ OK <- signSendRecv h rKey2 ("dabc", rId2, "DEL") pure () - logSize `shouldReturn` 5 + logSize `shouldReturn` 6 withSmpServerThreadOn at testPort . runTest t $ \h -> do sId1 <- readTVarIO senderId1 @@ -297,10 +304,12 @@ testWithStoreLog at@(ATransport t) = Resp "bcda" _ (ERR AUTH) <- signSendRecv h sKey1 ("bcda", sId1, "SEND 5 hello ") pure () - withSmpServerStoreLogOn at testPort . runTest t $ \h -> do + withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do -- this queue is restored sId1 <- readTVarIO senderId1 + nId <- readTVarIO notifierId Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, "SEND 5 hello ") + Resp "dabc" _ OK <- signSendRecv h1 nKey ("dabc", nId, "NSUB") -- this queue is removed - not restored sId2 <- readTVarIO senderId2 Resp "cdab" _ (ERR AUTH) <- signSendRecv h sKey2 ("cdab", sId2, "SEND 9 hello too ") @@ -309,26 +318,29 @@ testWithStoreLog at@(ATransport t) = logSize `shouldReturn` 1 removeFile testStoreLogFile where - createAndSecureQueue :: Transport c => THandle c -> SenderPublicKey -> IO (SenderId, RecipientId, C.SafePrivateKey) - createAndSecureQueue h sPub = do - (rPub, rKey) <- C.generateKeyPair rsaKeySize - Resp "abcd" "" (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub) - let keyCmd = "KEY " <> C.serializePubKey sPub - Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, keyCmd) - (rId', rId) #== "same queue ID" - pure (sId, rId, rKey) - runTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> ThreadId -> Expectation runTest _ test' server = do testSMPClient test' `shouldReturn` () killThread server + runClient :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation + runClient _ test' = testSMPClient test' `shouldReturn` () + logSize :: IO Int logSize = try (length . B.lines <$> B.readFile testStoreLogFile) >>= \case Right l -> pure l Left (_ :: SomeException) -> logSize +createAndSecureQueue :: Transport c => THandle c -> SenderPublicKey -> IO (SenderId, RecipientId, C.SafePrivateKey) +createAndSecureQueue h sPub = do + (rPub, rKey) <- C.generateKeyPair rsaKeySize + Resp "abcd" "" (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub) + let keyCmd = "KEY " <> C.serializePubKey sPub + Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, keyCmd) + (rId', rId) #== "same queue ID" + pure (sId, rId, rKey) + testTiming :: ATransport -> Spec testTiming (ATransport t) = it "should have similar time for auth error, whether queue exists or not, for all key sizes" $ @@ -375,6 +387,28 @@ testTiming (ATransport t) = Resp "" _ (MSG _ _ "hello") <- tGet fromServer rh similarTime timeNoQueue timeWrongKey +testMessageNotifications :: ATransport -> Spec +testMessageNotifications (ATransport t) = + it "should create simplex connection, subscribe notifier and deliver notifications" $ do + (sPub, sKey) <- C.generateKeyPair rsaKeySize + (nPub, nKey) <- C.generateKeyPair rsaKeySize + smpTest4 t $ \rh sh nh1 nh2 -> do + (sId, rId, rKey) <- createAndSecureQueue rh sPub + Resp "1" _ (NID nId) <- signSendRecv rh rKey ("1", rId, "NKEY " <> C.serializePubKey nPub) + Resp "2" _ OK <- signSendRecv nh1 nKey ("2", nId, "NSUB") + Resp "3" _ OK <- signSendRecv sh sKey ("3", sId, "SEND 5 hello ") + Resp "" _ (MSG _ _ "hello") <- tGet fromServer rh + Resp "3a" _ OK <- signSendRecv rh rKey ("3a", rId, "ACK") + Resp "" _ NMSG <- tGet fromServer nh1 + Resp "4" _ OK <- signSendRecv nh2 nKey ("4", nId, "NSUB") + Resp "" _ END <- tGet fromServer nh1 + Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, "SEND 11 hello again ") + Resp "" _ (MSG _ _ "hello again") <- tGet fromServer rh + Resp "" _ NMSG <- tGet fromServer nh2 + 1000 `timeout` tGet fromServer nh1 >>= \case + Nothing -> return () + Just _ -> error "nothing else should be delivered to the 1st notifier's TCP connection" + samplePubKey :: ByteString samplePubKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj+toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP+Tm4sokaFDTIG3QJFzOjC+/9nW4MUjAOFll9PCp9kaEFHJ/YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju/f6kAayvYKW3/lbJNXCmyinAccBosO08/0sUxvtuniIo18kfYJE0UmP1ReCjhMP+O+yOmwZJini/QelJk/Pez8IIDDWnY1qYQsN/q7ocjakOYrpGG7mig6JMFpDJtD6istR" From eb941f743511aad61bc0396a68dfe1d74060b0dd Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 19 Nov 2021 16:26:51 +0000 Subject: [PATCH 03/13] simplify pending message delivery (#202) * simplify pending message delivery (WIP) * refactor --- src/Simplex/Messaging/Agent.hs | 74 +++++++++------------ src/Simplex/Messaging/Agent/Client.hs | 9 +-- src/Simplex/Messaging/Agent/Store.hs | 2 +- src/Simplex/Messaging/Agent/Store/SQLite.hs | 4 +- 4 files changed, 37 insertions(+), 52 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 18dd0d845..b539cf501 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -65,7 +65,6 @@ import Data.Composition ((.:), (.:.)) import Data.Functor (($>)) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as L -import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (isJust) import qualified Data.Text as T @@ -83,9 +82,9 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Protocol (MsgBody, SenderPublicKey) import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), runTransportServer) -import Simplex.Messaging.Util (bshow, tryError) +import Simplex.Messaging.Util (bshow, tryError, unlessM) import System.Random (randomR) -import UnliftIO.Async (Async, async, race_) +import UnliftIO.Async (async, race_) import qualified UnliftIO.Exception as E import UnliftIO.STM @@ -297,7 +296,7 @@ subscribeConnection' :: forall m. AgentMonad m => AgentClient -> ConnId -> m () subscribeConnection' c connId = withStore (`getConn` connId) >>= \case SomeConn _ (DuplexConnection _ rq sq) -> do - resumeDelivery sq + resumeMsgDelivery c connId sq case status (sq :: SndQueue) of Confirmed -> withVerifyKey sq $ \verifyKey -> do conf <- withStore (`getAcceptedConfirmation` connId) @@ -308,7 +307,7 @@ subscribeConnection' c connId = Active -> subscribeQueue c rq connId _ -> throwError $ INTERNAL "unexpected queue status" SomeConn _ (SndConnection _ sq) -> do - resumeDelivery sq + resumeMsgDelivery c connId sq case status (sq :: SndQueue) of Confirmed -> withVerifyKey sq $ \verifyKey -> activateQueueJoining c connId sq verifyKey =<< resumeInterval @@ -316,12 +315,6 @@ subscribeConnection' c connId = _ -> throwError $ INTERNAL "unexpected queue status" SomeConn _ (RcvConnection _ rq) -> subscribeQueue c rq connId where - resumeDelivery :: SndQueue -> m () - resumeDelivery SndQueue {server} = do - wasDelivering <- resumeMsgDelivery c connId server - unless wasDelivering $ do - pending <- withStore (`getPendingMsgs` connId) - queuePendingMsgs c connId pending withVerifyKey :: SndQueue -> (C.PublicKey -> m ()) -> m () withVerifyKey sq action = let err = throwError $ INTERNAL "missing signing key public counterpart" @@ -344,14 +337,10 @@ sendMessage' c connId msg = _ -> throwError $ CONN SIMPLEX where enqueueMessage :: SndQueue -> m AgentMsgId - enqueueMessage SndQueue {server} = do + enqueueMessage sq@SndQueue {server} = do + resumeMsgDelivery c connId sq msgId <- storeSentMsg - wasDelivering <- resumeMsgDelivery c connId server - pending <- - if wasDelivering - then pure [PendingMsg {connId, msgId}] - else withStore (`getPendingMsgs` connId) - queuePendingMsgs c connId pending + queuePendingMsgs c connId server [msgId] pure $ unId msgId where storeSentMsg :: m InternalId @@ -372,42 +361,41 @@ sendMessage' c connId msg = createSndMsg st connId msgData pure internalId -resumeMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnId -> SMPServer -> m Bool -resumeMsgDelivery c connId srv = do - void $ resume srv (srvMsgDeliveries c) $ runSrvMsgDelivery c srv - resume connId (connMsgDeliveries c) $ runMsgDelivery c connId srv +resumeMsgDelivery :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> m () +resumeMsgDelivery c connId SndQueue {server} = do + unlessM srvDelivering $ + async (runSrvMsgDelivery c server) + >>= atomically . modifyTVar (srvMsgDeliveries c) . M.insert server + unlessM connQueued $ + withStore (`getPendingMsgs` connId) + >>= queuePendingMsgs c connId server where - resume :: Ord a => a -> TVar (Map a (Async ())) -> m () -> m Bool - resume key actionMap actionProcess = do - isDelivering <- isJust . M.lookup key <$> readTVarIO actionMap - unless isDelivering $ - async actionProcess - >>= atomically . modifyTVar actionMap . M.insert key - pure isDelivering + srvDelivering = isJust . M.lookup server <$> readTVarIO (srvMsgDeliveries c) + connQueued = + atomically $ + isJust + <$> stateTVar + (connMsgsQueued c) + (\m -> (M.lookup connId m, M.insert connId True m)) -queuePendingMsgs :: AgentMonad m => AgentClient -> ConnId -> [PendingMsg] -> m () -queuePendingMsgs c connId pending = - atomically $ getPendingMsgQ connId (connMsgQueues c) >>= forM_ pending . writeTQueue +queuePendingMsgs :: AgentMonad m => AgentClient -> ConnId -> SMPServer -> [InternalId] -> m () +queuePendingMsgs c connId server msgIds = atomically $ do + q <- getPendingMsgQ c server + mapM_ (writeTQueue q . PendingMsg connId) msgIds -getPendingMsgQ :: Ord a => a -> TVar (Map a (TQueue PendingMsg)) -> STM (TQueue PendingMsg) -getPendingMsgQ key queueMap = do - maybe newMsgQueue pure . M.lookup key =<< readTVar queueMap +getPendingMsgQ :: AgentClient -> SMPServer -> STM (TQueue PendingMsg) +getPendingMsgQ c srv = do + maybe newMsgQueue pure . M.lookup srv =<< readTVar (srvMsgQueues c) where newMsgQueue :: STM (TQueue PendingMsg) newMsgQueue = do mq <- newTQueue - modifyTVar queueMap $ M.insert key mq + modifyTVar (srvMsgQueues c) $ M.insert srv mq pure mq -runMsgDelivery :: AgentMonad m => AgentClient -> ConnId -> SMPServer -> m () -runMsgDelivery c connId srv = do - mq <- atomically . getPendingMsgQ connId $ connMsgQueues c - smq <- atomically . getPendingMsgQ srv $ srvMsgQueues c - forever . atomically $ readTQueue mq >>= writeTQueue smq - runSrvMsgDelivery :: forall m. AgentMonad m => AgentClient -> SMPServer -> m () runSrvMsgDelivery c@AgentClient {subQ} srv = do - mq <- atomically . getPendingMsgQ srv $ srvMsgQueues c + mq <- atomically $ getPendingMsgQ c srv ri <- asks $ reconnectInterval . config forever $ do PendingMsg {connId, msgId} <- atomically $ readTQueue mq diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index cc9cfb340..031403a4a 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -72,8 +72,7 @@ data AgentClient = AgentClient subscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue)), subscrConns :: TVar (Map ConnId SMPServer), activations :: TVar (Map ConnId (Async ())), -- activations of send queues in progress - connMsgQueues :: TVar (Map ConnId (TQueue PendingMsg)), - connMsgDeliveries :: TVar (Map ConnId (Async ())), + connMsgsQueued :: TVar (Map ConnId Bool), srvMsgQueues :: TVar (Map SMPServer (TQueue PendingMsg)), srvMsgDeliveries :: TVar (Map SMPServer (Async ())), reconnections :: TVar [Async ()], @@ -93,14 +92,13 @@ newAgentClient agentEnv = do subscrSrvrs <- newTVar M.empty subscrConns <- newTVar M.empty activations <- newTVar M.empty - connMsgQueues <- newTVar M.empty - connMsgDeliveries <- newTVar M.empty + connMsgsQueued <- newTVar M.empty srvMsgQueues <- newTVar M.empty srvMsgDeliveries <- newTVar M.empty reconnections <- newTVar [] clientId <- stateTVar (clientCounter agentEnv) $ \i -> (i + 1, i + 1) lock <- newTMVar () - return AgentClient {rcvQ, subQ, msgQ, smpClients, subscrSrvrs, subscrConns, activations, connMsgQueues, connMsgDeliveries, srvMsgQueues, srvMsgDeliveries, reconnections, clientId, agentEnv, smpSubscriber = undefined, lock} + return AgentClient {rcvQ, subQ, msgQ, smpClients, subscrSrvrs, subscrConns, activations, connMsgsQueued, srvMsgQueues, srvMsgDeliveries, reconnections, clientId, agentEnv, smpSubscriber = undefined, lock} -- | Agent monad with MonadReader Env and MonadError AgentErrorType type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m) @@ -176,7 +174,6 @@ closeAgentClient c = liftIO $ do closeSMPServerClients c cancelActions $ activations c cancelActions $ reconnections c - cancelActions $ connMsgDeliveries c cancelActions $ srvMsgDeliveries c closeSMPServerClients :: AgentClient -> IO () diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index fd8b3ced6..7ef0e7f1e 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -58,7 +58,7 @@ class Monad m => MonadAgentStore s m where createSndMsg :: s -> ConnId -> SndMsgData -> m () updateSndMsgStatus :: s -> ConnId -> InternalId -> SndMsgStatus -> m () getPendingMsgData :: s -> ConnId -> InternalId -> m (SndQueue, MsgBody) - getPendingMsgs :: s -> ConnId -> m [PendingMsg] + getPendingMsgs :: s -> ConnId -> m [InternalId] getMsg :: s -> ConnId -> InternalId -> m Msg checkRcvMsg :: s -> ConnId -> InternalId -> m () updateRcvMsgAck :: s -> ConnId -> InternalId -> m () diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 5d63af27c..ec05920d6 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -430,10 +430,10 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto sndQueue :: Maybe SndQueue -> Either StoreError SndQueue sndQueue = maybe (Left SEConnNotFound) Right - getPendingMsgs :: SQLiteStore -> ConnId -> m [PendingMsg] + getPendingMsgs :: SQLiteStore -> ConnId -> m [InternalId] getPendingMsgs st connId = liftIO . withTransaction st $ \db -> - map (PendingMsg connId . fromOnly) + map fromOnly <$> DB.query db "SELECT internal_id FROM snd_messages WHERE conn_alias = ? AND snd_status = ?" (connId, SndMsgCreated) getMsg :: SQLiteStore -> ConnId -> InternalId -> m Msg From eb7fcae31bab8323c77abfd7d703f20396845a3a Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 22 Nov 2021 08:52:39 +0000 Subject: [PATCH 04/13] update transport protocol to use TLS (#204) * update transport protocol to use TLS * typos * s/serverKeyHash/serverIdentity/ Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> * Update protocol/simplex-messaging.md Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> * corrections Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> --- protocol/simplex-messaging.md | 109 +++++++++++++++++----------------- 1 file changed, 56 insertions(+), 53 deletions(-) diff --git a/protocol/simplex-messaging.md b/protocol/simplex-messaging.md index 7818773d6..a1b4ff5e9 100644 --- a/protocol/simplex-messaging.md +++ b/protocol/simplex-messaging.md @@ -72,7 +72,7 @@ The SMP model has three communication participants: the recipient, the message b SMP server manages multiple "simplex queues" - data records on the server that identify communication channels from the senders to the recipients. The same communicating party that is the sender in one queue, can be the recipient in another - without exposing this fact to the server. -The queue record consists of 2 unique random IDs generated by the server, one for the recipient and another for the sender, and 2 keys to authenticate the recipient and the sender respectively, provided by the client. The users of SMP protocol must use a unique key for each queue, to avoid the possibility of aggregating and analysing their queues in case SMP server is compromised. +The queue record consists of 2 unique random IDs generated by the server, one for the recipient and another for the sender, and 2 keys to authenticate the recipient and the sender respectively, provided by the client. The users of SMP protocol must use a unique key for each queue, to avoid the possibility of aggregating and analyzing their queues in case SMP server is compromised. Creating and using the queue requires sending commands to the SMP server from the recipient and the sender - they are described in detail in [SMP commands](#smp-commands) section. @@ -84,12 +84,15 @@ The [ABNF][8] syntax of the message is: ```abnf queueInfo = %s"smp::" smpServer "::" queueId "::" encryptionKey -smpServer = srvHost [":" port] ["#" serverKeyHash] +smpServer = srvHost [":" port] "#" serverIdentity srvHost = ; RFC1123, RFC5891 port = 1*DIGIT -serverKeyHash = encoded +serverIdentity = encoded queueId = encoded -encryptionKey = %s"rsa:" x509encoded ; the recipient's RSA public key for sender to encrypt messages +encryptionKey = encryptionScheme ":" x509encoded ; the recipient's RSA public key for sender to encrypt messages +encryptionScheme = %s"rsa" ; end-to-end encryption and key exchange protocols, + ; the current hybrid encryption scheme (RSA-OAEP/AES-256-GCM-SHA256) + ; will be replaced with double ratchet protocol and DH key exchange. x509encoded = encoded = ``` @@ -98,7 +101,7 @@ encoded = `port` is optional, the default TCP port for SMP protocol is 5223. -`serverKeyHash` is an optional hash of the server transport key used during transport handshake (see [Appendix A](#appendix-a)). +`serverIdentity` is a required hash of the server certificate SPKI block (without line breaks, header and footer) used by the client to validate server certificate during transport handshake (see [Appendix A](#appendix-a)). Encryption keys are encoded using [X509][11] specification. @@ -272,7 +275,7 @@ Simplex Messaging Protocol: - One unique "public" key is used by the servers to authenticate requests to send the messages into the queue, and another unique "public" key - to retrieve the messages from the queue. "Unique" here means that each "public" key is used only for one queue and is not used for any other context - effectively, this key is not public and does not represent any participant identity. - - Both recipient and sender "public" keys are provided to the server by the queue recipient. "Public" key `RK` is provided when the queue is created, public key `SK` is proviced when the queue is secured. + - Both recipient and sender "public" keys are provided to the server by the queue recipient. "Public" key `RK` is provided when the queue is created, public key `SK` is provided when the queue is secured. - The "public" keys known to the server and used to authenticate commands from the participants are unrelated to the keys used to encrypt and decrypt the messages - the latter keys are also unique per each queue but they are only known to participants, not to the servers. @@ -348,16 +351,18 @@ Each transmission between the client and the server must have this format/syntax ```abnf transmission = [signature] SP signed SP pad ; pad to the fixed block size -signed = [corrId] SP [queueId] SP cmd +signed = sessionIdentifier SP [corrId] SP [queueId] SP cmd ; corrId is required in client commands and server responses, + ; corrId is empty in server notifications. cmd = ping / recipientCmd / send / subscribeNotifications / serverMsg recipientCmd = create / subscribe / secure / enableNotifications / acknowledge / suspend / delete -serverMsg = pong / queueIds / message / notifierId / messageNotification / +serverMsg = queueIds / message / notifierId / messageNotification / unsubscribed / ok / error corrId = 1*(%x21-7F) ; any characters other than control/whitespace queueId = encoded ; empty queue ID is used with "create" command signature = encoded -; empty signature can be used with "create", "send" and "ping" commands and server messages +; empty signature can be used with "send" before the queue is secured with secure command +; signature is always empty with "ping" and "serverMsg" encoded = ``` @@ -367,21 +372,20 @@ The syntax of specific commands and responses is defined below. ### Correlating responses with commands -The server should send `queueIds`, `error` and `ok` responses in the same order within each queue ID as the commands received in the transport connection, so that they can be correlated by the clients. To simplify correlation of commands and responses, the server should use the same `corrId` in the response as in the command sent by the client. +The server should send `queueIds`, `error` and `ok` responses in the same order within each queue ID as the commands received in the transport connection, so that they can be correlated by the clients. To simplify correlation of commands and responses, the server must use the same `corrId` in the response as in the command sent by the client. If the transport connection is closed before some responses are sent, these responses should be discarded. ### Command authentication -SMP servers must authenticate all transmissions (excluding `ping` and `send` commands) by verifying the provided signatures. Command signature should be generated by applying RSA-PSS algorithm to the `signed` block of the transmission using the key associated with the queue ID (sender's or recipient's, depending on which queue ID is used). +SMP servers must authenticate all transmissions (excluding `ping` and initial `send` commands) by verifying the client signatures. Command signature should be generated by applying the algorithm specified for the queue to the `signed` block of the transmission, using the key associated with the queue ID (recipient's, sender's or notifier's, depending on which queue ID is used). ### Keep-alive command -To keep the transport connection alive and to generate noise traffic the clients should use `ping` command to which the server responds with `pong` response. This command should be sent unsigned and without queue ID. +To keep the transport connection alive and to generate noise traffic the clients should use `ping` command to which the server responds with `ok` response. This command should be sent unsigned and without queue ID. ```abnf ping = %s"PING" -pong = %s"PONG" ``` ### Recipient commands @@ -394,7 +398,9 @@ This command is sent by the recipient to the SMP server to create a new queue. T ```abnf create = %s"NEW" SP recipientKey -recipientKey = %s"rsa:" x509encoded ; the recipient's RSA public key for this queue +recipientKey = signatureScheme ":" x509encoded ; the recipient's public key to verify commands for this queue +signatureScheme = %s"rsa" | %s"ed25519" | %s"ed448" ; "rsa" means deprecated RSA-PSS signature scheme, + ; it must not be used for the new queues. x509encoded = ``` @@ -410,7 +416,7 @@ This response should be sent with empty queue ID (the second part of the transmi Once the queue is created, the recipient gets automatically subscribed to receive the messages from that queue, until the transport connection is closed. The `subscribe` command is needed only to start receiving the messages from the existing queue when the new transport connection is opened. -NEW `transmission` must be signed using the `recipientKey` that was passed in the transmission. +NEW `transmission` must be signed using the `recipientKey` that was passed in the transmission – this verifies that the client has the private key that will be used to sign subsequent commands for this queue. #### Subscribe to queue @@ -430,7 +436,7 @@ This command is sent by the recipient to the server to add sender's key to the q ```abnf secure = %s"KEY" SP senderKey -senderKey = %s"rsa:" x509encoded ; the sender's RSA public key for this queue +senderKey = signatureScheme ":" x509encoded ; the sender's public key public key to verify SEND command for this queue ``` `senderKey` is received from the sender as part of the first message - see [Send Message](#send-message) command. @@ -443,7 +449,7 @@ This command is sent by the recipient to the server to add notifier's key to the ```abnf enableNotifications = %s"NKEY" SP notifierKey -notifierKey = %s"rsa:" x509encoded ; the notifier's RSA public key for this queue +notifierKey = signatureScheme ":" x509encoded ; the notifier's public key public key to verify NSUB command for this queue ``` The server will respond with `notifierId` response if notifications were enabled and the notifier's key was successfully added to the queue: @@ -528,7 +534,7 @@ The body should be encrypted with the recipient's "public" key (`EK`); once decr decryptedBody = [clientHeader] CRLF clientBody CRLF clientHeader = senderKeyMsg senderKeyMsg = %s"KEY" SP senderKey -senderKey = %s"rsa:" x509encoded ; the sender's RSA public key for this queue +senderKey = signatureScheme ":" x509encoded ; the sender's public key to sign SEND commands for this queue clientBody = *OCTET ``` @@ -570,7 +576,7 @@ timestamp = `timestamp` - the UTC time when the server received the message from the sender, must be in date-time format defined by [RFC 3339][10] -`binaryMsg` - see syntax in [Send message](#send-message) +`msgBody` - see syntax in [Send message](#send-message) #### Notifier queue ID response @@ -639,52 +645,47 @@ ok = %s"OK" Both the recipient and the sender can use TCP or some other, possibly higher level, transport protocol to communicate with the server. The default TCP port for SMP server is 5223. -By default, the client and server should use the protocol presented below, that does not depend on a centralized certificate authority. +For scenarios when meta-data privacy is critical, it is recommended that clients: +- communicating over Tor network, +- establish a separate connection for each SMP queue, +- send noise traffic (using PING command). -Transport is encrypted with [AEAD-GCM][12] protocol with two random symmetric AES 256-bit keys and two random base IVs that will be agreed during the handshake. Both client and the server should maintain two 32-bit word counters, one for the sent and one for the received messages. The IV for each message should be computed by xor-ing the sequential message counter, starting from 0, with the first 32 bits of agreed base IV (the number is encoded in network byte order). +In addition to that, the servers can be deployed as Tor onion services. -To establish the session keys and base IVs, the server should have an asymmetric key pair generated during server deployment and unknown to the clients. The users should know the key hash (256 bits) in advance in order to be able to validate the server public key during transport connection handshake. +The transport protocol should provide the following: +- server authentication (by matching server certificate hash with `serverIdentity`), +- forward secrecy (by encrypting the traffic using ephemeral keys agreed during transport handshake), +- integrity (preventing data modification by the attacker without detection), +- unique channel binding (`sessionIdentifier`) to include in the signed part of SMP transmissions. -The handshake sequence is the following: +By default, the client and server communicate using [TLS 1.3 protocol][13] restricted to: +- TLS_AES_256_GCM_SHA384 cypher suite, +- ed25519 and ed448 EdDSA algorithms for signatures, +- x25519 and x448 ECDHE groups for key exchange. +- servers must send only one self-signed certificate in the handshake, clients must abort the connection in case more than one certificate is sent. +- server and client TLS configuration should not allow resuming the sessions. -1. Once the connection is established, the server sends the `server_header` followed by its public RSA key encoded in X509 binary (not base-64 encoded) format to the client. -2. The client compares the SHA256 hash of the received key with the hash it already has (e.g. received as part of connection invitation or as SMP server configuration). If the hash does not match, the client must terminate the connection. -3. If the hash is the same, the client should generate two random symmetric 256-bit AES keys and two base IVs that will be used as session keys/IVs by the client and the server. -4. The client then should create the `client_handshake` block and send it to the server, encrypted using [RSA-OAEP][2] scheme with the server public key: `rsa-encrypt(client_handshake)`. `snd_aes_key` and `snd_base_iv` will be used by the client to encrypt **sent** messages and by the server to decrypt them, `rcv_aes_key` and `rcv_base_iv` will be used by the client to decrypt **received** messages and by the server to encrypt them. `client_handshake` also contains `block_size` and reserved `protocol` blocks (see syntax). -5. The server should decrypt the received AES keys and base IVs with its private RSA key. -6. In case of successful decryption, the server should send encrypted welcome block (`encrypted_welcome_block`) that contains SMP protocol version supported by the server. +During TLS handshake the client must validate that the hash of the server certificate SPKI block is equal to the `serverIdentity` the client received as part of SMP server address; if the server identity does not match the client must abort the connection. -All the subsequent data, both from the client and from the server, should be sent padded to the fixed agreed block size, encrypted with symmetric AES keys and base IVs (incremented by counters on both sides), that were sent by the client during the handshake. If the application needs to transmit a larger message, it should be broken down into fragments. +Once TLS handshake is complete, client and server will exchange blocks of fixed size (16384 bytes). -Handshake blocks sent by the client and the server have this syntax: +The first block sent by the client should be `clientHello` and the server should respond with `serverHello`: ```abnf -server_header = block_size protocol key_size -block_size = 4*4(OCTET) ; 4-byte block size sent by the server -protocol = 2*2(%x00) ; 0, reserved -key_size = 2*2(OCTET) ; the size of the encoded key in bytes (binary encoded in X509 standard) +clientHello = SP smpVersion SP reserved pad +serverHello = sessionIdentifier SP smpVersion SP reserved pad +sessionIdentifier = ; unique session identifier derived from transport connection handshake + ; it should be included in all SMP transmissions sent in this transport connection. -client_handshake = client_block_size protocol snd_aes_key snd_base_iv rcv_aes_key rcv_base_iv -client_block_size = 4*4(OCTET) ; 4-byte block size sent by the client, -; to confirm or override the block size sent by the server -client_protocol = 2*2(%x00) ; 0, reserved -snd_aes_key = 32*32(OCTET) -snd_base_iv = 16*16(OCTET) -rcv_aes_key = 32*32(OCTET) -rcv_base_iv = 16*16(OCTET) - -transport_block = aes_body_auth_tag aes_encrypted_body -; size is sent by server during handshake, usually 4096 bytes -aes_body_auth_tag = 16*16(OCTET) -aes_encrypted_body = 1*OCTET - -encrypted_welcome_block = transport_block -welcome_block = smp_version SP pad ; decrypt(encrypted_welcome_block) -smp_version = %s"v" 1*DIGIT "." 1*DIGIT "." 1*DIGIT ["-" 1*ALPHA "." 1*DIGIT] ; in semver format - ; for example: v123.456.789-alpha.7 +smpVersion = %s"SMP v" 1*DIGIT "." 1*DIGIT "." 1*DIGIT ; semver format, the version in this document is v0.5.0 +reserved = pad = 1*OCTET ``` +For TLS 1.3 transport client should assert that `sessionIdentifier` is equal to `tls-unique` channel binding defined in [RFC 5929][14] (TLS Finished message struct); we pass it in `serverHello` block to allow communication over some other transport protocol. + +The communication party (client or server) that has the lower protocol version should assume that this version will be supported by another party, the party with the higher protocol version should abort the connection in case they cannot support the lower version. + [1]: https://en.wikipedia.org/wiki/Man-in-the-middle_attack [2]: https://en.wikipedia.org/wiki/End-to-end_encryption [3]: https://en.wikipedia.org/wiki/QR_code @@ -697,3 +698,5 @@ pad = 1*OCTET [10]: https://tools.ietf.org/html/rfc3339 [11]: https://tools.ietf.org/html/rfc5280 [12]: https://tools.ietf.org/html/rfc7714 +[13]: https://datatracker.ietf.org/doc/html/rfc8446 +[14]: https://datatracker.ietf.org/doc/html/rfc5929#section-3 From 01e8c232f03d262c511c98ec1fda8cda53b15db6 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 22 Nov 2021 19:08:19 +0000 Subject: [PATCH 05/13] change syntax for queue URI and connection request (#205) * change syntax for queue URI and connection request * separate queue URI into separate section * correction --- protocol/agent-protocol.md | 53 ++++++++++++++++++++--------------- protocol/simplex-messaging.md | 52 +++++++++++++++++----------------- protocol/smp-uri-request.txt | 16 +++++++++++ 3 files changed, 72 insertions(+), 49 deletions(-) create mode 100644 protocol/smp-uri-request.txt diff --git a/protocol/agent-protocol.md b/protocol/agent-protocol.md index 9d80beef0..417a75853 100644 --- a/protocol/agent-protocol.md +++ b/protocol/agent-protocol.md @@ -24,7 +24,7 @@ - [END notification](#end-notification) - [OFF command](#off-command) - [DEL command](#del-command) -- [Connection invitation](#connection-invitation) +- [Connection request](#connection-request) ## Abstract @@ -32,28 +32,27 @@ The purpose of SMP agent protocol is to define the syntax and the semantics of c It provides: - convenient protocol to create and manage bi-directional (duplex) connections between the users of SMP agents consisting of two (or more) separate unidirectional (simplex) SMP queues, abstracting away multiple steps required to establish bi-directional connections and any information about the servers location from the users of the protocol. -- management of E2E encryption between SMP agents, generating ephemeral RSA keys for each connection. -- SMP command authentication on SMP servers, generating ephemeral RSA keys for each SMP queue. -- TCP transport handshake and encryption with SMP servers. +- management of E2E encryption between SMP agents, generating ephemeral asymmetric keys for each connection. +- SMP command authentication on SMP servers, generating ephemeral keys for each SMP queue. +- TCP/TLS transport handshake with SMP servers. - validation of message integrity. -SMP agent protocols provides no encryption or any security on the client side - it is assumed that the agent is executed in the trusted and secure environment. +SMP agent protocol provides no encryption or security on the client side - it is assumed that the agent is executed in the trusted and secure environment, in one of three ways: +- via TCP network using secure connection. +- via local port (when the agent runs on the same device as a separate process). +- via agent library, when the agent logic is included directly into the client application. -The future versions of this protocol could provide: -- managing redundant SMP queues with more than 1 queue in each direction. -- managing simple symmetric groups as a foundation for chat groups and device synchronization. -- agent cluster - synchronizing states of multiple agents. -- secure "synchronous" streams with symmetric message encryption and connection-level authentication (requires extending [SMP protocol](./simplex-messaging.md)) - it can be used, e.g., for file transfers. +The last option is the most secure, as it reduces the number of attack vectors in comparison with other options. [SimpleX Chat for terminal](https://github.com/simplex-chat/simplex-chat) uses this approach. ## SMP agent -SMP agent is a client-side process or library that communicates via SMP servers using [simplex messaging protocol (SMP)](./simplex-messaging.md) with other SMP agents according to the commands received from its users. This protocol is a middle layer in SMP protocols stack (above SMP protocol but below any application level protocol) - it is intended to be used by client-side applications that need secure asynchronous bi-directional communication channels ("connections"). +SMP agent communicates via SMP servers using [simplex messaging protocol (SMP)](./simplex-messaging.md) with other SMP agents according to the commands received from its users. This protocol is a middle layer in SimpleX protocols (above SMP protocol but below any application level protocol) - it is intended to be used by client-side applications that need secure asynchronous bi-directional communication channels ("connections"). -The agent must have a persistent storage to manage the states of known connections and of the client-side information of two SMP queues that each connection consists of, and also the buffer of the most recent messages. The number of the messages that should be stored is implementation specific, depending on the error management approach that the agent implements; at the very least the agent must store the hash and id of the last received message. +The agent must have a persistent storage to manage the states of known connections and of the client-side information of SMP queues that each connection consists of, and also the buffer of the most recent sent and received messages. The number of the messages that should be stored is implementation specific, depending on the error management approach that the agent implements; at the very least the agent must store the hash and id of the last received and sent message. ## SMP servers management -SMP agent protocol commands do not contain SMP servers that the agent will use to establish the connections between their users. The servers are part of the agent configuration and can be dynamically added and removed by the agent implementation: +SMP agent protocol commands do not contain SMP servers that the agent will use to establish the connections. The servers are part of the agent configuration and can be dynamically added and removed by the agent implementation: - by the client applications via any API that is outside of scope of this protocol. - by the agents themselves based on servers availability and latency. @@ -64,7 +63,7 @@ SMP agent protocol has 3 main parts: - the syntax and semantics of messages that SMP agents exchange between each other in order to: - negotiate establishing unidirectional (simplex) encrypted queues on SMP server(s) - exchange client messages and delivery notifications, providing sequential message IDs and message integrity (by including the hash of the previous message). -- the syntax and semantics of the commands (a higher level interface than SMP protocol) that are sent over TCP or other sequential protocol by agent clients to the agents. This protocol allows to create and manage multiple connections, each consisting of two simplex SMP queues. +- the syntax and semantics of the commands that are sent over TCP or other sequential protocol by agent clients to the agents. This protocol allows to create and manage multiple connections, each consisting of two or more SMP queues. - the syntax and semantics of the message that the clients of SMP agents should send out-of-band (as pre-shared "invitation" including SMP server, queue ID and encryption key) to ensure [E2E encryption][1] the integrity of SMP queues and protection against active attacks ([MITM attacks][2]). ## Duplex connection procedure @@ -74,7 +73,7 @@ SMP agent protocol has 3 main parts: The procedure of establishing a duplex connection is explained on the example of Alice and Bob creating a bi-directional connection comprised of two unidirectional (simplex) queues, using SMP agents (A and B) to facilitate it, and two different SMP servers (which could be the same server). It is shown on the diagram above and has these steps: 1. Alice requests the new connection from the SMP agent A using `NEW` command. -2. Agent A creates an SMP connection on the server (using [SMP protocol](./simplex-messaging.md)) and responds to Alice with the invitation that contains queue information and the encryption key Bob's agent B should use. The invitation format is described in [Connection invitation](#connection-invitation). +2. Agent A creates an SMP connection on the server (using [SMP protocol](./simplex-messaging.md)) and responds to Alice with the invitation that contains queue information and the encryption key Bob's agent B should use. The invitation format is described in [Connection request](#connection-request). 3. Alice sends the invitation to Bob via any secure channel they have (out-of-band message). 4. Bob sends `JOIN` command with the invitation as a parameter to agent B to accept the connection. 5. Establishing Alice's SMP connection (with SMP protocol commands): @@ -138,7 +137,7 @@ helloMsg = %s"HELLO" SP signatureVerificationKey [SP %s"NO_ACK"] ; NO_ACK means that acknowledgements to client messages will NOT be sent in this connection by the agent that sent `HELLO` message. signatureVerificationKey = encoded -replyQueueMsg = %s"REPLY" SP ; `queueInfo` is the same as in out-of-band message, see SMP protocol +replyQueueMsg = %s"REPLY" SP ; `connectionRequest` is defined below ; this message can only be sent by the second connection party deleteQueueMsg = %s"DEL" ; notification that recipient queue will be deleted @@ -204,7 +203,7 @@ agentMsg = invitation / connRequest / connInfo / connected / unsubscribed / conn newCmd = %s"NEW" [SP %s"NO_ACK"] ; response is `invitation` or `error` ; NO_ACK parameter currently not supported -invitation = %s"INV" SP ; `queueInfo` is the same as in out-of-band message, see SMP protocol +invitation = %s"INV" SP ; `connectionRequest` is defined below connRequest = %s"REQ" SP confirmationId SP msgBody ; msgBody here is any binary information identifying connection request @@ -231,8 +230,8 @@ connDown = %s"DOWN" connUp = %s"UP" ; restored connection -joinCmd = %s"JOIN" SP [SP %s"NO_REPLY"] [SP %s"NO_ACK"] -; `queueInfo` is the same as in out-of-band message, see SMP protocol +joinCmd = %s"JOIN" SP [SP %s"NO_REPLY"] [SP %s"NO_ACK"] +; `connectionRequest` is defined below ; response is `connected` or `error` suspendCmd = %s"OFF" ; can be sent by either party, response `ok` or `error` @@ -348,11 +347,21 @@ It is used to suspend the receiving SMP queue - sender will no longer be able to It is used to delete the connection and all messages in it, as well as the receiving SMP queue and all messages in it that were remaining on the server. Agent response to this command can be `OK` or `ERR`. This command is irreversible. -## Connection invitation +## Connection request -Connection invitation `queueInfo` is generated by SMP agent in response to `newCmd` command (`"NEW"`), used by another party user with `joinCmd` command (`"JOIN"`), and then another invitation is sent by the agent in `replyQueueMsg` and used by the first party agent to connect to the reply queue (the second part of the process is invisible to the users). +Connection request `connectionRequest` is generated by SMP agent in response to `newCmd` command (`"NEW"`), used by another party user with `joinCmd` command (`"JOIN"`), and then another invitation is sent by the agent in `replyQueueMsg` and used by the first party agent to connect to the reply queue (the second part of the process is invisible to the users). -See SMP protocol [out-of-band messages](./simplex-messaging.md#out-of-band-messages) for connection invitation syntax. +Connection request syntax: + +``` +connectionRequest = queueURI "#/connect/" encryptionScheme ":" publicKey +encryptionScheme = %s"rsa" ; end-to-end encryption and key exchange protocols, + ; the current hybrid encryption scheme (RSA-OAEP/AES-256-GCM-SHA256) + ; will be replaced with double ratchet protocol and DH key exchange. +publicKey = +``` + +See SMP protocol [out-of-band messages](./simplex-messaging.md#out-of-band-messages) for syntax for queueURI. [1]: https://en.wikipedia.org/wiki/End-to-end_encryption [2]: https://en.wikipedia.org/wiki/Man-in-the-middle_attack diff --git a/protocol/simplex-messaging.md b/protocol/simplex-messaging.md index a1b4ff5e9..ad08ccb89 100644 --- a/protocol/simplex-messaging.md +++ b/protocol/simplex-messaging.md @@ -7,6 +7,7 @@ - [SMP Model](#smp-model) - [Out-of-band messages](#out-of-band-messages) - [Simplex queue](#simplex-queue) +- [SMP queue URI](#smp-queue-uri) - [SMP procedure](#smp-procedure) - [SMP qualities and features](#smp-qualities-and-features) - [Cryptographic algorithms](#cryptographic-algorithms) @@ -78,34 +79,9 @@ Creating and using the queue requires sending commands to the SMP server from th ## Out-of-band messages -The out-of-band message with the queue information is sent via some trusted alternative channel from the recipient to the sender. This message is used to share the encryption (a.k.a. "public") key that the sender will use to encrypt the messages (to be decrypted by the recipient), sender queue ID, server hostname and any other information necessary to establish secure encrypted connection with SMP server (see [Appendix A](#appendix-a) for SMP transport protocol). +The out-of-band message with the queue information is sent via some trusted alternative channel from the recipient to the sender. This message is used to share one or several [queue URIs](#smp-queue-uri) that parties can use to establish the initial connection, the encryption scheme and, it can include the public key(s) for end-to-end encryption. -The [ABNF][8] syntax of the message is: - -```abnf -queueInfo = %s"smp::" smpServer "::" queueId "::" encryptionKey -smpServer = srvHost [":" port] "#" serverIdentity -srvHost = ; RFC1123, RFC5891 -port = 1*DIGIT -serverIdentity = encoded -queueId = encoded -encryptionKey = encryptionScheme ":" x509encoded ; the recipient's RSA public key for sender to encrypt messages -encryptionScheme = %s"rsa" ; end-to-end encryption and key exchange protocols, - ; the current hybrid encryption scheme (RSA-OAEP/AES-256-GCM-SHA256) - ; will be replaced with double ratchet protocol and DH key exchange. -x509encoded = -encoded = -``` - -`hostname` can be IP address or domain name, as defined in RFC 1123, section 2.1. - -`port` is optional, the default TCP port for SMP protocol is 5223. - -`serverIdentity` is a required hash of the server certificate SPKI block (without line breaks, header and footer) used by the client to validate server certificate during transport handshake (see [Appendix A](#appendix-a)). - -Encryption keys are encoded using [X509][11] specification. - -Defining the approach to out-of-band message passing is out of scope of this protocol. +The approach to out-of-band message passing and their syntax should be defined in application-level protocols. ## Simplex queue @@ -133,6 +109,28 @@ Queue is defined by recipient ID `RID` and sender ID `SID`, unique for the serve The protocol uses different IDs for sender and recipient in order to provide an additional privacy by preventing the correlation of senders and recipients commands sent over the network - in case the encrypted transport is compromised, it would still be difficult to correlate senders and recipients without access to the queue records on the server. +## SMP queue URI + +The SMP queue URI should include queue hostname, an optional port, sender queue ID and server identity to establish secure connection with SMP server (see [Appendix A](#appendix-a) for SMP transport protocol). + +The [ABNF][8] syntax of the queue URI is: + +```abnf +queueURI = %s"smp://" smpServer "/" queueId +smpServer = serverIdentity "@" srvHost [":" port] +srvHost = ; RFC1123, RFC5891 +port = 1*DIGIT +serverIdentity = base64url +queueId = base64url +base64url = ; RFC4648, section 5 +``` + +`hostname` can be IP address or domain name, as defined in RFC 1123, section 2.1. + +`port` is optional, the default TCP port for SMP protocol is 5223. + +`serverIdentity` is a required hash of the server certificate SPKI block (without line breaks, header and footer) used by the client to validate server certificate during transport handshake (see [Appendix A](#appendix-a)) + ## SMP procedure The SMP procedure of creating a simplex queue on SMP server is explained using participants Alice (the recipient) who wants to receive messages from Bob (the sender). diff --git a/protocol/smp-uri-request.txt b/protocol/smp-uri-request.txt new file mode 100644 index 000000000..ffa3fd263 --- /dev/null +++ b/protocol/smp-uri-request.txt @@ -0,0 +1,16 @@ +Scheme name: smp + +Status: Provisional + +Applications/protocols that use this scheme name: +This scheme is used for URIs of message queues in SimpleX Messaging Protocol, +a client-server protocol for asynchronous distributed unidirectional +message transmission via persistent message queues. + +Contact: Evgeny Poberezkin + +Change controller: Evgeny Poberezkin + +References: +The syntax for message queue URIs in the latest version of SimpleX Messaging Protocol: +https://github.com/simplex-chat/simplexmq/blob/v5/protocol/simplex-messaging.md#smp-queue-uri From f3d79ebcda6ec2a9b575fc9527a7c37675af8d19 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Thu, 25 Nov 2021 17:24:00 +0000 Subject: [PATCH 06/13] update SMP protocol to include server signature and encryption keys --- protocol/simplex-messaging.md | 61 +++++++++++++++++++++++++---------- 1 file changed, 44 insertions(+), 17 deletions(-) diff --git a/protocol/simplex-messaging.md b/protocol/simplex-messaging.md index ad08ccb89..8994ce449 100644 --- a/protocol/simplex-messaging.md +++ b/protocol/simplex-messaging.md @@ -111,12 +111,13 @@ The protocol uses different IDs for sender and recipient in order to provide an ## SMP queue URI -The SMP queue URI should include queue hostname, an optional port, sender queue ID and server identity to establish secure connection with SMP server (see [Appendix A](#appendix-a) for SMP transport protocol). +The SMP queue URIs MUST include server identity, queue hostname, an optional port, sender queue ID and the public key that the clients must use to verify responses. Server identity is used to establish secure connection protected from MITM attack with SMP server (see [Appendix A](#appendix-a) for SMP transport protocol). The [ABNF][8] syntax of the queue URI is: ```abnf -queueURI = %s"smp://" smpServer "/" queueId +queueURI = %s"smp://" smpServer "/" queueId "#" serverSignaturePublicKey +; serverSignaturePublicKey syntax is defined below smpServer = serverIdentity "@" srvHost [":" port] srvHost = ; RFC1123, RFC5891 port = 1*DIGIT @@ -281,7 +282,7 @@ Simplex Messaging Protocol: ## Cryptographic algorithms -Simplex messaging clients need to cryptographically sign commands for the following operations: +Simplex messaging clients and servers must cryptographically sign commands, responses and messages for the following operations: - With the recipient's key `RK` (server to verify): - create the queue (`NEW`) @@ -295,18 +296,22 @@ Simplex messaging clients need to cryptographically sign commands for the follow - send messages (`SEND`) - With the optional notifier's key: - subscribe to message notifications (`NSUB`) +- With the server's key (for recipient and sender to verify) + - queue IDs response (`IDS`) + - notifier queue ID response (`NID`) + - delivered messages (`MSG`) + - `OK` and `ERR` responses -To sign and verify commands, clients and servers MUST use RSA-PSS algorithm defined in [RFC3447][2]. +To sign/verify commands, messages and responses, clients and servers MUST use Ed25519 or Ed448 algorithm defined in [RFC8709][15]. -To optionally sign and verify messages, clients SHOULD use RSA-PSS algorithm. +To encrypt/decrypt message bodies delivered to the recipients, clients and servers MUST use x25519 or x448 algorithm defined in [RFC8709][15]. -To encrypt and decrypt messages, clients and servers SHOULD use RSA-OAEP algorithm defined in [RFC3447][2]. +Clients MUST encrypt message bodies sent via SMP servers - the protocol for this end-to-end encryption should be chosen by the clients using SMP protocol. The reasons to use these algorithms: -- They are supported by WebCrypto API. -- They are more widely supported than ECC algorithms. -- They are newer versions than RSA-PKCS1-v1_5 encryption and signature schemes. +- Faster operation that RSA algorithms. +- DH key exchange provides forward secrecy. Future versions of the protocol may allow different cryptographic algorithms. @@ -395,22 +400,37 @@ Sending any of the commands in this section (other than `create`, that is sent w This command is sent by the recipient to the SMP server to create a new queue. The syntax is: ```abnf -create = %s"NEW" SP recipientKey -recipientKey = signatureScheme ":" x509encoded ; the recipient's public key to verify commands for this queue -signatureScheme = %s"rsa" | %s"ed25519" | %s"ed448" ; "rsa" means deprecated RSA-PSS signature scheme, - ; it must not be used for the new queues. +create = %s"NEW" SP recipientSignaturePublicKey SP recipientDhPublicKey +recipientSignaturePublicKey = signatureKey +; the recipient's public key to verify commands for this queue +signatureKey = signatureScheme ":" x509encoded +signatureScheme = %s"rsa" | %s"ed25519" | %s"ed448" +; "rsa" means deprecated RSA-PSS signature scheme, +; it must not be used for the new queues. +recipientDhPublicKey = dhPublicKey +dhPublicKey = encryptionScheme ":" x509encoded +; the recipient's key for DH exchange to derive the secret +; that the server will use to encrypt delivered message bodies +encryptionScheme = %s"x25519" | %s"x448" + x509encoded = ``` -If the queue is created successfully, the server must send `queueIds` response with the recipient's and sender's queue IDs: +If the queue is created successfully, the server must send `queueIds` response with the recipient's and sender's queue IDs and public keys to sign all responses and messages and to encrypt delivered message bodies: ```abnf queueIds = %s"IDS" SP recipientId SP senderId + SP serverSignaturePublicKey SP serverDhPublicKey +serverSignaturePublicKey = signatureKey +; the server's public key to verify responses and messages for this queue +serverDhPublicKey = dhPublicKey +; the server's key for DH exchange to derive the secret +; that the server will use to encrypt delivered message bodies recipientId = encoded senderId = encoded ``` -This response should be sent with empty queue ID (the second part of the transmission). +This response should be sent with empty queue ID (the third part of the transmission). Once the queue is created, the recipient gets automatically subscribed to receive the messages from that queue, until the transport connection is closed. The `subscribe` command is needed only to start receiving the messages from the existing queue when the new transport connection is opened. @@ -457,7 +477,7 @@ notifierId = %s"NID" SP notifierId recipientId = encoded ``` -This response is sent with the recipient's queue ID (the second part of the transmission). +This response is sent with the recipient's queue ID (the third part of the transmission). To receive the message notifications, `subscribeNotifications` command ("NSUB") must be sent signed with the notifier's key. @@ -565,7 +585,9 @@ See its syntax in [Create queue command](#create-queue-command) The server must deliver messages to all subscribed simplex queues on the currently open transport connection. The syntax for the message delivery is: ```abnf -message = %s"MSG" SP msgId SP timestamp SP size SP msgBody SP +message = %s"MSG" SP encryptedMessage +encryptedMessage = +sentMessage = msgId SP timestamp SP size SP msgBody SP msgId = encoded timestamp = ``` @@ -576,6 +598,10 @@ timestamp = `msgBody` - see syntax in [Send message](#send-message) +When server delivers the messages to the recipient, message body should be encrypted with the secret derived from DH exchange using the keys passed during the queue creation and returned with `queueIds` response. + +This is done to prevent the possibility of correlation of incoming and outgoing traffic of SMP server inside transport protocol. + #### Notifier queue ID response Server must respond with this message when queue notifications are enabled. @@ -698,3 +724,4 @@ The communication party (client or server) that has the lower protocol version s [12]: https://tools.ietf.org/html/rfc7714 [13]: https://datatracker.ietf.org/doc/html/rfc8446 [14]: https://datatracker.ietf.org/doc/html/rfc5929#section-3 +[15]: https://www.rfc-editor.org/rfc/rfc8709.html From ab875198ed27b26a38d5cc741200e799e73e4072 Mon Sep 17 00:00:00 2001 From: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> Date: Sat, 27 Nov 2021 02:31:15 +1000 Subject: [PATCH 07/13] SMP protocol typo --- protocol/simplex-messaging.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/protocol/simplex-messaging.md b/protocol/simplex-messaging.md index 8994ce449..d90b3353b 100644 --- a/protocol/simplex-messaging.md +++ b/protocol/simplex-messaging.md @@ -310,7 +310,7 @@ Clients MUST encrypt message bodies sent via SMP servers - the protocol for this The reasons to use these algorithms: -- Faster operation that RSA algorithms. +- Faster operation than RSA algorithms. - DH key exchange provides forward secrecy. Future versions of the protocol may allow different cryptographic algorithms. From 99b374989024f7dd6eefca78ed0388afaff3cc41 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sun, 28 Nov 2021 07:08:47 +0000 Subject: [PATCH 08/13] simplify RSA private key types (#207) * simplify RSA private key types * remove updateSignKey method --- apps/smp-server/Main.hs | 10 +- protocol/agent-protocol.md | 4 +- src/Simplex/Messaging/Agent.hs | 26 ++-- src/Simplex/Messaging/Agent/Protocol.hs | 4 +- src/Simplex/Messaging/Agent/Store.hs | 1 - src/Simplex/Messaging/Agent/Store/SQLite.hs | 12 -- src/Simplex/Messaging/Client.hs | 4 +- src/Simplex/Messaging/Crypto.hs | 130 ++++---------------- src/Simplex/Messaging/Protocol.hs | 6 +- src/Simplex/Messaging/Server/Env/STM.hs | 4 +- src/Simplex/Messaging/Transport.hs | 4 +- tests/AgentTests/SQLiteTests.hs | 34 +++-- tests/ServerTests.hs | 4 +- 13 files changed, 75 insertions(+), 168 deletions(-) diff --git a/apps/smp-server/Main.hs b/apps/smp-server/Main.hs index b71bed5d4..ba8cfe702 100644 --- a/apps/smp-server/Main.hs +++ b/apps/smp-server/Main.hs @@ -101,7 +101,7 @@ getConfig opts = do storeLog <- liftIO $ openStoreLog opts ini pure $ makeConfig ini pk storeLog -makeConfig :: IniOpts -> C.FullPrivateKey -> Maybe (StoreLog 'ReadMode) -> ServerConfig +makeConfig :: IniOpts -> C.PrivateKey -> Maybe (StoreLog 'ReadMode) -> ServerConfig makeConfig IniOpts {serverPort, blockSize, enableWebsockets} pk storeLog = let transports = (serverPort, transport @TCP) : [("80", transport @WS) | enableWebsockets] in serverConfig {serverPrivateKey = pk, storeLog, blockSize, transports} @@ -200,11 +200,11 @@ createIni ServerOpts {enableStoreLog} = do enableWebsockets = True } -readKey :: IniOpts -> ExceptT String IO C.FullPrivateKey +readKey :: IniOpts -> ExceptT String IO C.PrivateKey readKey IniOpts {serverKeyFile} = do fileExists serverKeyFile liftIO (S.readKeyFile serverKeyFile) >>= \case - [S.Unprotected (PrivKeyRSA pk)] -> pure $ C.FullPrivateKey pk + [S.Unprotected (PrivKeyRSA pk)] -> pure $ C.PrivateKey pk [_] -> err "not RSA key" [] -> err "invalid key file format" _ -> err "more than one key" @@ -212,7 +212,7 @@ readKey IniOpts {serverKeyFile} = do err :: String -> ExceptT String IO b err e = throwE $ e <> ": " <> serverKeyFile -createKey :: IniOpts -> IO C.FullPrivateKey +createKey :: IniOpts -> IO C.PrivateKey createKey IniOpts {serverKeyFile} = do (_, pk) <- C.generateKeyPair newKeySize S.writeKeyFile S.TraditionalFormat serverKeyFile [PrivKeyRSA $ C.rsaPrivateKey pk] @@ -233,7 +233,7 @@ confirm msg = do ok <- getLine when (map toLower ok /= "y") exitFailure -serverKeyHash :: C.FullPrivateKey -> B.ByteString +serverKeyHash :: C.PrivateKey -> B.ByteString serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey' openStoreLog :: ServerOpts -> IniOpts -> IO (Maybe (StoreLog 'ReadMode)) diff --git a/protocol/agent-protocol.md b/protocol/agent-protocol.md index 417a75853..41c1297b4 100644 --- a/protocol/agent-protocol.md +++ b/protocol/agent-protocol.md @@ -40,9 +40,7 @@ It provides: SMP agent protocol provides no encryption or security on the client side - it is assumed that the agent is executed in the trusted and secure environment, in one of three ways: - via TCP network using secure connection. - via local port (when the agent runs on the same device as a separate process). -- via agent library, when the agent logic is included directly into the client application. - -The last option is the most secure, as it reduces the number of attack vectors in comparison with other options. [SimpleX Chat for terminal](https://github.com/simplex-chat/simplex-chat) uses this approach. +- via agent library, when the agent logic is included directly into the client application - [SimpleX Chat for terminal](https://github.com/simplex-chat/simplex-chat) uses this approach. ## SMP agent diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index b539cf501..7b48bcc04 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -298,30 +298,27 @@ subscribeConnection' c connId = SomeConn _ (DuplexConnection _ rq sq) -> do resumeMsgDelivery c connId sq case status (sq :: SndQueue) of - Confirmed -> withVerifyKey sq $ \verifyKey -> do + Confirmed -> do conf <- withStore (`getAcceptedConfirmation` connId) secureQueue c rq $ senderKey (conf :: AcceptedConfirmation) withStore $ \st -> setRcvQueueStatus st rq Secured - activateSecuredQueue rq sq verifyKey - Secured -> withVerifyKey sq $ activateSecuredQueue rq sq + activateSecuredQueue rq sq + Secured -> activateSecuredQueue rq sq Active -> subscribeQueue c rq connId _ -> throwError $ INTERNAL "unexpected queue status" SomeConn _ (SndConnection _ sq) -> do resumeMsgDelivery c connId sq case status (sq :: SndQueue) of - Confirmed -> withVerifyKey sq $ \verifyKey -> - activateQueueJoining c connId sq verifyKey =<< resumeInterval + Confirmed -> activateQueueJoining c connId sq (verifyKey sq) =<< resumeInterval Active -> throwError $ CONN SIMPLEX _ -> throwError $ INTERNAL "unexpected queue status" SomeConn _ (RcvConnection _ rq) -> subscribeQueue c rq connId where - withVerifyKey :: SndQueue -> (C.PublicKey -> m ()) -> m () - withVerifyKey sq action = - let err = throwError $ INTERNAL "missing signing key public counterpart" - in maybe err action . C.publicKey $ signKey sq - activateSecuredQueue :: RcvQueue -> SndQueue -> C.PublicKey -> m () - activateSecuredQueue rq sq verifyKey = do - activateQueueInitiating c connId sq verifyKey =<< resumeInterval + verifyKey :: SndQueue -> C.PublicKey + verifyKey = C.publicKey' . signKey + activateSecuredQueue :: RcvQueue -> SndQueue -> m () + activateSecuredQueue rq sq = do + activateQueueInitiating c connId sq (verifyKey sq) =<< resumeInterval subscribeQueue c rq connId resumeInterval :: m RetryInterval resumeInterval = do @@ -600,12 +597,7 @@ activateQueue c connId sq verifyKey retryInterval afterActivation = sendHello c sq verifyKey retryInterval withStore $ \st -> setSndQueueStatus st sq Active removeActivation c connId - removeVerificationKey afterActivation - removeVerificationKey :: m () - removeVerificationKey = - let safeSignKey = C.removePublicKey $ signKey sq - in withStore $ \st -> updateSignKey st sq safeSignKey notifyConnected :: AgentMonad m => AgentClient -> ConnId -> m () notifyConnected c connId = atomically $ writeTBQueue (subQ c) ("", connId, CON) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 44e42cdd4..0614a2df8 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -339,10 +339,10 @@ data SMPQueueInfo = SMPQueueInfo SMPServer SMP.SenderId EncryptionKey type EncryptionKey = C.PublicKey -- | Private key used to E2E decrypt SMP messages. -type DecryptionKey = C.SafePrivateKey +type DecryptionKey = C.PrivateKey -- | Private key used to sign SMP commands -type SignatureKey = C.APrivateKey +type SignatureKey = C.PrivateKey -- | Public key used by SMP server to authorize (verify) SMP commands. type VerificationKey = C.PublicKey diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 7ef0e7f1e..f6bdec954 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -43,7 +43,6 @@ class Monad m => MonadAgentStore s m where setRcvQueueStatus :: s -> RcvQueue -> QueueStatus -> m () setRcvQueueActive :: s -> RcvQueue -> VerificationKey -> m () setSndQueueStatus :: s -> SndQueue -> QueueStatus -> m () - updateSignKey :: s -> SndQueue -> SignatureKey -> m () -- Confirmations createConfirmation :: s -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index ec05920d6..177dd2950 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -279,18 +279,6 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto |] [":status" := status, ":host" := host, ":port" := serializePort_ port, ":snd_id" := sndId] - updateSignKey :: SQLiteStore -> SndQueue -> SignatureKey -> m () - updateSignKey st SndQueue {sndId, server = SMPServer {host, port}} signatureKey = - liftIO . withTransaction st $ \db -> - DB.executeNamed - db - [sql| - UPDATE snd_queues - SET sign_key = :sign_key - WHERE host = :host AND port = :port AND snd_id = :snd_id; - |] - [":sign_key" := signatureKey, ":host" := host, ":port" := serializePort_ port, ":snd_id" := sndId] - createConfirmation :: SQLiteStore -> TVar ChaChaDRG -> NewConfirmation -> m ConfirmationId createConfirmation st gVar NewConfirmation {connId, senderKey, senderConnInfo} = liftIOEither . withTransaction st $ \db -> diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index f39dc2e05..7c845d809 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -333,14 +333,14 @@ suspendSMPQueue = okSMPCommand $ Cmd SRecipient OFF deleteSMPQueue :: SMPClient -> RecipientPrivateKey -> QueueId -> ExceptT SMPClientError IO () deleteSMPQueue = okSMPCommand $ Cmd SRecipient DEL -okSMPCommand :: Cmd -> SMPClient -> C.SafePrivateKey -> QueueId -> ExceptT SMPClientError IO () +okSMPCommand :: Cmd -> SMPClient -> C.PrivateKey -> QueueId -> ExceptT SMPClientError IO () okSMPCommand cmd c pKey qId = sendSMPCommand c (Just pKey) qId cmd >>= \case Cmd _ OK -> return () _ -> throwE SMPUnexpectedResponse -- | Send any SMP command ('Cmd' type). -sendSMPCommand :: SMPClient -> Maybe C.SafePrivateKey -> QueueId -> Cmd -> ExceptT SMPClientError IO Cmd +sendSMPCommand :: SMPClient -> Maybe C.PrivateKey -> QueueId -> Cmd -> ExceptT SMPClientError IO Cmd sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, tcpTimeout} pKey qId cmd = do corrId <- lift_ getNextCorrId t <- signTransmission $ serializeTransmission (corrId, qId, cmd) diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index ccd8f5f90..a92c75ffd 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/src/Simplex/Messaging/Crypto.hs @@ -20,20 +20,14 @@ -- . module Simplex.Messaging.Crypto ( -- * RSA keys - PrivateKey (rsaPrivateKey, publicKey), - SafePrivateKey (..), -- constructor is not exported - FullPrivateKey (..), - APrivateKey (..), + PrivateKey (..), PublicKey (..), - SafeKeyPair, - FullKeyPair, + KeyPair, KeyHash (..), generateKeyPair, publicKey', publicKeySize, validKeySize, - safePrivateKey, - removePublicKey, -- * E2E hybrid encryption scheme encrypt, @@ -114,86 +108,25 @@ import Simplex.Messaging.Util (liftEitherError, (<$?>)) -- | A newtype of 'Crypto.PubKey.RSA.PublicKey'. newtype PublicKey = PublicKey {rsaPublicKey :: R.PublicKey} deriving (Eq, Show) --- | A newtype of 'Crypto.PubKey.RSA.PrivateKey', with PublicKey removed. --- --- It is not possible to recover PublicKey from SafePrivateKey. --- The constructor of this type is not exported. -newtype SafePrivateKey = SafePrivateKey {unPrivateKey :: R.PrivateKey} deriving (Eq, Show) - --- | A newtype of 'Crypto.PubKey.RSA.PrivateKey' (with PublicKey inside). -newtype FullPrivateKey = FullPrivateKey {unPrivateKey :: R.PrivateKey} deriving (Eq, Show) - -- | A newtype of 'Crypto.PubKey.RSA.PrivateKey' (PublicKey may be inside). -newtype APrivateKey = APrivateKey {unPrivateKey :: R.PrivateKey} deriving (Eq, Show) +newtype PrivateKey = PrivateKey {rsaPrivateKey :: R.PrivateKey} deriving (Eq, Show) --- | Type-class used for both private key types: SafePrivateKey and FullPrivateKey. -class PrivateKey k where - -- unwraps 'Crypto.PubKey.RSA.PrivateKey' - rsaPrivateKey :: k -> R.PrivateKey - - -- equivalent to data type constructor, not exported - _privateKey :: R.PrivateKey -> k - - -- smart constructor removing public key from SafePrivateKey but keeping it in FullPrivateKey - mkPrivateKey :: R.PrivateKey -> k - - -- extracts public key from private key - publicKey :: k -> Maybe PublicKey - --- | Remove public key exponent from APrivateKey. -removePublicKey :: APrivateKey -> APrivateKey -removePublicKey (APrivateKey R.PrivateKey {private_pub = k, private_d}) = - APrivateKey $ unPrivateKey (safePrivateKey (R.public_size k, R.public_n k, private_d) :: SafePrivateKey) - -instance PrivateKey SafePrivateKey where - rsaPrivateKey = unPrivateKey - _privateKey = SafePrivateKey - mkPrivateKey R.PrivateKey {private_pub = k, private_d} = - safePrivateKey (R.public_size k, R.public_n k, private_d) - publicKey _ = Nothing - -instance PrivateKey FullPrivateKey where - rsaPrivateKey = unPrivateKey - _privateKey = FullPrivateKey - mkPrivateKey = FullPrivateKey - publicKey = Just . PublicKey . R.private_pub . rsaPrivateKey - -instance PrivateKey APrivateKey where - rsaPrivateKey = unPrivateKey - _privateKey = APrivateKey - mkPrivateKey = APrivateKey - publicKey pk = - let k = R.private_pub $ rsaPrivateKey pk - in if R.public_e k == 0 - then Nothing - else Just $ PublicKey k - -instance IsString FullPrivateKey where +instance IsString PrivateKey where fromString = parseString $ decode >=> decodePrivKey instance IsString PublicKey where fromString = parseString $ decode >=> decodePubKey -instance ToField SafePrivateKey where toField = toField . encodePrivKey - -instance ToField APrivateKey where toField = toField . encodePrivKey +instance ToField PrivateKey where toField = toField . encodePrivKey instance ToField PublicKey where toField = toField . encodePubKey -instance FromField SafePrivateKey where fromField = blobFieldParser binaryPrivKeyP - -instance FromField APrivateKey where fromField = blobFieldParser binaryPrivKeyP +instance FromField PrivateKey where fromField = blobFieldParser binaryPrivKeyP instance FromField PublicKey where fromField = blobFieldParser binaryPubKeyP -- | Tuple of RSA 'PublicKey' and 'PrivateKey'. -type KeyPair k = (PublicKey, k) - --- | Tuple of RSA 'PublicKey' and 'SafePrivateKey'. -type SafeKeyPair = (PublicKey, SafePrivateKey) - --- | Tuple of RSA 'PublicKey' and 'FullPrivateKey'. -type FullKeyPair = (PublicKey, FullPrivateKey) +type KeyPair = (PublicKey, PrivateKey) -- | RSA signature newtype. newtype Signature = Signature {unSignature :: ByteString} deriving (Eq, Show) @@ -230,8 +163,8 @@ aesKeySize = 256 `div` 8 authTagSize :: Int authTagSize = 128 `div` 8 --- | Generate RSA key pair with either SafePrivateKey or FullPrivateKey. -generateKeyPair :: PrivateKey k => Int -> IO (KeyPair k) +-- | Generate RSA key pair. +generateKeyPair :: Int -> IO KeyPair generateKeyPair size = loop where publicExponent = findPrimeFrom . (+ 3) <$> generateMax pubExpRange @@ -241,12 +174,12 @@ generateKeyPair size = loop d = R.private_d pk if d * d < n then loop - else pure (PublicKey k, mkPrivateKey pk) + else pure (PublicKey k, PrivateKey pk) -privateKeySize :: PrivateKey k => k -> Int +privateKeySize :: PrivateKey -> Int privateKeySize = R.public_size . R.private_pub . rsaPrivateKey -publicKey' :: FullPrivateKey -> PublicKey +publicKey' :: PrivateKey -> PublicKey publicKey' = PublicKey . R.private_pub . rsaPrivateKey publicKeySize :: PublicKey -> Int @@ -331,7 +264,7 @@ encrypt k paddedSize msg = do -- | E2E decrypt SMP agent messages. -- -- https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-01-26-crypto.md#e2e-encryption -decrypt :: PrivateKey k => k -> ByteString -> ExceptT CryptoError IO ByteString +decrypt :: PrivateKey -> ByteString -> ExceptT CryptoError IO ByteString decrypt pk msg'' = do let (encHeader, msg') = B.splitAt (privateKeySize pk) msg'' header <- decryptOAEP pk encHeader @@ -410,7 +343,7 @@ encryptOAEP (PublicKey k) aesKey = -- | RSA OAEP decryption. -- -- Used as part of hybrid E2E encryption scheme and for SMP transport handshake. -decryptOAEP :: PrivateKey k => k -> ByteString -> ExceptT CryptoError IO ByteString +decryptOAEP :: PrivateKey -> ByteString -> ExceptT CryptoError IO ByteString decryptOAEP pk encKey = liftEitherError RSADecryptError $ OAEP.decryptSafer oaepParams (rsaPrivateKey pk) encKey @@ -421,7 +354,7 @@ pssParams = PSS.defaultPSSParams SHA256 -- | RSA PSS message signing. -- -- Used by SMP clients to sign SMP commands and by SMP agents to sign messages. -sign :: PrivateKey k => k -> ByteString -> ExceptT CryptoError IO Signature +sign :: PrivateKey -> ByteString -> ExceptT CryptoError IO Signature sign pk msg = ExceptT $ bimap RSASignError Signature <$> PSS.signSafer pssParams (rsaPrivateKey pk) msg -- | RSA PSS signature verification. @@ -439,7 +372,7 @@ serializePubKey = ("rsa:" <>) . encode . encodePubKey -- | Base-64 PKCS8 encoding of PSA private key. -- -- Not used as part of SMP protocols. -serializePrivKey :: PrivateKey k => k -> ByteString +serializePrivKey :: PrivateKey -> ByteString serializePrivKey = ("rsa:" <>) . encode . encodePrivKey -- Base-64 X509 RSA public key parser. @@ -451,40 +384,19 @@ binaryPubKeyP :: Parser PublicKey binaryPubKeyP = decodePubKey <$?> A.takeByteString -- Base-64 PKCS8 RSA private key parser. -privKeyP :: PrivateKey k => Parser k +privKeyP :: Parser PrivateKey privKeyP = decodePrivKey <$?> ("rsa:" *> base64P) -- Binary PKCS8 RSA private key parser. -binaryPrivKeyP :: PrivateKey k => Parser k +binaryPrivKeyP :: Parser PrivateKey binaryPrivKeyP = decodePrivKey <$?> A.takeByteString --- | Construct 'SafePrivateKey' from three numbers - used internally and in the tests. -safePrivateKey :: (Int, Integer, Integer) -> SafePrivateKey -safePrivateKey = SafePrivateKey . safeRsaPrivateKey - -safeRsaPrivateKey :: (Int, Integer, Integer) -> R.PrivateKey -safeRsaPrivateKey (size, n, d) = - R.PrivateKey - { private_pub = - R.PublicKey - { public_size = size, - public_n = n, - public_e = 0 - }, - private_d = d, - private_p = 0, - private_q = 0, - private_dP = 0, - private_dQ = 0, - private_qinv = 0 - } - -- Binary X509 encoding of 'PublicKey'. encodePubKey :: PublicKey -> ByteString encodePubKey = encodeKey . PubKeyRSA . rsaPublicKey -- Binary PKCS8 encoding of 'PrivateKey'. -encodePrivKey :: PrivateKey k => k -> ByteString +encodePrivKey :: PrivateKey -> ByteString encodePrivKey = encodeKey . PrivKeyRSA . rsaPrivateKey encodeKey :: ASN1Object a => a -> ByteString @@ -498,10 +410,10 @@ decodePubKey = r -> keyError r -- Decoding of binary PKCS8 'PrivateKey'. -decodePrivKey :: PrivateKey k => ByteString -> Either String k +decodePrivKey :: ByteString -> Either String PrivateKey decodePrivKey = decodeKey >=> \case - (PrivKeyRSA pk, []) -> Right $ mkPrivateKey pk + (PrivKeyRSA pk, []) -> Right $ PrivateKey pk r -> keyError r decodeKey :: ASN1Object a => ByteString -> Either String (a, [ASN1]) diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 02056acc4..d80f25ed5 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -177,7 +177,7 @@ instance IsString CorrId where -- | Recipient's private key used by the recipient to authorize (sign) SMP commands. -- -- Only used by SMP agent, kept here so its definition is close to respective public key. -type RecipientPrivateKey = C.SafePrivateKey +type RecipientPrivateKey = C.PrivateKey -- | Recipient's public key used by SMP server to verify authorization of SMP commands. type RecipientPublicKey = C.PublicKey @@ -185,13 +185,13 @@ type RecipientPublicKey = C.PublicKey -- | Sender's private key used by the recipient to authorize (sign) SMP commands. -- -- Only used by SMP agent, kept here so its definition is close to respective public key. -type SenderPrivateKey = C.SafePrivateKey +type SenderPrivateKey = C.PrivateKey -- | Sender's public key used by SMP server to verify authorization of SMP commands. type SenderPublicKey = C.PublicKey -- | Private key used by push notifications server to authorize (sign) LSTN command. -type NotifierPrivateKey = C.SafePrivateKey +type NotifierPrivateKey = C.PrivateKey -- | Public key used by SMP server to verify authorization of LSTN command sent by push notifications server. type NotifierPublicKey = C.PublicKey diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index 5a0ebacea..83f2f2633 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -30,7 +30,7 @@ data ServerConfig = ServerConfig msgIdBytes :: Int, storeLog :: Maybe (StoreLog 'ReadMode), blockSize :: Int, - serverPrivateKey :: C.FullPrivateKey + serverPrivateKey :: C.PrivateKey -- serverId :: ByteString } @@ -40,7 +40,7 @@ data Env = Env queueStore :: QueueStore, msgStore :: STMMsgStore, idsDrg :: TVar ChaChaDRG, - serverKeyPair :: C.FullKeyPair, + serverKeyPair :: C.KeyPair, storeLog :: Maybe (StoreLog 'WriteMode) } diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index 06382563c..6c15576b6 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -63,7 +63,7 @@ import Data.ByteArray (xor) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Functor (($>)) -import Data.Maybe(fromMaybe) +import Data.Maybe (fromMaybe) import Data.Set (Set) import qualified Data.Set as S import Data.String @@ -345,7 +345,7 @@ makeNextIV SessionKey {baseIV, counter} = atomically $ do -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a -- -- The numbers in function names refer to the steps in the document. -serverHandshake :: forall c. Transport c => c -> Int -> C.FullKeyPair -> ExceptT TransportError IO (THandle c) +serverHandshake :: forall c. Transport c => c -> Int -> C.KeyPair -> ExceptT TransportError IO (THandle c) serverHandshake c srvBlockSize (k, pk) = do checkValidBlockSize srvBlockSize liftIO sendHeaderAndPublicKey_1 diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 26d652ad9..83333fea5 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -149,14 +149,32 @@ testForeignKeysEnabled = cData1 :: ConnData cData1 = ConnData {connId = "conn1"} +testPrivateKey :: C.PrivateKey +testPrivateKey = + C.PrivateKey + R.PrivateKey + { private_pub = + R.PublicKey + { public_size = 1, + public_n = 2, + public_e = 0 + }, + private_d = 3, + private_p = 0, + private_q = 0, + private_dP = 0, + private_dQ = 0, + private_qinv = 0 + } + rcvQueue1 :: RcvQueue rcvQueue1 = RcvQueue { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash, rcvId = "1234", - rcvPrivateKey = C.safePrivateKey (1, 2, 3), + rcvPrivateKey = testPrivateKey, sndId = Just "2345", - decryptKey = C.safePrivateKey (1, 2, 3), + decryptKey = testPrivateKey, verifyKey = Nothing, status = New } @@ -166,9 +184,9 @@ sndQueue1 = SndQueue { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash, sndId = "3456", - sndPrivateKey = C.safePrivateKey (1, 2, 3), + sndPrivateKey = testPrivateKey, encryptKey = C.PublicKey $ R.PublicKey 1 2 3, - signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey), + signKey = testPrivateKey, status = New } @@ -306,9 +324,9 @@ testUpgradeRcvConnToDuplex = SndQueue { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash, sndId = "2345", - sndPrivateKey = C.safePrivateKey (1, 2, 3), + sndPrivateKey = testPrivateKey, encryptKey = C.PublicKey $ R.PublicKey 1 2 3, - signKey = C.APrivateKey $ C.unPrivateKey (C.safePrivateKey (1, 2, 3) :: C.SafePrivateKey), + signKey = testPrivateKey, status = New } upgradeRcvConnToDuplex store "conn1" anotherSndQueue @@ -326,9 +344,9 @@ testUpgradeSndConnToDuplex = RcvQueue { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash, rcvId = "3456", - rcvPrivateKey = C.safePrivateKey (1, 2, 3), + rcvPrivateKey = testPrivateKey, sndId = Just "4567", - decryptKey = C.safePrivateKey (1, 2, 3), + decryptKey = testPrivateKey, verifyKey = Nothing, status = New } diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 3d328a4af..7c12b9e18 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -47,7 +47,7 @@ pattern Resp corrId queueId command <- ("", (corrId, queueId, Right (Cmd SBroker sendRecv :: Transport c => THandle c -> (ByteString, ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError sendRecv h (sgn, corrId, qId, cmd) = tPutRaw h (sgn, corrId, encode qId, cmd) >> tGet fromServer h -signSendRecv :: Transport c => THandle c -> C.SafePrivateKey -> (ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError +signSendRecv :: Transport c => THandle c -> C.PrivateKey -> (ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError signSendRecv h pk (corrId, qId, cmd) = do let t = B.intercalate " " [corrId, encode qId, cmd] Right sig <- runExceptT $ C.sign pk t @@ -332,7 +332,7 @@ testWithStoreLog at@(ATransport t) = Right l -> pure l Left (_ :: SomeException) -> logSize -createAndSecureQueue :: Transport c => THandle c -> SenderPublicKey -> IO (SenderId, RecipientId, C.SafePrivateKey) +createAndSecureQueue :: Transport c => THandle c -> SenderPublicKey -> IO (SenderId, RecipientId, C.PrivateKey) createAndSecureQueue h sPub = do (rPub, rKey) <- C.generateKeyPair rsaKeySize Resp "abcd" "" (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub) From e1002d5ac075e125d50de8410e0ff474c44eda23 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sun, 28 Nov 2021 11:44:22 +0000 Subject: [PATCH 09/13] GADTs for cryptographic keys (#208) * GADTs for cryptographic keys * update tests (signature timing tests still fail) * fix signature verification timing tests * configurable algorithm to sign commands to SMP queues (Ed448 by default) * add dummy Ed keys, add timing tests for Ed keys * re-enable Connection subscriptions tests --- apps/smp-server/Main.hs | 16 +- src/Simplex/Messaging/Agent.hs | 27 +- src/Simplex/Messaging/Agent/Client.hs | 38 +- src/Simplex/Messaging/Agent/Env/SQLite.hs | 3 + src/Simplex/Messaging/Agent/Protocol.hs | 34 +- src/Simplex/Messaging/Agent/Store.hs | 11 +- src/Simplex/Messaging/Agent/Store/SQLite.hs | 3 +- src/Simplex/Messaging/Client.hs | 16 +- src/Simplex/Messaging/Crypto.hs | 727 +++++++++++++++++--- src/Simplex/Messaging/Protocol.hs | 72 +- src/Simplex/Messaging/Server.hs | 78 ++- src/Simplex/Messaging/Server/Env/STM.hs | 6 +- src/Simplex/Messaging/Server/StoreLog.hs | 20 +- src/Simplex/Messaging/Transport.hs | 15 +- tests/AgentTests/SQLiteTests.hs | 34 +- tests/SMPClient.hs | 17 +- tests/ServerTests.hs | 159 +++-- 17 files changed, 938 insertions(+), 338 deletions(-) diff --git a/apps/smp-server/Main.hs b/apps/smp-server/Main.hs index ba8cfe702..75c5080ec 100644 --- a/apps/smp-server/Main.hs +++ b/apps/smp-server/Main.hs @@ -101,7 +101,7 @@ getConfig opts = do storeLog <- liftIO $ openStoreLog opts ini pure $ makeConfig ini pk storeLog -makeConfig :: IniOpts -> C.PrivateKey -> Maybe (StoreLog 'ReadMode) -> ServerConfig +makeConfig :: IniOpts -> C.PrivateKey 'C.RSA -> Maybe (StoreLog 'ReadMode) -> ServerConfig makeConfig IniOpts {serverPort, blockSize, enableWebsockets} pk storeLog = let transports = (serverPort, transport @TCP) : [("80", transport @WS) | enableWebsockets] in serverConfig {serverPrivateKey = pk, storeLog, blockSize, transports} @@ -200,11 +200,11 @@ createIni ServerOpts {enableStoreLog} = do enableWebsockets = True } -readKey :: IniOpts -> ExceptT String IO C.PrivateKey +readKey :: IniOpts -> ExceptT String IO (C.PrivateKey 'C.RSA) readKey IniOpts {serverKeyFile} = do fileExists serverKeyFile liftIO (S.readKeyFile serverKeyFile) >>= \case - [S.Unprotected (PrivKeyRSA pk)] -> pure $ C.PrivateKey pk + [S.Unprotected (PrivKeyRSA pk)] -> pure $ C.PrivateKeyRSA pk [_] -> err "not RSA key" [] -> err "invalid key file format" _ -> err "more than one key" @@ -212,10 +212,10 @@ readKey IniOpts {serverKeyFile} = do err :: String -> ExceptT String IO b err e = throwE $ e <> ": " <> serverKeyFile -createKey :: IniOpts -> IO C.PrivateKey +createKey :: IniOpts -> IO (C.PrivateKey 'C.RSA) createKey IniOpts {serverKeyFile} = do - (_, pk) <- C.generateKeyPair newKeySize - S.writeKeyFile S.TraditionalFormat serverKeyFile [PrivKeyRSA $ C.rsaPrivateKey pk] + (_, pk) <- C.generateKeyPair' newKeySize C.SRSA + S.writeKeyFile S.TraditionalFormat serverKeyFile [C.privateToX509 pk] pure pk fileExists :: FilePath -> ExceptT String IO () @@ -233,8 +233,8 @@ confirm msg = do ok <- getLine when (map toLower ok /= "y") exitFailure -serverKeyHash :: C.PrivateKey -> B.ByteString -serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey' +serverKeyHash :: C.PrivateKey 'C.RSA -> B.ByteString +serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey openStoreLog :: ServerOpts -> IniOpts -> IO (Maybe (StoreLog 'ReadMode)) openStoreLog ServerOpts {enableStoreLog = l} IniOpts {enableStoreLog = l', storeLogFile = f} diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 7b48bcc04..bdc76278e 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -264,7 +264,7 @@ joinConn c connId qInfo cInfo = do activateQueueJoining c connId' sq verifyKey $ retryInterval cfg pure connId' -activateQueueJoining :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m () +activateQueueJoining :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m () activateQueueJoining c connId sq verifyKey retryInterval = activateQueue c connId sq verifyKey retryInterval createReplyQueue where @@ -314,8 +314,8 @@ subscribeConnection' c connId = _ -> throwError $ INTERNAL "unexpected queue status" SomeConn _ (RcvConnection _ rq) -> subscribeQueue c rq connId where - verifyKey :: SndQueue -> C.PublicKey - verifyKey = C.publicKey' . signKey + verifyKey :: SndQueue -> C.APublicVerifyKey + verifyKey = C.publicKey . signKey activateSecuredQueue :: RcvQueue -> SndQueue -> m () activateSecuredQueue rq sq = do activateQueueInitiating c connId sq (verifyKey sq) =<< resumeInterval @@ -582,11 +582,11 @@ confirmQueue c sq senderKey cInfo = do sendConfirmation c sq senderKey cInfo withStore $ \st -> setSndQueueStatus st sq Confirmed -activateQueueInitiating :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m () +activateQueueInitiating :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m () activateQueueInitiating c connId sq verifyKey retryInterval = activateQueue c connId sq verifyKey retryInterval $ notifyConnected c connId -activateQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> VerificationKey -> RetryInterval -> m () -> m () +activateQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m () -> m () activateQueue c connId sq verifyKey retryInterval afterActivation = getActivation c connId >>= \case Nothing -> async runActivation >>= addActivation c connId @@ -603,11 +603,20 @@ notifyConnected :: AgentMonad m => AgentClient -> ConnId -> m () notifyConnected c connId = atomically $ writeTBQueue (subQ c) ("", connId, CON) newSndQueue :: - (MonadUnliftIO m, MonadReader Env m) => SMPQueueInfo -> m (SndQueue, SenderPublicKey, VerificationKey) -newSndQueue (SMPQueueInfo smpServer senderId encryptKey) = do + (MonadUnliftIO m, MonadReader Env m) => SMPQueueInfo -> m (SndQueue, SenderPublicKey, C.APublicVerifyKey) +newSndQueue qInfo = + asks (cmdSignAlg . config) >>= \case + C.SignAlg a -> newSndQueue_ a qInfo + +newSndQueue_ :: + (C.SignatureAlgorithm a, C.AlgorithmI a, MonadUnliftIO m, MonadReader Env m) => + C.SAlgorithm a -> + SMPQueueInfo -> + m (SndQueue, SenderPublicKey, C.APublicVerifyKey) +newSndQueue_ a (SMPQueueInfo smpServer senderId encryptKey) = do size <- asks $ rsaKeySize . config - (senderKey, sndPrivateKey) <- liftIO $ C.generateKeyPair size - (verifyKey, signKey) <- liftIO $ C.generateKeyPair size + (senderKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair size a + (verifyKey, signKey) <- liftIO $ C.generateSignatureKeyPair size C.SRSA let sndQueue = SndQueue { server = smpServer, diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index 031403a4a..9e86fe777 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -224,13 +224,23 @@ smpClientError = \case e -> INTERNAL $ show e newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueInfo) -newRcvQueue c srv = do +newRcvQueue c srv = + asks (cmdSignAlg . config) >>= \case + C.SignAlg a -> newRcvQueue_ a c srv + +newRcvQueue_ :: + (C.SignatureAlgorithm a, C.AlgorithmI a, AgentMonad m) => + C.SAlgorithm a -> + AgentClient -> + SMPServer -> + m (RcvQueue, SMPQueueInfo) +newRcvQueue_ a c srv = do size <- asks $ rsaKeySize . config - (recipientKey, rcvPrivateKey) <- liftIO $ C.generateKeyPair size + (recipientKey, rcvPrivateKey) <- liftIO $ C.generateSignatureKeyPair size a logServer "-->" c srv "" "NEW" (rcvId, sId) <- withSMP c srv $ \smp -> createSMPQueue smp rcvPrivateKey recipientKey logServer "<--" c srv "" $ B.unwords ["IDS", logSecret rcvId, logSecret sId] - (encryptKey, decryptKey) <- liftIO $ C.generateKeyPair size + (encryptKey, decryptKey) <- liftIO $ C.generateEncryptionKeyPair size C.SRSA let rq = RcvQueue { server = srv, @@ -299,7 +309,7 @@ sendConfirmation c sq@SndQueue {server, sndId} senderKey cInfo = mkConfirmation :: SMPClient -> m MsgBody mkConfirmation smp = encryptAndSign smp sq . serializeSMPMessage $ SMPConfirmation senderKey cInfo -sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> VerificationKey -> RetryInterval -> m () +sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> C.APublicVerifyKey -> RetryInterval -> m () sendHello c sq@SndQueue {server, sndId, sndPrivateKey} verifyKey ri = withLogSMP_ c server sndId "SEND (retrying)" $ \smp -> do msg <- mkHello smp $ AckMode On @@ -350,23 +360,27 @@ encryptAndSign smp SndQueue {encryptKey, signKey} msg = do paddedSize <- asks $ (blockSize smp -) . reservedMsgSize liftError cryptoError $ do enc <- C.encrypt encryptKey paddedSize msg - C.Signature sig <- C.sign signKey enc - pure $ sig <> enc + sig <- C.sign signKey enc + pure $ C.signatureBytes sig <> enc decryptAndVerify :: AgentMonad m => RcvQueue -> ByteString -> m ByteString decryptAndVerify RcvQueue {decryptKey, verifyKey} msg = verifyMessage verifyKey msg >>= liftError cryptoError . C.decrypt decryptKey -verifyMessage :: AgentMonad m => Maybe VerificationKey -> ByteString -> m ByteString +verifyMessage :: AgentMonad m => Maybe C.APublicVerifyKey -> ByteString -> m ByteString verifyMessage verifyKey msg = do - size <- asks $ rsaKeySize . config - let (sig, enc) = B.splitAt size msg + sigSize <- asks $ rsaKeySize . config + let (s, enc) = B.splitAt sigSize msg case verifyKey of Nothing -> pure enc - Just k - | C.verify k (C.Signature sig) enc -> pure enc - | otherwise -> throwError $ AGENT A_SIGNATURE + Just k -> + case C.decodeSignature $ B.take (C.signatureSize k) s of + Left _ -> throwError $ AGENT A_SIGNATURE + Right sig -> + if C.verify k sig enc + then pure enc + else throwError $ AGENT A_SIGNATURE cryptoError :: C.CryptoError -> AgentErrorType cryptoError = \case diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index 6a063d4dd..1e9b367cd 100644 --- a/src/Simplex/Messaging/Agent/Env/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs @@ -16,6 +16,7 @@ import Simplex.Messaging.Agent.RetryInterval import Simplex.Messaging.Agent.Store.SQLite import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations import Simplex.Messaging.Client +import qualified Simplex.Messaging.Crypto as C import System.Random (StdGen, newStdGen) import UnliftIO.STM @@ -23,6 +24,7 @@ data AgentConfig = AgentConfig { tcpPort :: ServiceName, smpServers :: NonEmpty SMPServer, rsaKeySize :: Int, + cmdSignAlg :: C.SignAlg, connIdBytes :: Int, tbqSize :: Natural, dbFile :: FilePath, @@ -41,6 +43,7 @@ defaultAgentConfig = { tcpPort = "5224", smpServers = undefined, rsaKeySize = 2048 `div` 8, + cmdSignAlg = C.SignAlg C.SEd448, connIdBytes = 12, tbqSize = 16, dbFile = "smp-agent.db", diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 0614a2df8..09f9a3613 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -55,10 +55,6 @@ module Simplex.Messaging.Agent.Protocol MsgIntegrity (..), MsgErrorType (..), QueueStatus (..), - SignatureKey, - VerificationKey, - EncryptionKey, - DecryptionKey, ACorrId, AgentMsgId, @@ -223,7 +219,7 @@ data SMPMessage -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents data AMessage where -- | the first message in the queue to validate it is secured - HELLO :: VerificationKey -> AckMode -> AMessage + HELLO :: C.APublicVerifyKey -> AckMode -> AMessage -- | reply queue information REPLY :: SMPQueueInfo -> AMessage -- | agent envelope for the client message @@ -238,7 +234,7 @@ parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE smpMessageP = A.endOfLine *> smpClientMessageP <|> smpConfirmationP smpConfirmationP :: Parser SMPMessage - smpConfirmationP = "KEY " *> (SMPConfirmation <$> C.pubKeyP <* A.endOfLine <* A.endOfLine <*> binaryBodyP <* A.endOfLine) + smpConfirmationP = "KEY " *> (SMPConfirmation <$> C.strKeyP <* A.endOfLine <* A.endOfLine <*> binaryBodyP <* A.endOfLine) smpClientMessageP :: Parser SMPMessage smpClientMessageP = @@ -253,7 +249,7 @@ parseSMPMessage = parse (smpMessageP <* A.endOfLine) $ AGENT A_MESSAGE -- | Serialize SMP message. serializeSMPMessage :: SMPMessage -> ByteString serializeSMPMessage = \case - SMPConfirmation sKey cInfo -> smpMessage ("KEY " <> C.serializePubKey sKey) "" (serializeBinary cInfo) <> "\n" + SMPConfirmation sKey cInfo -> smpMessage ("KEY " <> C.serializeKey sKey) "" (serializeBinary cInfo) <> "\n" SMPMessage {senderMsgId, senderTimestamp, previousMsgHash, agentMessage} -> let header = messageHeader senderMsgId senderTimestamp previousMsgHash body = serializeAgentMessage agentMessage @@ -269,7 +265,7 @@ agentMessageP = <|> "REPLY " *> reply <|> "MSG " *> a_msg where - hello = HELLO <$> C.pubKeyP <*> ackMode + hello = HELLO <$> C.strKeyP <*> ackMode reply = REPLY <$> smpQueueInfoP a_msg = A_MSG <$> binaryBodyP <* A.endOfLine ackMode = AckMode <$> (" NO_ACK" $> Off <|> pure On) @@ -277,7 +273,7 @@ agentMessageP = -- | SMP queue information parser. smpQueueInfoP :: Parser SMPQueueInfo smpQueueInfoP = - "smp::" *> (SMPQueueInfo <$> smpServerP <* "::" <*> base64P <* "::" <*> C.pubKeyP) + "smp::" *> (SMPQueueInfo <$> smpServerP <* "::" <*> base64P <* "::" <*> C.strKeyP) -- | SMP server location parser. smpServerP :: Parser SMPServer @@ -289,14 +285,14 @@ smpServerP = SMPServer <$> server <*> optional port <*> optional kHash serializeAgentMessage :: AMessage -> ByteString serializeAgentMessage = \case - HELLO verifyKey ackMode -> "HELLO " <> C.serializePubKey verifyKey <> if ackMode == AckMode Off then " NO_ACK" else "" + HELLO verifyKey ackMode -> "HELLO " <> C.serializeKey verifyKey <> if ackMode == AckMode Off then " NO_ACK" else "" REPLY qInfo -> "REPLY " <> serializeSmpQueueInfo qInfo A_MSG body -> "MSG " <> serializeBinary body <> "\n" -- | Serialize SMP queue information that is sent out-of-band. serializeSmpQueueInfo :: SMPQueueInfo -> ByteString serializeSmpQueueInfo (SMPQueueInfo srv qId ek) = - B.intercalate "::" ["smp", serializeServer srv, encode qId, C.serializePubKey ek] + B.intercalate "::" ["smp", serializeServer srv, encode qId, C.serializeKey ek] -- | Serialize SMP server location. serializeServer :: SMPServer -> ByteString @@ -332,21 +328,9 @@ newtype AckMode = AckMode OnOff deriving (Eq, Show) -- | SMP queue information sent out-of-band. -- -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#out-of-band-messages -data SMPQueueInfo = SMPQueueInfo SMPServer SMP.SenderId EncryptionKey +data SMPQueueInfo = SMPQueueInfo SMPServer SMP.SenderId C.APublicEncryptKey deriving (Eq, Show) --- | Public key used to E2E encrypt SMP messages. -type EncryptionKey = C.PublicKey - --- | Private key used to E2E decrypt SMP messages. -type DecryptionKey = C.PrivateKey - --- | Private key used to sign SMP commands -type SignatureKey = C.PrivateKey - --- | Public key used by SMP server to authorize (verify) SMP commands. -type VerificationKey = C.PublicKey - data QueueDirection = SND | RCV deriving (Show) -- | SMP queue status. @@ -437,7 +421,7 @@ data SMPAgentError A_PROHIBITED | -- | cannot RSA/AES-decrypt or parse decrypted header A_ENCRYPTION - | -- | invalid RSA signature + | -- | invalid signature A_SIGNATURE deriving (Eq, Generic, Read, Show, Exception) diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index f6bdec954..2eba1b814 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -18,6 +18,7 @@ import Data.Kind (Type) import Data.Time (UTCTime) import Data.Type.Equality import Simplex.Messaging.Agent.Protocol +import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Protocol ( MsgBody, MsgId, @@ -41,7 +42,7 @@ class Monad m => MonadAgentStore s m where upgradeRcvConnToDuplex :: s -> ConnId -> SndQueue -> m () upgradeSndConnToDuplex :: s -> ConnId -> RcvQueue -> m () setRcvQueueStatus :: s -> RcvQueue -> QueueStatus -> m () - setRcvQueueActive :: s -> RcvQueue -> VerificationKey -> m () + setRcvQueueActive :: s -> RcvQueue -> C.APublicVerifyKey -> m () setSndQueueStatus :: s -> SndQueue -> QueueStatus -> m () -- Confirmations @@ -70,8 +71,8 @@ data RcvQueue = RcvQueue rcvId :: SMP.RecipientId, rcvPrivateKey :: RecipientPrivateKey, sndId :: Maybe SMP.SenderId, - decryptKey :: DecryptionKey, - verifyKey :: Maybe VerificationKey, + decryptKey :: C.APrivateDecryptKey, + verifyKey :: Maybe C.APublicVerifyKey, status :: QueueStatus } deriving (Eq, Show) @@ -81,8 +82,8 @@ data SndQueue = SndQueue { server :: SMPServer, sndId :: SMP.SenderId, sndPrivateKey :: SenderPrivateKey, - encryptKey :: EncryptionKey, - signKey :: SignatureKey, + encryptKey :: C.APublicEncryptKey, + signKey :: C.APrivateSignKey, status :: QueueStatus } deriving (Eq, Show) diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 177dd2950..7e2f09bdc 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -51,6 +51,7 @@ import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.Store import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration) import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations +import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Parsers (blobFieldParser) import Simplex.Messaging.Protocol (MsgBody) import qualified Simplex.Messaging.Protocol as SMP @@ -248,7 +249,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto |] [":status" := status, ":host" := host, ":port" := serializePort_ port, ":rcv_id" := rcvId] - setRcvQueueActive :: SQLiteStore -> RcvQueue -> VerificationKey -> m () + setRcvQueueActive :: SQLiteStore -> RcvQueue -> C.APublicVerifyKey -> m () setRcvQueueActive st RcvQueue {rcvId, server = SMPServer {host, port}} verifyKey = -- ? throw error if queue does not exist? liftIO . withTransaction st $ \db -> diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index 7c845d809..0dc0ac929 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -82,7 +82,7 @@ data SMPClient = SMPClient tcpTimeout :: Int, clientCorrId :: TVar Natural, sentCommands :: TVar (Map CorrId Request), - sndQ :: TBQueue SignedRawTransmission, + sndQ :: TBQueue SentRawTransmission, rcvQ :: TBQueue SignedTransmissionOrError, msgQ :: TBQueue SMPServerTransmission, blockSize :: Int @@ -333,14 +333,14 @@ suspendSMPQueue = okSMPCommand $ Cmd SRecipient OFF deleteSMPQueue :: SMPClient -> RecipientPrivateKey -> QueueId -> ExceptT SMPClientError IO () deleteSMPQueue = okSMPCommand $ Cmd SRecipient DEL -okSMPCommand :: Cmd -> SMPClient -> C.PrivateKey -> QueueId -> ExceptT SMPClientError IO () +okSMPCommand :: Cmd -> SMPClient -> C.APrivateSignKey -> QueueId -> ExceptT SMPClientError IO () okSMPCommand cmd c pKey qId = sendSMPCommand c (Just pKey) qId cmd >>= \case Cmd _ OK -> return () _ -> throwE SMPUnexpectedResponse -- | Send any SMP command ('Cmd' type). -sendSMPCommand :: SMPClient -> Maybe C.PrivateKey -> QueueId -> Cmd -> ExceptT SMPClientError IO Cmd +sendSMPCommand :: SMPClient -> Maybe C.APrivateSignKey -> QueueId -> Cmd -> ExceptT SMPClientError IO Cmd sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, tcpTimeout} pKey qId cmd = do corrId <- lift_ getNextCorrId t <- signTransmission $ serializeTransmission (corrId, qId, cmd) @@ -354,20 +354,20 @@ sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, tcpTimeout} pKey qId i <- stateTVar clientCorrId $ \i -> (i, i + 1) pure . CorrId $ bshow i - signTransmission :: ByteString -> ExceptT SMPClientError IO SignedRawTransmission + signTransmission :: ByteString -> ExceptT SMPClientError IO SentRawTransmission signTransmission t = case pKey of - Nothing -> return ("", t) + Nothing -> return (Nothing, t) Just pk -> do sig <- liftError SMPSignatureError $ C.sign pk t - return (sig, t) + return (Just sig, t) -- two separate "atomically" needed to avoid blocking - sendRecv :: CorrId -> SignedRawTransmission -> IO Response + sendRecv :: CorrId -> SentRawTransmission -> IO Response sendRecv corrId t = atomically (send corrId t) >>= withTimeout . atomically . takeTMVar where withTimeout a = fromMaybe (Left SMPResponseTimeout) <$> timeout tcpTimeout a - send :: CorrId -> SignedRawTransmission -> STM (TMVar Response) + send :: CorrId -> SentRawTransmission -> STM (TMVar Response) send corrId t = do r <- newEmptyTMVar modifyTVar sentCommands . M.insert corrId $ Request qId r diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index a92c75ffd..b4ffbc9ee 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/src/Simplex/Messaging/Crypto.hs @@ -1,11 +1,19 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} -- | -- Module : Simplex.Messaging.Crypto @@ -19,28 +27,50 @@ -- This module provides cryptography implementation for SMP protocols based on -- . module Simplex.Messaging.Crypto - ( -- * RSA keys + ( -- * Cryptographic keys + Algorithm (..), + SAlgorithm (..), + Alg (..), + SignAlg (..), PrivateKey (..), PublicKey (..), + APrivateKey (..), + APublicKey (..), + APrivateSignKey (..), + APublicVerifyKey (..), + APrivateDecryptKey (..), + APublicEncryptKey (..), + CryptoKey (..), + CryptoPrivateKey (..), KeyPair, KeyHash (..), generateKeyPair, - publicKey', - publicKeySize, - validKeySize, + generateKeyPair', + generateSignatureKeyPair, + generateEncryptionKeyPair, + privateToX509, -- * E2E hybrid encryption scheme encrypt, + encrypt', decrypt, + decrypt', -- * RSA OAEP encryption encryptOAEP, decryptOAEP, - -- * RSA PSS signing + -- * sign/verify Signature (..), + ASignature (..), + CryptoSignature (..), + SignatureSize (..), + SignatureAlgorithm, + AlgorithmI (..), sign, verify, + verify', + validSignatureSize, -- * AES256 AEAD-GCM scheme Key (..), @@ -56,13 +86,7 @@ module Simplex.Messaging.Crypto ivP, -- * Encoding of RSA keys - serializePrivKey, - serializePubKey, - encodePubKey, publicKeyHash, - privKeyP, - pubKeyP, - binaryPubKeyP, -- * SHA256 hash sha256Hash, @@ -81,6 +105,10 @@ import qualified Crypto.Error as CE import Crypto.Hash (Digest, SHA256 (..), hash) import Crypto.Number.Generate (generateMax) import Crypto.Number.Prime (findPrimeFrom) +import qualified Crypto.PubKey.Curve25519 as X25519 +import qualified Crypto.PubKey.Curve448 as X448 +import qualified Crypto.PubKey.Ed25519 as Ed25519 +import qualified Crypto.PubKey.Ed448 as Ed448 import qualified Crypto.PubKey.RSA as R import qualified Crypto.PubKey.RSA.OAEP as OAEP import qualified Crypto.PubKey.RSA.PSS as PSS @@ -97,42 +125,507 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.ByteString.Internal (c2w, w2c) import Data.ByteString.Lazy (fromStrict, toStrict) +import Data.Constraint (Dict (..)) +import Data.Kind (Constraint, Type) import Data.String +import Data.Type.Equality import Data.X509 import Database.SQLite.Simple.FromField (FromField (..)) import Database.SQLite.Simple.ToField (ToField (..)) +import GHC.TypeLits (ErrorMessage (..), TypeError) import Network.Transport.Internal (decodeWord32, encodeWord32) import Simplex.Messaging.Parsers (base64P, blobFieldParser, parseAll, parseString) import Simplex.Messaging.Util (liftEitherError, (<$?>)) --- | A newtype of 'Crypto.PubKey.RSA.PublicKey'. -newtype PublicKey = PublicKey {rsaPublicKey :: R.PublicKey} deriving (Eq, Show) +-- | Cryptographic algorithms. +data Algorithm = RSA | Ed25519 | Ed448 | X25519 | X448 --- | A newtype of 'Crypto.PubKey.RSA.PrivateKey' (PublicKey may be inside). -newtype PrivateKey = PrivateKey {rsaPrivateKey :: R.PrivateKey} deriving (Eq, Show) +-- | Singleton types for 'Algorithm'. +data SAlgorithm :: Algorithm -> Type where + SRSA :: SAlgorithm RSA + SEd25519 :: SAlgorithm Ed25519 + SEd448 :: SAlgorithm Ed448 + SX25519 :: SAlgorithm X25519 + SX448 :: SAlgorithm X448 -instance IsString PrivateKey where - fromString = parseString $ decode >=> decodePrivKey +deriving instance Eq (SAlgorithm a) -instance IsString PublicKey where - fromString = parseString $ decode >=> decodePubKey +deriving instance Show (SAlgorithm a) -instance ToField PrivateKey where toField = toField . encodePrivKey +data Alg = forall a. AlgorithmI a => Alg (SAlgorithm a) -instance ToField PublicKey where toField = toField . encodePubKey +data SignAlg + = forall a. + (AlgorithmI a, SignatureAlgorithm a) => + SignAlg (SAlgorithm a) -instance FromField PrivateKey where fromField = blobFieldParser binaryPrivKeyP +class AlgorithmI (a :: Algorithm) where sAlgorithm :: SAlgorithm a -instance FromField PublicKey where fromField = blobFieldParser binaryPubKeyP +instance AlgorithmI RSA where sAlgorithm = SRSA + +instance AlgorithmI Ed25519 where sAlgorithm = SEd25519 + +instance AlgorithmI Ed448 where sAlgorithm = SEd448 + +instance AlgorithmI X25519 where sAlgorithm = SX25519 + +instance AlgorithmI X448 where sAlgorithm = SX448 + +instance TestEquality SAlgorithm where + testEquality SRSA SRSA = Just Refl + testEquality SEd25519 SEd25519 = Just Refl + testEquality SEd448 SEd448 = Just Refl + testEquality SX25519 SX25519 = Just Refl + testEquality SX448 SX448 = Just Refl + testEquality _ _ = Nothing + +-- | GADT for public keys. +data PublicKey (a :: Algorithm) where + PublicKeyRSA :: R.PublicKey -> PublicKey RSA + PublicKeyEd25519 :: Ed25519.PublicKey -> PublicKey Ed25519 + PublicKeyEd448 :: Ed448.PublicKey -> PublicKey Ed448 + PublicKeyX25519 :: X25519.PublicKey -> PublicKey X25519 + PublicKeyX448 :: X448.PublicKey -> PublicKey X448 + +deriving instance Eq (PublicKey a) + +deriving instance Show (PublicKey a) + +data APublicKey + = forall a. + AlgorithmI a => + APublicKey (SAlgorithm a) (PublicKey a) + +instance Eq APublicKey where + APublicKey a k == APublicKey a' k' = case testEquality a a' of + Just Refl -> k == k' + Nothing -> False + +deriving instance Show APublicKey + +-- | GADT for private keys. +data PrivateKey (a :: Algorithm) where + PrivateKeyRSA :: {privateKeyRSA :: R.PrivateKey} -> PrivateKey RSA + PrivateKeyEd25519 :: Ed25519.SecretKey -> Ed25519.PublicKey -> PrivateKey Ed25519 + PrivateKeyEd448 :: Ed448.SecretKey -> Ed448.PublicKey -> PrivateKey Ed448 + PrivateKeyX25519 :: X25519.SecretKey -> PrivateKey X25519 + PrivateKeyX448 :: X448.SecretKey -> PrivateKey X448 + +deriving instance Eq (PrivateKey a) + +deriving instance Show (PrivateKey a) + +data APrivateKey + = forall a. + AlgorithmI a => + APrivateKey (SAlgorithm a) (PrivateKey a) + +instance Eq APrivateKey where + APrivateKey a k == APrivateKey a' k' = case testEquality a a' of + Just Refl -> k == k' + Nothing -> False + +deriving instance Show APrivateKey + +class AlgorithmPrefix k where + algorithmPrefix :: k -> ByteString + +instance AlgorithmPrefix (SAlgorithm a) where + algorithmPrefix = \case + SRSA -> "rsa" + SEd25519 -> "ed25519" + SEd448 -> "ed448" + SX25519 -> "x25519" + SX448 -> "x448" + +instance AlgorithmI a => AlgorithmPrefix (PublicKey a) where + algorithmPrefix _ = algorithmPrefix $ sAlgorithm @a + +instance AlgorithmI a => AlgorithmPrefix (PrivateKey a) where + algorithmPrefix _ = algorithmPrefix $ sAlgorithm @a + +instance AlgorithmPrefix APublicKey where + algorithmPrefix (APublicKey a _) = algorithmPrefix a + +instance AlgorithmPrefix APrivateKey where + algorithmPrefix (APrivateKey a _) = algorithmPrefix a + +prefixAlgorithm :: ByteString -> Either String Alg +prefixAlgorithm = \case + "rsa" -> Right $ Alg SRSA + "ed25519" -> Right $ Alg SEd25519 + "ed448" -> Right $ Alg SEd448 + "x25519" -> Right $ Alg SX25519 + "x448" -> Right $ Alg SX448 + _ -> Left "unknown algorithm" + +algP :: Parser Alg +algP = prefixAlgorithm <$?> A.takeTill (== ':') + +type family SignatureAlgorithm (a :: Algorithm) :: Constraint where + SignatureAlgorithm RSA = () + SignatureAlgorithm Ed25519 = () + SignatureAlgorithm Ed448 = () + SignatureAlgorithm a = + (Int ~ Bool, TypeError (Text "Algorithm " :<>: ShowType a :<>: Text " cannot be used to sign/verify")) + +signatureAlgorithm :: SAlgorithm a -> Maybe (Dict (SignatureAlgorithm a)) +signatureAlgorithm = \case + SRSA -> Just Dict + SEd25519 -> Just Dict + SEd448 -> Just Dict + _ -> Nothing + +data APrivateSignKey + = forall a. + (AlgorithmI a, SignatureAlgorithm a) => + APrivateSignKey (SAlgorithm a) (PrivateKey a) + +instance Eq APrivateSignKey where + APrivateSignKey a k == APrivateSignKey a' k' = case testEquality a a' of + Just Refl -> k == k' + Nothing -> False + +deriving instance Show APrivateSignKey + +data APublicVerifyKey + = forall a. + (AlgorithmI a, SignatureAlgorithm a) => + APublicVerifyKey (SAlgorithm a) (PublicKey a) + +instance Eq APublicVerifyKey where + APublicVerifyKey a k == APublicVerifyKey a' k' = case testEquality a a' of + Just Refl -> k == k' + Nothing -> False + +deriving instance Show APublicVerifyKey + +type family EncryptionAlgorithm (a :: Algorithm) :: Constraint where + EncryptionAlgorithm RSA = () + EncryptionAlgorithm a = + (Int ~ Bool, TypeError (Text "Algorithm " :<>: ShowType a :<>: Text " cannot be used to encrypt/decrypt")) + +encryptionAlgorithm :: SAlgorithm a -> Maybe (Dict (EncryptionAlgorithm a)) +encryptionAlgorithm = \case + SRSA -> Just Dict + _ -> Nothing + +data APrivateDecryptKey + = forall a. + (AlgorithmI a, EncryptionAlgorithm a) => + APrivateDecryptKey (SAlgorithm a) (PrivateKey a) + +instance Eq APrivateDecryptKey where + APrivateDecryptKey a k == APrivateDecryptKey a' k' = case testEquality a a' of + Just Refl -> k == k' + Nothing -> False + +deriving instance Show APrivateDecryptKey + +data APublicEncryptKey + = forall a. + (AlgorithmI a, EncryptionAlgorithm a) => + APublicEncryptKey (SAlgorithm a) (PublicKey a) + +instance Eq APublicEncryptKey where + APublicEncryptKey a k == APublicEncryptKey a' k' = case testEquality a a' of + Just Refl -> k == k' + Nothing -> False + +deriving instance Show APublicEncryptKey + +-- | Class for all key types +class CryptoKey k where + keySize :: k -> Int + + validKeySize :: k -> Bool + + -- | base64 X509 key encoding with algorithm prefix + serializeKey :: k -> ByteString + + -- | binary X509 key encoding + encodeKey :: k -> ByteString + + -- | base64 X509 (with algorithm prefix) key parser + strKeyP :: Parser k + + -- | binary X509 key parser + binaryKeyP :: Parser k + +-- | X509 encoding of any public key. +instance CryptoKey APublicKey where + keySize (APublicKey _ k) = keySize k + validKeySize (APublicKey _ k) = validKeySize k + serializeKey (APublicKey _ k) = serializeKey k + encodeKey (APublicKey _ k) = encodeKey k + strKeyP = do + Alg a <- algP <* A.char ':' + k@(APublicKey a' _) <- decodePubKey <$?> base64P + case testEquality a a' of + Just Refl -> pure k + _ -> fail $ "public key algorithm " <> show a <> " does not match prefix" + binaryKeyP = decodePubKey <$?> A.takeByteString + +-- | X509 encoding of signature public key. +instance CryptoKey APublicVerifyKey where + keySize (APublicVerifyKey _ k) = keySize k + validKeySize (APublicVerifyKey _ k) = validKeySize k + serializeKey (APublicVerifyKey _ k) = serializeKey k + encodeKey (APublicVerifyKey _ k) = encodeKey k + strKeyP = pubVerifyKey <$?> strKeyP + binaryKeyP = pubVerifyKey <$?> binaryKeyP + +-- | X509 encoding of encryption public key. +instance CryptoKey APublicEncryptKey where + keySize (APublicEncryptKey _ k) = keySize k + validKeySize (APublicEncryptKey _ k) = validKeySize k + serializeKey (APublicEncryptKey _ k) = serializeKey k + encodeKey (APublicEncryptKey _ k) = encodeKey k + strKeyP = pubEncryptKey <$?> strKeyP + binaryKeyP = pubEncryptKey <$?> binaryKeyP + +-- | X509 encoding of 'PublicKey'. +instance forall a. AlgorithmI a => CryptoKey (PublicKey a) where + keySize = \case + PublicKeyRSA k -> R.public_size k + PublicKeyEd25519 _ -> Ed25519.publicKeySize + PublicKeyEd448 _ -> Ed448.publicKeySize + PublicKeyX25519 _ -> x25519_size + PublicKeyX448 _ -> x448_size + validKeySize = \case + PublicKeyRSA k -> validRSAKeySize $ R.public_size k + _ -> True + serializeKey k = algorithmPrefix k <> ":" <> encode (encodeKey k) + encodeKey = encodeASNKey . publicToX509 + strKeyP = pubKey' <$?> strKeyP + binaryKeyP = pubKey' <$?> binaryKeyP + +-- | X509 encoding of any private key. +instance CryptoKey APrivateKey where + keySize (APrivateKey _ k) = keySize k + validKeySize (APrivateKey _ k) = validKeySize k + serializeKey (APrivateKey _ k) = serializeKey k + encodeKey (APrivateKey _ k) = encodeKey k + strKeyP = do + Alg a <- algP <* A.char ':' + k@(APrivateKey a' _) <- decodePrivKey <$?> base64P + case testEquality a a' of + Just Refl -> pure k + _ -> fail $ "private key algorithm " <> show a <> " does not match prefix" + binaryKeyP = decodePrivKey <$?> A.takeByteString + +-- | X509 encoding of signature private key. +instance CryptoKey APrivateSignKey where + keySize (APrivateSignKey _ k) = keySize k + validKeySize (APrivateSignKey _ k) = validKeySize k + serializeKey (APrivateSignKey _ k) = serializeKey k + encodeKey (APrivateSignKey _ k) = encodeKey k + strKeyP = privSignKey <$?> strKeyP + binaryKeyP = privSignKey <$?> binaryKeyP + +-- | X509 encoding of encryption private key. +instance CryptoKey APrivateDecryptKey where + keySize (APrivateDecryptKey _ k) = keySize k + validKeySize (APrivateDecryptKey _ k) = validKeySize k + serializeKey (APrivateDecryptKey _ k) = serializeKey k + encodeKey (APrivateDecryptKey _ k) = encodeKey k + strKeyP = privDecryptKey <$?> strKeyP + binaryKeyP = privDecryptKey <$?> binaryKeyP + +-- | X509 encoding of 'PrivateKey'. +instance AlgorithmI a => CryptoKey (PrivateKey a) where + keySize = \case + PrivateKeyRSA k -> rsaPrivateKeySize k + PrivateKeyEd25519 _ _ -> Ed25519.secretKeySize + PrivateKeyEd448 _ _ -> Ed448.secretKeySize + PrivateKeyX25519 _ -> x25519_size + PrivateKeyX448 _ -> x448_size + validKeySize = \case + PrivateKeyRSA k -> validRSAKeySize $ rsaPrivateKeySize k + _ -> True + serializeKey k = algorithmPrefix k <> ":" <> encode (encodeKey k) + encodeKey = encodeASNKey . privateToX509 + strKeyP = privKey' <$?> strKeyP + binaryKeyP = privKey' <$?> binaryKeyP + +type family PublicKeyType pk where + PublicKeyType APrivateKey = APublicKey + PublicKeyType APrivateSignKey = APublicVerifyKey + PublicKeyType APrivateDecryptKey = APublicEncryptKey + PublicKeyType (PrivateKey a) = PublicKey a + +class CryptoPrivateKey pk where publicKey :: pk -> PublicKeyType pk + +instance CryptoPrivateKey APrivateKey where + publicKey (APrivateKey a k) = APublicKey a $ publicKey k + +instance CryptoPrivateKey APrivateSignKey where + publicKey (APrivateSignKey a k) = APublicVerifyKey a $ publicKey k + +instance CryptoPrivateKey APrivateDecryptKey where + publicKey (APrivateDecryptKey a k) = APublicEncryptKey a $ publicKey k + +instance CryptoPrivateKey (PrivateKey a) where + publicKey = \case + PrivateKeyRSA k -> PublicKeyRSA $ R.private_pub k + PrivateKeyEd25519 _ k -> PublicKeyEd25519 k + PrivateKeyEd448 _ k -> PublicKeyEd448 k + PrivateKeyX25519 k -> PublicKeyX25519 $ X25519.toPublic k + PrivateKeyX448 k -> PublicKeyX448 $ X448.toPublic k + +instance AlgorithmI a => IsString (PrivateKey a) where + fromString = parseString $ decode >=> decodePrivKey >=> privKey' + +instance AlgorithmI a => IsString (PublicKey a) where + fromString = parseString $ decode >=> decodePubKey >=> pubKey' -- | Tuple of RSA 'PublicKey' and 'PrivateKey'. -type KeyPair = (PublicKey, PrivateKey) +type KeyPair a = (PublicKey a, PrivateKey a) --- | RSA signature newtype. -newtype Signature = Signature {unSignature :: ByteString} deriving (Eq, Show) +type AKeyPair = (APublicKey, APrivateKey) -instance IsString Signature where - fromString = Signature . fromString +type ASignatureKeyPair = (APublicVerifyKey, APrivateSignKey) + +type AnEncryptionKeyPair = (APublicEncryptKey, APrivateDecryptKey) + +generateKeyPair :: AlgorithmI a => Int -> SAlgorithm a -> IO AKeyPair +generateKeyPair size a = bimap (APublicKey a) (APrivateKey a) <$> generateKeyPair' size a + +generateSignatureKeyPair :: + (AlgorithmI a, SignatureAlgorithm a) => Int -> SAlgorithm a -> IO ASignatureKeyPair +generateSignatureKeyPair size a = + bimap (APublicVerifyKey a) (APrivateSignKey a) <$> generateKeyPair' size a + +generateEncryptionKeyPair :: + (AlgorithmI a, EncryptionAlgorithm a) => Int -> SAlgorithm a -> IO AnEncryptionKeyPair +generateEncryptionKeyPair size a = + bimap (APublicEncryptKey a) (APrivateDecryptKey a) <$> generateKeyPair' size a + +generateKeyPair' :: Int -> SAlgorithm a -> IO (KeyPair a) +generateKeyPair' size = \case + SRSA -> generateKeyPairRSA size + SEd25519 -> + Ed25519.generateSecretKey >>= \pk -> + let k = Ed25519.toPublic pk + in pure (PublicKeyEd25519 k, PrivateKeyEd25519 pk k) + SEd448 -> + Ed448.generateSecretKey >>= \pk -> + let k = Ed448.toPublic pk + in pure (PublicKeyEd448 k, PrivateKeyEd448 pk k) + SX25519 -> + X25519.generateSecretKey >>= \pk -> + let k = X25519.toPublic pk + in pure (PublicKeyX25519 k, PrivateKeyX25519 pk) + SX448 -> + X448.generateSecretKey >>= \pk -> + let k = X448.toPublic pk + in pure (PublicKeyX448 k, PrivateKeyX448 pk) + +instance ToField APrivateSignKey where toField = toField . encodeKey + +instance ToField APublicVerifyKey where toField = toField . encodeKey + +instance ToField APrivateDecryptKey where toField = toField . encodeKey + +instance ToField APublicEncryptKey where toField = toField . encodeKey + +instance FromField APrivateSignKey where fromField = blobFieldParser binaryKeyP + +instance FromField APublicVerifyKey where fromField = blobFieldParser binaryKeyP + +instance FromField APrivateDecryptKey where fromField = blobFieldParser binaryKeyP + +instance FromField APublicEncryptKey where fromField = blobFieldParser binaryKeyP + +instance IsString (Maybe ASignature) where + fromString = parseString $ decode >=> decodeSignature + +data Signature (a :: Algorithm) where + SignatureRSA :: ByteString -> Signature RSA + SignatureEd25519 :: Ed25519.Signature -> Signature Ed25519 + SignatureEd448 :: Ed448.Signature -> Signature Ed448 + +deriving instance Eq (Signature a) + +deriving instance Show (Signature a) + +data ASignature + = forall a. + (AlgorithmI a, SignatureAlgorithm a) => + ASignature (SAlgorithm a) (Signature a) + +instance Eq ASignature where + ASignature a s == ASignature a' s' = case testEquality a a' of + Just Refl -> s == s' + _ -> False + +deriving instance Show ASignature + +class CryptoSignature s where + serializeSignature :: s -> ByteString + serializeSignature = encode . signatureBytes + signatureBytes :: s -> ByteString + decodeSignature :: ByteString -> Either String s + +instance CryptoSignature ASignature where + signatureBytes (ASignature _ sig) = signatureBytes sig + decodeSignature s + | l == Ed25519.signatureSize = + ASignature SEd25519 . SignatureEd25519 <$> ed Ed25519.signature s + | l == Ed448.signatureSize = + ASignature SEd448 . SignatureEd448 <$> ed Ed448.signature s + | l == 128 || l == 256 || l == 384 || l == 512 = rsa s + | otherwise = Left "bad signature size" + where + l = B.length s + ed alg = first show . CE.eitherCryptoError . alg + rsa = Right . ASignature SRSA . SignatureRSA + +instance CryptoSignature (Maybe ASignature) where + signatureBytes = maybe "" signatureBytes + decodeSignature s + | B.null s = Right Nothing + | otherwise = Just <$> decodeSignature s + +instance AlgorithmI a => CryptoSignature (Signature a) where + signatureBytes = \case + SignatureRSA s -> s + SignatureEd25519 s -> BA.convert s + SignatureEd448 s -> BA.convert s + decodeSignature s = do + ASignature a sig <- decodeSignature s + case testEquality a $ sAlgorithm @a of + Just Refl -> Right sig + _ -> Left "bad signature algorithm" + +class SignatureSize s where signatureSize :: s -> Int + +instance SignatureSize (Signature a) where + signatureSize = \case + SignatureRSA s -> B.length s + SignatureEd25519 _ -> Ed25519.signatureSize + SignatureEd448 _ -> Ed448.signatureSize + +instance SignatureSize APrivateSignKey where + signatureSize (APrivateSignKey _ k) = signatureSize k + +instance SignatureSize APublicVerifyKey where + signatureSize (APublicVerifyKey _ k) = signatureSize k + +instance SignatureAlgorithm a => SignatureSize (PrivateKey a) where + signatureSize = \case + PrivateKeyRSA k -> rsaPrivateKeySize k + PrivateKeyEd25519 _ _ -> Ed25519.signatureSize + PrivateKeyEd448 _ _ -> Ed448.signatureSize + +instance SignatureAlgorithm a => SignatureSize (PublicKey a) where + signatureSize = \case + PublicKeyRSA k -> R.public_size k + PublicKeyEd25519 _ -> Ed25519.signatureSize + PublicKeyEd448 _ -> Ed448.signatureSize + +rsaPrivateKeySize :: R.PrivateKey -> Int +rsaPrivateKeySize = R.public_size . R.private_pub -- | Various cryptographic or related errors. data CryptoError @@ -142,6 +635,8 @@ data CryptoError RSADecryptError R.Error | -- | RSA PSS signature error RSASignError R.Error + | -- | Unsupported signing algorithm + UnsupportedAlgorithm | -- | AES initialization error AESCipherError CE.CryptoError | -- | IV generation error @@ -164,8 +659,8 @@ authTagSize :: Int authTagSize = 128 `div` 8 -- | Generate RSA key pair. -generateKeyPair :: Int -> IO KeyPair -generateKeyPair size = loop +generateKeyPairRSA :: Int -> IO (KeyPair RSA) +generateKeyPairRSA size = loop where publicExponent = findPrimeFrom . (+ 3) <$> generateMax pubExpRange loop = do @@ -174,24 +669,20 @@ generateKeyPair size = loop d = R.private_d pk if d * d < n then loop - else pure (PublicKey k, PrivateKey pk) + else pure (PublicKeyRSA k, PrivateKeyRSA pk) -privateKeySize :: PrivateKey -> Int -privateKeySize = R.public_size . R.private_pub . rsaPrivateKey +x25519_size :: Int +x25519_size = 32 -publicKey' :: PrivateKey -> PublicKey -publicKey' = PublicKey . R.private_pub . rsaPrivateKey +x448_size :: Int +x448_size = 448 `quot` 8 -publicKeySize :: PublicKey -> Int -publicKeySize = R.public_size . rsaPublicKey +validRSAKeySize :: Int -> Bool +validRSAKeySize n = n == 128 || n == 256 || n == 384 || n == 512 -validKeySize :: Int -> Bool -validKeySize = \case - 128 -> True - 256 -> True - 384 -> True - 512 -> True - _ -> False +validSignatureSize :: Int -> Bool +validSignatureSize n = + n == Ed25519.signatureSize || n == Ed448.signatureSize || validRSAKeySize n data Header = Header { aesKey :: Key, @@ -217,8 +708,8 @@ instance ToField KeyHash where toField = toField . encode . unKeyHash instance FromField KeyHash where fromField = blobFieldParser $ KeyHash <$> base64P -- | Digest (hash) of binary X509 encoding of RSA public key. -publicKeyHash :: PublicKey -> KeyHash -publicKeyHash = KeyHash . sha256Hash . encodePubKey +publicKeyHash :: PublicKey RSA -> KeyHash +publicKeyHash = KeyHash . sha256Hash . encodeKey -- | SHA256 digest. sha256Hash :: ByteString -> ByteString @@ -249,28 +740,36 @@ parseHeader = first CryptoHeaderError . parseAll headerP -- * E2E hybrid encryption scheme --- | E2E encrypt SMP agent messages. +-- | Legacy hybrid E2E encryption of SMP agent messages (RSA-OAEP/AES-256-GCM-SHA256). -- -- https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-01-26-crypto.md#e2e-encryption -encrypt :: PublicKey -> Int -> ByteString -> ExceptT CryptoError IO ByteString -encrypt k paddedSize msg = do +encrypt' :: PublicKey a -> Int -> ByteString -> ExceptT CryptoError IO ByteString +encrypt' k@(PublicKeyRSA _) paddedSize msg = do aesKey <- liftIO randomAesKey ivBytes <- liftIO randomIV (authTag, msg') <- encryptAES aesKey ivBytes paddedSize msg let header = Header {aesKey, ivBytes, authTag, msgSize = B.length msg} encHeader <- encryptOAEP k $ serializeHeader header return $ encHeader <> msg' +encrypt' _ _ _ = throwE UnsupportedAlgorithm --- | E2E decrypt SMP agent messages. +-- | Legacy hybrid E2E decryption of SMP agent messages (RSA-OAEP/AES-256-GCM-SHA256). -- -- https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-01-26-crypto.md#e2e-encryption -decrypt :: PrivateKey -> ByteString -> ExceptT CryptoError IO ByteString -decrypt pk msg'' = do - let (encHeader, msg') = B.splitAt (privateKeySize pk) msg'' +decrypt' :: PrivateKey a -> ByteString -> ExceptT CryptoError IO ByteString +decrypt' pk@(PrivateKeyRSA _) msg'' = do + let (encHeader, msg') = B.splitAt (keySize pk) msg'' header <- decryptOAEP pk encHeader Header {aesKey, ivBytes, authTag, msgSize} <- except $ parseHeader header msg <- decryptAES aesKey ivBytes msg' authTag return $ B.take msgSize msg +decrypt' _ _ = throwE UnsupportedAlgorithm + +encrypt :: APublicEncryptKey -> Int -> ByteString -> ExceptT CryptoError IO ByteString +encrypt (APublicEncryptKey _ k) = encrypt' k + +decrypt :: APrivateDecryptKey -> ByteString -> ExceptT CryptoError IO ByteString +decrypt (APrivateDecryptKey _ pk) = decrypt' pk -- | AEAD-GCM encryption. -- @@ -335,85 +834,115 @@ oaepParams = OAEP.defaultOAEPParams SHA256 -- | RSA OAEP encryption. -- -- Used as part of hybrid E2E encryption scheme and for SMP transport handshake. -encryptOAEP :: PublicKey -> ByteString -> ExceptT CryptoError IO ByteString -encryptOAEP (PublicKey k) aesKey = +encryptOAEP :: PublicKey RSA -> ByteString -> ExceptT CryptoError IO ByteString +encryptOAEP (PublicKeyRSA k) aesKey = liftEitherError RSAEncryptError $ OAEP.encrypt oaepParams k aesKey -- | RSA OAEP decryption. -- -- Used as part of hybrid E2E encryption scheme and for SMP transport handshake. -decryptOAEP :: PrivateKey -> ByteString -> ExceptT CryptoError IO ByteString -decryptOAEP pk encKey = +decryptOAEP :: PrivateKey RSA -> ByteString -> ExceptT CryptoError IO ByteString +decryptOAEP (PrivateKeyRSA pk) encKey = liftEitherError RSADecryptError $ - OAEP.decryptSafer oaepParams (rsaPrivateKey pk) encKey + OAEP.decryptSafer oaepParams pk encKey pssParams :: PSS.PSSParams SHA256 ByteString ByteString pssParams = PSS.defaultPSSParams SHA256 --- | RSA PSS message signing. +-- | Message signing. -- -- Used by SMP clients to sign SMP commands and by SMP agents to sign messages. -sign :: PrivateKey -> ByteString -> ExceptT CryptoError IO Signature -sign pk msg = ExceptT $ bimap RSASignError Signature <$> PSS.signSafer pssParams (rsaPrivateKey pk) msg +sign' :: SignatureAlgorithm a => PrivateKey a -> ByteString -> ExceptT CryptoError IO (Signature a) +sign' (PrivateKeyRSA pk) msg = ExceptT $ bimap RSASignError SignatureRSA <$> PSS.signSafer pssParams pk msg +sign' (PrivateKeyEd25519 pk k) msg = pure . SignatureEd25519 $ Ed25519.sign pk k msg +sign' (PrivateKeyEd448 pk k) msg = pure . SignatureEd448 $ Ed448.sign pk k msg --- | RSA PSS signature verification. +sign :: APrivateSignKey -> ByteString -> ExceptT CryptoError IO ASignature +sign (APrivateSignKey a k) = fmap (ASignature a) . sign' k + +-- | Signature verification. -- -- Used by SMP servers to authorize SMP commands and by SMP agents to verify messages. -verify :: PublicKey -> Signature -> ByteString -> Bool -verify (PublicKey k) (Signature sig) msg = PSS.verify pssParams k msg sig +verify' :: SignatureAlgorithm a => PublicKey a -> Signature a -> ByteString -> Bool +verify' (PublicKeyRSA k) (SignatureRSA sig) msg = PSS.verify pssParams k msg sig +verify' (PublicKeyEd25519 k) (SignatureEd25519 sig) msg = Ed25519.verify k msg sig +verify' (PublicKeyEd448 k) (SignatureEd448 sig) msg = Ed448.verify k msg sig --- | Base-64 X509 encoding of RSA public key. --- --- Used as part of SMP queue information (out-of-band message). -serializePubKey :: PublicKey -> ByteString -serializePubKey = ("rsa:" <>) . encode . encodePubKey +verify :: APublicVerifyKey -> ASignature -> ByteString -> Bool +verify (APublicVerifyKey a k) (ASignature a' sig) msg = case testEquality a a' of + Just Refl -> verify' k sig msg + _ -> False --- | Base-64 PKCS8 encoding of PSA private key. --- --- Not used as part of SMP protocols. -serializePrivKey :: PrivateKey -> ByteString -serializePrivKey = ("rsa:" <>) . encode . encodePrivKey +pubVerifyKey :: APublicKey -> Either String APublicVerifyKey +pubVerifyKey (APublicKey a k) = case signatureAlgorithm a of + Just Dict -> Right $ APublicVerifyKey a k + _ -> Left "key does not support signature algorithms" --- Base-64 X509 RSA public key parser. -pubKeyP :: Parser PublicKey -pubKeyP = decodePubKey <$?> ("rsa:" *> base64P) +pubEncryptKey :: APublicKey -> Either String APublicEncryptKey +pubEncryptKey (APublicKey a k) = case encryptionAlgorithm a of + Just Dict -> Right $ APublicEncryptKey a k + _ -> Left "key does not support encryption algorithms" --- Binary X509 RSA public key parser. -binaryPubKeyP :: Parser PublicKey -binaryPubKeyP = decodePubKey <$?> A.takeByteString +pubKey' :: forall a. AlgorithmI a => APublicKey -> Either String (PublicKey a) +pubKey' (APublicKey a k) = case testEquality a $ sAlgorithm @a of + Just Refl -> Right k + _ -> Left "bad key algorithm" --- Base-64 PKCS8 RSA private key parser. -privKeyP :: Parser PrivateKey -privKeyP = decodePrivKey <$?> ("rsa:" *> base64P) +privSignKey :: APrivateKey -> Either String APrivateSignKey +privSignKey (APrivateKey a k) = case signatureAlgorithm a of + Just Dict -> Right $ APrivateSignKey a k + _ -> Left "key does not support signature algorithms" --- Binary PKCS8 RSA private key parser. -binaryPrivKeyP :: Parser PrivateKey -binaryPrivKeyP = decodePrivKey <$?> A.takeByteString +privDecryptKey :: APrivateKey -> Either String APrivateDecryptKey +privDecryptKey (APrivateKey a k) = case encryptionAlgorithm a of + Just Dict -> Right $ APrivateDecryptKey a k + _ -> Left "key does not support encryption algorithms" --- Binary X509 encoding of 'PublicKey'. -encodePubKey :: PublicKey -> ByteString -encodePubKey = encodeKey . PubKeyRSA . rsaPublicKey +privKey' :: forall a. AlgorithmI a => APrivateKey -> Either String (PrivateKey a) +privKey' (APrivateKey a k) = case testEquality a $ sAlgorithm @a of + Just Refl -> Right k + _ -> Left "bad key algorithm" --- Binary PKCS8 encoding of 'PrivateKey'. -encodePrivKey :: PrivateKey -> ByteString -encodePrivKey = encodeKey . PrivKeyRSA . rsaPrivateKey +publicToX509 :: PublicKey a -> PubKey +publicToX509 = \case + PublicKeyRSA k -> PubKeyRSA k + PublicKeyEd25519 k -> PubKeyEd25519 k + PublicKeyEd448 k -> PubKeyEd448 k + PublicKeyX25519 k -> PubKeyX25519 k + PublicKeyX448 k -> PubKeyX448 k -encodeKey :: ASN1Object a => a -> ByteString -encodeKey k = toStrict . encodeASN1 DER $ toASN1 k [] +privateToX509 :: PrivateKey a -> PrivKey +privateToX509 = \case + PrivateKeyRSA k -> PrivKeyRSA k + PrivateKeyEd25519 k _ -> PrivKeyEd25519 k + PrivateKeyEd448 k _ -> PrivKeyEd448 k + PrivateKeyX25519 k -> PrivKeyX25519 k + PrivateKeyX448 k -> PrivKeyX448 k + +encodeASNKey :: ASN1Object a => a -> ByteString +encodeASNKey k = toStrict . encodeASN1 DER $ toASN1 k [] -- Decoding of binary X509 'PublicKey'. -decodePubKey :: ByteString -> Either String PublicKey +decodePubKey :: ByteString -> Either String APublicKey decodePubKey = decodeKey >=> \case - (PubKeyRSA k, []) -> Right $ PublicKey k + (PubKeyRSA k, []) -> Right . APublicKey SRSA $ PublicKeyRSA k + (PubKeyEd25519 k, []) -> Right . APublicKey SEd25519 $ PublicKeyEd25519 k + (PubKeyEd448 k, []) -> Right . APublicKey SEd448 $ PublicKeyEd448 k + (PubKeyX25519 k, []) -> Right . APublicKey SX25519 $ PublicKeyX25519 k + (PubKeyX448 k, []) -> Right . APublicKey SX448 $ PublicKeyX448 k r -> keyError r -- Decoding of binary PKCS8 'PrivateKey'. -decodePrivKey :: ByteString -> Either String PrivateKey +decodePrivKey :: ByteString -> Either String APrivateKey decodePrivKey = decodeKey >=> \case - (PrivKeyRSA pk, []) -> Right $ PrivateKey pk + (PrivKeyRSA pk, []) -> Right . APrivateKey SRSA $ PrivateKeyRSA pk + (PrivKeyEd25519 k, []) -> Right . APrivateKey SEd25519 . PrivateKeyEd25519 k $ Ed25519.toPublic k + (PrivKeyEd448 k, []) -> Right . APrivateKey SEd448 . PrivateKeyEd448 k $ Ed448.toPublic k + (PrivKeyX25519 k, []) -> Right . APrivateKey SX25519 $ PrivateKeyX25519 k + (PrivKeyX448 k, []) -> Right . APrivateKey SX448 $ PrivateKeyX448 k r -> keyError r decodeKey :: ASN1Object a => ByteString -> Either String (a, [ASN1]) @@ -421,5 +950,5 @@ decodeKey = fromASN1 <=< first show . decodeASN1 DER . fromStrict keyError :: (a, [ASN1]) -> Either String b keyError = \case - (_, []) -> Left "not RSA key" + (_, []) -> Left "unknown key algorithm" _ -> Left "more than one key" diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index d80f25ed5..f6d072aa2 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -34,6 +34,7 @@ module Simplex.Messaging.Protocol SignedTransmission, SignedTransmissionOrError, RawTransmission, + SentRawTransmission, SignedRawTransmission, CorrId (..), QueueId, @@ -76,6 +77,7 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Functor (($>)) import Data.Kind +import Data.Maybe (isNothing) import Data.String import Data.Time.Clock import Data.Time.ISO8601 @@ -109,18 +111,21 @@ deriving instance Show Cmd type Transmission = (CorrId, QueueId, Cmd) -- | SMP transmission with signature. -type SignedTransmission = (C.Signature, Transmission) +type SignedTransmission = (Maybe C.ASignature, Transmission) type TransmissionOrError = (CorrId, QueueId, Either ErrorType Cmd) -- | signed parsed transmission, with parsing error. -type SignedTransmissionOrError = (C.Signature, TransmissionOrError) +type SignedTransmissionOrError = (Maybe C.ASignature, TransmissionOrError) -- | unparsed SMP transmission with signature. type RawTransmission = (ByteString, ByteString, ByteString, ByteString) --- | unparsed SMP transmission with signature. -type SignedRawTransmission = (C.Signature, ByteString) +-- | unparsed sent SMP transmission with signature. +type SignedRawTransmission = (Maybe C.ASignature, ByteString, ByteString, ByteString) + +-- | unparsed sent SMP transmission with signature. +type SentRawTransmission = (Maybe C.ASignature, ByteString) -- | SMP queue ID for the recipient. type RecipientId = QueueId @@ -177,24 +182,24 @@ instance IsString CorrId where -- | Recipient's private key used by the recipient to authorize (sign) SMP commands. -- -- Only used by SMP agent, kept here so its definition is close to respective public key. -type RecipientPrivateKey = C.PrivateKey +type RecipientPrivateKey = C.APrivateSignKey -- | Recipient's public key used by SMP server to verify authorization of SMP commands. -type RecipientPublicKey = C.PublicKey +type RecipientPublicKey = C.APublicVerifyKey -- | Sender's private key used by the recipient to authorize (sign) SMP commands. -- -- Only used by SMP agent, kept here so its definition is close to respective public key. -type SenderPrivateKey = C.PrivateKey +type SenderPrivateKey = C.APrivateSignKey -- | Sender's public key used by SMP server to verify authorization of SMP commands. -type SenderPublicKey = C.PublicKey +type SenderPublicKey = C.APublicVerifyKey -- | Private key used by push notifications server to authorize (sign) LSTN command. -type NotifierPrivateKey = C.PrivateKey +type NotifierPrivateKey = C.APrivateSignKey -- | Public key used by SMP server to verify authorization of LSTN command sent by push notifications server. -type NotifierPublicKey = C.PublicKey +type NotifierPublicKey = C.APublicVerifyKey -- | SMP message server ID. type MsgId = Encoded @@ -243,11 +248,11 @@ instance Arbitrary CommandError where arbitrary = genericArbitraryU -- | SMP transmission parser. transmissionP :: Parser RawTransmission transmissionP = do - signature <- segment + sig <- segment corrId <- segment queueId <- segment command <- A.takeByteString - return (signature, corrId, queueId, command) + return (sig, corrId, queueId, command) where segment = A.takeTill (== ' ') <* " " @@ -273,11 +278,11 @@ commandP = <|> "ERR " *> serverError <|> "PONG" $> Cmd SBroker PONG where - newCmd = Cmd SRecipient . NEW <$> C.pubKeyP + newCmd = Cmd SRecipient . NEW <$> C.strKeyP idsResp = Cmd SBroker <$> (IDS <$> (base64P <* A.space) <*> base64P) nIdsResp = Cmd SBroker . NID <$> base64P - keyCmd = Cmd SRecipient . KEY <$> C.pubKeyP - nKeyCmd = Cmd SRecipient . NKEY <$> C.pubKeyP + keyCmd = Cmd SRecipient . KEY <$> C.strKeyP + nKeyCmd = Cmd SRecipient . NKEY <$> C.strKeyP sendCmd = do size <- A.decimal <* A.space Cmd SSender . SEND <$> A.take size <* A.space @@ -297,9 +302,9 @@ parseCommand = parse (commandP <* " " <* A.takeByteString) $ CMD SYNTAX -- | Serialize SMP command. serializeCommand :: Cmd -> ByteString serializeCommand = \case - Cmd SRecipient (NEW rKey) -> "NEW " <> C.serializePubKey rKey - Cmd SRecipient (KEY sKey) -> "KEY " <> C.serializePubKey sKey - Cmd SRecipient (NKEY nKey) -> "NKEY " <> C.serializePubKey nKey + Cmd SRecipient (NEW rKey) -> "NEW " <> C.serializeKey rKey + Cmd SRecipient (KEY sKey) -> "KEY " <> C.serializeKey sKey + Cmd SRecipient (NKEY nKey) -> "NKEY " <> C.serializeKey nKey Cmd SRecipient SUB -> "SUB" Cmd SRecipient ACK -> "ACK" Cmd SRecipient OFF -> "OFF" @@ -328,9 +333,9 @@ serializeErrorType :: ErrorType -> ByteString serializeErrorType = bshow -- | Send signed SMP transmission to TCP transport. -tPut :: Transport c => THandle c -> SignedRawTransmission -> IO (Either TransportError ()) -tPut th (C.Signature sig, t) = - tPutEncrypted th $ encode sig <> " " <> t <> " " +tPut :: Transport c => THandle c -> SentRawTransmission -> IO (Either TransportError ()) +tPut th (sig, t) = + tPutEncrypted th $ C.serializeSignature sig <> " " <> t <> " " -- | Serialize SMP transmission. serializeTransmission :: Transmission -> ByteString @@ -362,26 +367,21 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate where decodeParseValidate :: Either TransportError RawTransmission -> m SignedTransmissionOrError decodeParseValidate = \case - Right (signature, corrId, queueId, command) -> - let decodedTransmission = liftM2 (,corrId,,command) (validSig =<< decode signature) (decode queueId) + Right (sig, corrId, queueId, command) -> + let decodedTransmission = liftM2 (,corrId,,command) (C.decodeSignature =<< decode sig) (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 "", (CorrId corrId, "", Left BLOCK)) + tError corrId = return (Nothing, (CorrId corrId, "", Left BLOCK)) - tParseValidate :: RawTransmission -> m SignedTransmissionOrError + tParseValidate :: SignedRawTransmission -> m SignedTransmissionOrError tParseValidate t@(sig, corrId, queueId, command) = do let cmd = parseCommand command >>= fromParty >>= tCredentials t - return (C.Signature sig, (CorrId corrId, queueId, cmd)) + return (sig, (CorrId corrId, queueId, cmd)) - tCredentials :: RawTransmission -> Cmd -> Either ErrorType Cmd - tCredentials (signature, _, queueId, _) cmd = case cmd of + tCredentials :: SignedRawTransmission -> Cmd -> Either ErrorType Cmd + tCredentials (sig, _, queueId, _) cmd = case cmd of -- IDS response must not have queue ID Cmd SBroker IDS {} -> Right cmd -- ERR response does not always have queue ID @@ -396,7 +396,7 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate | otherwise -> Right cmd -- NEW must have signature but NOT queue ID Cmd SRecipient NEW {} - | B.null signature -> Left $ CMD NO_AUTH + | isNothing sig -> Left $ CMD NO_AUTH | not (B.null queueId) -> Left $ CMD HAS_AUTH | otherwise -> Right cmd -- SEND must have queue ID, signature is not always required @@ -405,9 +405,9 @@ tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate | otherwise -> Right cmd -- PING must not have queue ID or signature Cmd SSender PING - | B.null queueId && B.null signature -> Right cmd + | isNothing sig && B.null queueId -> Right cmd | otherwise -> Left $ CMD HAS_AUTH -- other client commands must have both signature and queue ID Cmd _ _ - | B.null signature || B.null queueId -> Left $ CMD NO_AUTH + | isNothing sig || B.null queueId -> Left $ CMD NO_AUTH | otherwise -> Right cmd diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 3d4cd634c..0f173d111 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -37,6 +37,7 @@ import Data.Functor (($>)) import qualified Data.Map.Strict as M import Data.Maybe (isNothing) import Data.Time.Clock +import Data.Type.Equality import Network.Socket (ServiceName) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Protocol @@ -142,59 +143,78 @@ receive h Client {rcvQ} = forever $ do send :: (Transport c, MonadUnliftIO m) => THandle c -> Client -> m () send h Client {sndQ} = forever $ do t <- atomically $ readTBQueue sndQ - liftIO $ tPut h ("", serializeTransmission t) + liftIO $ tPut h (Nothing, serializeTransmission t) mkResp :: CorrId -> QueueId -> Command 'Broker -> Transmission mkResp corrId queueId command = (corrId, queueId, Cmd SBroker command) verifyTransmission :: forall m. (MonadUnliftIO m, MonadReader Env m) => SignedTransmission -> m Transmission -verifyTransmission (sig, t@(corrId, queueId, cmd)) = do +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) -> pure $ verifySignature k Cmd SRecipient _ -> verifyCmd SRecipient $ verifySignature . recipientKey - Cmd SSender (SEND _) -> verifyCmd SSender $ verifyMaybe sig . senderKey + Cmd SSender (SEND _) -> verifyCmd SSender $ verifyMaybe . senderKey Cmd SSender PING -> return cmd - Cmd SNotifier NSUB -> verifyCmd SNotifier $ verifyMaybe sig . fmap snd . notifier + Cmd SNotifier NSUB -> verifyCmd SNotifier $ verifyMaybe . fmap snd . notifier where verifyCmd :: SParty p -> (QueueRec -> Cmd) -> m Cmd verifyCmd party f = do st <- asks queueStore q <- atomically $ getQueue st party queueId - pure $ either (const $ dummyVerify authErr) f q - verifyMaybe :: C.Signature -> Maybe SenderPublicKey -> Cmd - verifyMaybe "" = maybe cmd (const authErr) - verifyMaybe _ = maybe authErr verifySignature - verifySignature :: C.PublicKey -> Cmd - verifySignature key = if verify key then cmd else authErr - verify key - | C.publicKeySize key == sigLen = cryptoVerify key - | otherwise = dummyVerify False - cryptoVerify key = C.verify key sig (serializeTransmission t) + pure $ either (const $ dummyVerify_ sig_ authErr) f q + verifyMaybe :: Maybe C.APublicVerifyKey -> Cmd + verifyMaybe (Just k) = verifySignature k + verifyMaybe _ = maybe cmd (const authErr) sig_ + verifySignature :: C.APublicVerifyKey -> Cmd + verifySignature key = case sig_ of + Just s -> if verify key s then cmd else authErr + _ -> authErr + verify :: C.APublicVerifyKey -> C.ASignature -> Bool + verify (C.APublicVerifyKey a k) sig@(C.ASignature a' s) = + case (testEquality a a', C.signatureSize k == C.signatureSize s) of + (Just Refl, True) -> cryptoVerify k s + _ -> dummyVerify sig False + cryptoVerify :: C.SignatureAlgorithm a => C.PublicKey a -> C.Signature a -> Bool + cryptoVerify k s = C.verify' k s (serializeTransmission t) + dummyVerify_ :: Maybe C.ASignature -> a -> a + dummyVerify_ = \case + Just s -> dummyVerify s + _ -> id + dummyVerify :: C.ASignature -> a -> a + dummyVerify (C.ASignature _ s) = seq $ cryptoVerify (dummyPublicKey s) s smpErr = Cmd SBroker . ERR authErr = smpErr AUTH - dummyVerify :: a -> a - dummyVerify = seq $ - cryptoVerify $ case sigLen of - 128 -> dummyKey128 - 256 -> dummyKey256 - 384 -> dummyKey384 - 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 +dummyPublicKey :: C.Signature a -> C.PublicKey a +dummyPublicKey = \case + C.SignatureRSA s' -> case B.length s' of + 128 -> dummyKey128 + 256 -> dummyKey256 + 384 -> dummyKey384 + 512 -> dummyKey512 + _ -> dummyKey256 + C.SignatureEd25519 _ -> dummyKeyEd25519 + C.SignatureEd448 _ -> dummyKeyEd448 + +dummyKeyEd25519 :: C.PublicKey 'C.Ed25519 +dummyKeyEd25519 = "MCowBQYDK2VwAyEA139Oqs4QgpqbAmB0o7rZf6T19ryl7E65k4AYe0kE3Qs=" + +dummyKeyEd448 :: C.PublicKey 'C.Ed448 +dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/XopbOSaq9qyLhrgJWKOLyNrQPNVvpMA" + +dummyKey128 :: C.PublicKey 'C.RSA dummyKey128 = "MIIBIDANBgkqhkiG9w0BAQEFAAOCAQ0AMIIBCAKBgQC2oeA7s4roXN5K2N6022I1/2CTeMKjWH0m00bSZWa4N8LDKeFcShh8YUxZea5giAveViTRNOOVLgcuXbKvR3u24szN04xP0+KnYUuUUIIoT3YSjX0IlomhDhhSyup4BmA0gAZ+D1OaIKZFX6J8yQ1Lr/JGLEfSRsBjw8l+4hs9OwKBgQDKA+YlZvGb3BcpDwKmatiCXN7ZRDWkjXbj8VAW5zV95tSRCCVN48hrFM1H4Ju2QMMUc6kPUVX+eW4ZjdCl5blIqIHMcTmsdcmsDDCg3PjUNrwc6bv/1TcirbAKcmnKt9iurIt6eerxSO7TZUXXMUVsi7eRwb/RUNhpCrpJ/hpIOw==" -dummyKey256 :: C.PublicKey +dummyKey256 :: C.PublicKey 'C.RSA dummyKey256 = "MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAxwmTvaqmdTbkfUGNi8Yu0L/T4cxuOlQlx3zGZ9X9Qx0+oZjknWK+QHrdWTcpS+zH4Hi7fP6kanOQoQ90Hj6Ghl57VU1GEdUPywSw4i1/7t0Wv9uT9Q2ktHp2rqVo3xkC9IVIpL7EZAxdRviIN2OsOB3g4a/F1ZpjxcAaZeOMUugiAX1+GtkLuE0Xn4neYjCaOghLxQTdhybN70VtnkiQLx/X9NjkDIl/spYGm3tQFMyYKkP6IWoEpj0926hJ0fmlmhy8tAOhlZsb/baW5cgkEZ3E9jVVrySCgQzoLQgma610FIISRpRJbSyv26jU7MkMxiyuBiDaFOORkXFttoKbtQKBgEbDS9II2brsz+vfI7uP8atFcawkE52cx4M1UWQhqb1H3tBiRl+qO+dMq1pPQF2bW7dlZAWYzS4W/367bTAuALHBDGB8xi1P4Njhh9vaOgTvuqrHG9NJQ85BLy0qGw8rjIWSIXVmVpfrXFJ8po5l04UE258Ll2yocv3QRQmddQW9" -dummyKey384 :: C.PublicKey +dummyKey384 :: C.PublicKey 'C.RSA dummyKey384 = "MIICITANBgkqhkiG9w0BAQEFAAOCAg4AMIICCQKCAYEAthExp77lSFBMB0RedjgKIU+oNH5lMGdMqDCG0E5Ly7X49rFpfDMMN08GDIgvzg9kcwV3ScbPcjUE19wmAShX9f9k3w38KM3wmIBKSiuCREQl0V3xAYp1SYwiAkMNSSwxuIkDEeSOR56WdEcZvqbB4lY9MQlUv70KriPDxZaqKCTKslUezXHQuYPQX6eMnGFK7hxz5Kl5MajV52d+5iXsa8CA+m/e1KVnbelCO+xhN89xG8ALt0CJ9k5Wwo3myLgXi4dmNankCmg8jkh+7y2ywkzxMwH1JydDtV/FLzkbZsbPR2w93TNrTq1RJOuqMyh0VtdBSpxNW/Ft988TkkX2BAWzx82INw7W6/QbHGNtHNB995R4sgeYy8QbEpNGBhQnfQh7yRWygLTVXWKApQzzfCeIoDDWUS7dMv/zXoasAnpDBj+6UhHv3BHrps7kBvRyZQ2d/nUuAqiGd43ljJ++n6vNyFLgZoiV7HLia/FOGMkdt7j92CNmFHxiT6Xl7kRHAoGBAPNoWny2O7LBxzAKMLmQVHBAiKp6RMx+7URvtQDHDHPaZ7F3MvtvmYWwGzund3cQFAaV1EkJoYeI3YRuj6xdXgMyMaP54On++btArb6jUtZuvlC98qE8dEEHQNh+7TsCiMU+ivbeKFxS9A/B7OVedoMnPoJWhatbA9zB/6L1GNPh" -dummyKey512 :: C.PublicKey +dummyKey512 :: C.PublicKey 'C.RSA 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 () @@ -266,10 +286,10 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ = sndQ'} Server withLog $ \s -> logAddNotifier s queueId nId nKey pure $ NID nId - checkKeySize :: Monad m' => C.PublicKey -> m' (Command 'Broker) -> m' Transmission + checkKeySize :: Monad m' => C.APublicVerifyKey -> m' (Command 'Broker) -> m' Transmission checkKeySize key action = mkResp corrId queueId - <$> if C.validKeySize $ C.publicKeySize key + <$> if C.validKeySize key then action else pure . ERR $ CMD KEY_SIZE diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index 83f2f2633..f414c71e3 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -30,7 +30,7 @@ data ServerConfig = ServerConfig msgIdBytes :: Int, storeLog :: Maybe (StoreLog 'ReadMode), blockSize :: Int, - serverPrivateKey :: C.PrivateKey + serverPrivateKey :: C.PrivateKey 'C.RSA -- serverId :: ByteString } @@ -40,7 +40,7 @@ data Env = Env queueStore :: QueueStore, msgStore :: STMMsgStore, idsDrg :: TVar ChaChaDRG, - serverKeyPair :: C.KeyPair, + serverKeyPair :: C.KeyPair 'C.RSA, storeLog :: Maybe (StoreLog 'WriteMode) } @@ -94,7 +94,7 @@ newEnv config = do idsDrg <- drgNew >>= newTVarIO s' <- restoreQueues queueStore `mapM` storeLog (config :: ServerConfig) let pk = serverPrivateKey config - serverKeyPair = (C.publicKey' pk, pk) + serverKeyPair = (C.publicKey pk, pk) return Env {config, server, queueStore, msgStore, idsDrg, serverKeyPair, storeLog = s'} where restoreQueues :: QueueStore -> StoreLog 'ReadMode -> m (StoreLog 'WriteMode) diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs index 9f7fb5552..2a0d23929 100644 --- a/src/Simplex/Messaging/Server/StoreLog.hs +++ b/src/Simplex/Messaging/Server/StoreLog.hs @@ -62,33 +62,33 @@ storeLogRecordP = <|> "DELETE " *> (DeleteQueue <$> base64P) where createQueueP = CreateQueue <$> queueRecP - secureQueueP = SecureQueue <$> base64P <* A.space <*> C.pubKeyP + secureQueueP = SecureQueue <$> base64P <* A.space <*> C.strKeyP addNotifierP = - AddNotifier <$> base64P <* A.space <*> base64P <* A.space <*> C.pubKeyP + AddNotifier <$> base64P <* A.space <*> base64P <* A.space <*> C.strKeyP queueRecP = do recipientId <- "rid=" *> base64P <* A.space senderId <- "sid=" *> base64P <* A.space - recipientKey <- "rk=" *> C.pubKeyP <* A.space - senderKey <- "sk=" *> optional C.pubKeyP - notifier <- optional $ (,) <$> (" nid=" *> base64P) <*> (" nk=" *> C.pubKeyP) + recipientKey <- "rk=" *> C.strKeyP <* A.space + senderKey <- "sk=" *> optional C.strKeyP + notifier <- optional $ (,) <$> (" nid=" *> base64P) <*> (" nk=" *> C.strKeyP) pure QueueRec {recipientId, senderId, recipientKey, senderKey, notifier, status = QueueActive} serializeStoreLogRecord :: StoreLogRecord -> ByteString serializeStoreLogRecord = \case CreateQueue q -> "CREATE " <> serializeQueue q - SecureQueue rId sKey -> "SECURE " <> encode rId <> " " <> C.serializePubKey sKey - AddNotifier rId nId nKey -> B.unwords ["NOTIFIER", encode rId, encode nId, C.serializePubKey nKey] + SecureQueue rId sKey -> "SECURE " <> encode rId <> " " <> C.serializeKey sKey + AddNotifier rId nId nKey -> B.unwords ["NOTIFIER", encode rId, encode nId, C.serializeKey nKey] DeleteQueue rId -> "DELETE " <> encode rId where serializeQueue QueueRec {recipientId, senderId, recipientKey, senderKey, notifier} = B.unwords [ "rid=" <> encode recipientId, "sid=" <> encode senderId, - "rk=" <> C.serializePubKey recipientKey, - "sk=" <> maybe "" C.serializePubKey senderKey + "rk=" <> C.serializeKey recipientKey, + "sk=" <> maybe "" C.serializeKey senderKey ] <> maybe "" serializeNotifier notifier - serializeNotifier (nId, nKey) = " nid=" <> encode nId <> " nk=" <> C.serializePubKey nKey + serializeNotifier (nId, nKey) = " nid=" <> encode nId <> " nk=" <> C.serializeKey nKey openWriteStoreLog :: FilePath -> IO (StoreLog 'WriteMode) openWriteStoreLog f = WriteStoreLog f <$> openFile f WriteMode diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index 6c15576b6..603045fbf 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -345,7 +346,7 @@ makeNextIV SessionKey {baseIV, counter} = atomically $ do -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a -- -- The numbers in function names refer to the steps in the document. -serverHandshake :: forall c. Transport c => c -> Int -> C.KeyPair -> ExceptT TransportError IO (THandle c) +serverHandshake :: forall c. Transport c => c -> Int -> C.KeyPair 'C.RSA -> ExceptT TransportError IO (THandle c) serverHandshake c srvBlockSize (k, pk) = do checkValidBlockSize srvBlockSize liftIO sendHeaderAndPublicKey_1 @@ -358,13 +359,13 @@ serverHandshake c srvBlockSize (k, pk) = do where sendHeaderAndPublicKey_1 :: IO () sendHeaderAndPublicKey_1 = do - let sKey = C.encodePubKey k + let sKey = C.encodeKey k header = ServerHeader {blockSize = srvBlockSize, keySize = B.length sKey} cPut c $ binaryServerHeader header cPut c sKey receiveEncryptedKeys_4 :: ExceptT TransportError IO ByteString receiveEncryptedKeys_4 = - liftIO (cGet c $ C.publicKeySize k) >>= \case + liftIO (cGet c $ C.keySize k) >>= \case "" -> throwE $ TEHandshake TERMINATED ks -> pure ks decryptParseKeys_5 :: ByteString -> ExceptT TransportError IO ClientHandshake @@ -390,7 +391,7 @@ clientHandshake c blkSize_ keyHash = do getWelcome_6 th >>= checkVersion pure th where - getHeaderAndPublicKey_1_2 :: ExceptT TransportError IO (C.PublicKey, Int) + getHeaderAndPublicKey_1_2 :: ExceptT TransportError IO (C.PublicKey 'C.RSA, Int) getHeaderAndPublicKey_1_2 = do header <- liftIO (cGet c serverHeaderSize) ServerHeader {blockSize, keySize} <- liftEither $ parse serverHeaderP (TEHandshake HEADER) header @@ -399,8 +400,8 @@ clientHandshake c blkSize_ keyHash = do maybe (pure ()) (validateKeyHash_2 s) keyHash key <- liftEither $ parseKey s pure (key, blockSize) - parseKey :: ByteString -> Either TransportError C.PublicKey - parseKey = first (const $ TEHandshake RSA_KEY) . parseAll C.binaryPubKeyP + parseKey :: ByteString -> Either TransportError (C.PublicKey 'C.RSA) + parseKey = first (const $ TEHandshake RSA_KEY) . parseAll C.binaryKeyP validateKeyHash_2 :: ByteString -> C.KeyHash -> ExceptT TransportError IO () validateKeyHash_2 k (C.KeyHash kHash) | C.sha256Hash k == kHash = pure () @@ -412,7 +413,7 @@ clientHandshake c blkSize_ keyHash = do aesKey <- C.randomAesKey baseIV <- C.randomIV pure SessionKey {aesKey, baseIV, counter = undefined} - sendEncryptedKeys_4 :: C.PublicKey -> ClientHandshake -> ExceptT TransportError IO () + sendEncryptedKeys_4 :: C.PublicKey 'C.RSA -> ClientHandshake -> ExceptT TransportError IO () sendEncryptedKeys_4 k chs = liftError (const $ TEHandshake ENCRYPT) (C.encryptOAEP k $ serializeClientHandshake chs) >>= liftIO . cPut c diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 83333fea5..d265b5d80 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -149,9 +150,18 @@ testForeignKeysEnabled = cData1 :: ConnData cData1 = ConnData {connId = "conn1"} -testPrivateKey :: C.PrivateKey +testPrivateSignKey :: C.APrivateSignKey +testPrivateSignKey = C.APrivateSignKey C.SRSA testPrivateKey + +testPrivateDecryptKey :: C.APrivateDecryptKey +testPrivateDecryptKey = C.APrivateDecryptKey C.SRSA testPrivateKey + +testPublicEncryptKey :: C.APublicEncryptKey +testPublicEncryptKey = C.APublicEncryptKey C.SRSA $ C.PublicKeyRSA $ R.PublicKey 1 2 3 + +testPrivateKey :: C.PrivateKey 'C.RSA testPrivateKey = - C.PrivateKey + C.PrivateKeyRSA R.PrivateKey { private_pub = R.PublicKey @@ -172,9 +182,9 @@ rcvQueue1 = RcvQueue { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash, rcvId = "1234", - rcvPrivateKey = testPrivateKey, + rcvPrivateKey = testPrivateSignKey, sndId = Just "2345", - decryptKey = testPrivateKey, + decryptKey = testPrivateDecryptKey, verifyKey = Nothing, status = New } @@ -184,9 +194,9 @@ sndQueue1 = SndQueue { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash, sndId = "3456", - sndPrivateKey = testPrivateKey, - encryptKey = C.PublicKey $ R.PublicKey 1 2 3, - signKey = testPrivateKey, + sndPrivateKey = testPrivateSignKey, + encryptKey = testPublicEncryptKey, + signKey = testPrivateSignKey, status = New } @@ -324,9 +334,9 @@ testUpgradeRcvConnToDuplex = SndQueue { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash, sndId = "2345", - sndPrivateKey = testPrivateKey, - encryptKey = C.PublicKey $ R.PublicKey 1 2 3, - signKey = testPrivateKey, + sndPrivateKey = testPrivateSignKey, + encryptKey = testPublicEncryptKey, + signKey = testPrivateSignKey, status = New } upgradeRcvConnToDuplex store "conn1" anotherSndQueue @@ -344,9 +354,9 @@ testUpgradeSndConnToDuplex = RcvQueue { server = SMPServer "smp.simplex.im" (Just "5223") testKeyHash, rcvId = "3456", - rcvPrivateKey = testPrivateKey, + rcvPrivateKey = testPrivateSignKey, sndId = Just "4567", - decryptKey = testPrivateKey, + decryptKey = testPrivateDecryptKey, verifyKey = Nothing, status = New } diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index 6892baaea..fdd88725b 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -13,6 +13,7 @@ import Control.Monad.Except (runExceptT) import Control.Monad.IO.Unlift import Crypto.Random import Data.ByteString.Base64 (encode) +import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Network.Socket import qualified Simplex.Messaging.Crypto as C @@ -36,7 +37,7 @@ testPort = "5000" testPort2 :: ServiceName testPort2 = "5001" -testKeyHashStr :: B.ByteString +testKeyHashStr :: ByteString testKeyHashStr = "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8=" testBlockSize :: Maybe Int @@ -140,8 +141,8 @@ runSmpTestN nClients test = withSmpServer (transport @c) $ run nClients [] run 0 hs = test hs run n hs = testSMPClient $ \h -> run (n - 1) (h : hs) -smpServerTest :: forall c. Transport c => TProxy c -> RawTransmission -> IO RawTransmission -smpServerTest _ cmd = runSmpTest $ \(h :: THandle c) -> tPutRaw h cmd >> tGetRaw h +smpServerTest :: forall c. Transport c => TProxy c -> SignedRawTransmission -> IO SignedRawTransmission +smpServerTest _ t = runSmpTest $ \(h :: THandle c) -> tPutRaw h t >> tGetRaw h smpTest :: Transport c => TProxy c -> (THandle c -> IO ()) -> Expectation smpTest _ test' = runSmpTest test' `shouldReturn` () @@ -167,12 +168,12 @@ smpTest4 _ test' = smpTestN 4 _test _test [h1, h2, h3, h4] = test' h1 h2 h3 h4 _test _ = error "expected 4 handles" -tPutRaw :: Transport c => THandle c -> RawTransmission -> IO () +tPutRaw :: Transport c => THandle c -> SignedRawTransmission -> IO () tPutRaw h (sig, corrId, queueId, command) = do let t = B.intercalate " " [corrId, queueId, command] - void $ tPut h (C.Signature sig, t) + void $ tPut h (sig, t) -tGetRaw :: Transport c => THandle c -> IO RawTransmission +tGetRaw :: Transport c => THandle c -> IO SignedRawTransmission tGetRaw h = do - ("", (CorrId corrId, qId, Right cmd)) <- tGet fromServer h - pure ("", corrId, encode qId, serializeCommand cmd) + (Nothing, (CorrId corrId, qId, Right cmd)) <- tGet fromServer h + pure (Nothing, corrId, encode qId, serializeCommand cmd) diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 7c12b9e18..922636b36 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -44,14 +44,14 @@ serverTests t = do pattern Resp :: CorrId -> QueueId -> Command 'Broker -> SignedTransmissionOrError pattern Resp corrId queueId command <- ("", (corrId, queueId, Right (Cmd SBroker command))) -sendRecv :: Transport c => THandle c -> (ByteString, ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError +sendRecv :: Transport c => THandle c -> (Maybe C.ASignature, ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError sendRecv h (sgn, corrId, qId, cmd) = tPutRaw h (sgn, corrId, encode qId, cmd) >> tGet fromServer h -signSendRecv :: Transport c => THandle c -> C.PrivateKey -> (ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError +signSendRecv :: Transport c => THandle c -> C.APrivateSignKey -> (ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError signSendRecv h pk (corrId, qId, cmd) = do let t = B.intercalate " " [corrId, encode qId, cmd] Right sig <- runExceptT $ C.sign pk t - _ <- tPut h (sig, t) + _ <- tPut h (Just sig, t) tGet fromServer h cmdSEND :: ByteString -> ByteString @@ -64,8 +64,8 @@ testCreateSecure :: ATransport -> Spec testCreateSecure (ATransport t) = it "should create (NEW) and secure (KEY) queue" $ smpTest t $ \h -> do - (rPub, rKey) <- C.generateKeyPair rsaKeySize - Resp "abcd" rId1 (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub) + (rPub, rKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA + Resp "abcd" rId1 (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializeKey rPub) (rId1, "") #== "creates queue" Resp "bcda" sId1 ok1 <- sendRecv h ("", "bcda", sId, "SEND 5 hello ") @@ -81,12 +81,12 @@ testCreateSecure (ATransport t) = Resp "dabc" _ err6 <- signSendRecv h rKey ("dabc", rId, "ACK") (err6, ERR NO_MSG) #== "replies ERR when message acknowledged without messages" - (sPub, sKey) <- C.generateKeyPair rsaKeySize + (sPub, sKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA Resp "abcd" sId2 err1 <- signSendRecv h sKey ("abcd", sId, "SEND 5 hello ") (err1, ERR AUTH) #== "rejects signed SEND" (sId2, sId) #== "same queue ID in response 2" - let keyCmd = "KEY " <> C.serializePubKey sPub + let keyCmd = "KEY " <> C.serializeKey sPub Resp "bcda" _ err2 <- sendRecv h (sampleSig, "bcda", rId, keyCmd) (err2, ERR AUTH) #== "rejects KEY with wrong signature" @@ -116,12 +116,12 @@ testCreateDelete :: ATransport -> Spec testCreateDelete (ATransport t) = it "should create (NEW), suspend (OFF) and delete (DEL) queue" $ smpTest2 t $ \rh sh -> do - (rPub, rKey) <- C.generateKeyPair rsaKeySize - Resp "abcd" rId1 (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializePubKey rPub) + (rPub, rKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA + Resp "abcd" rId1 (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializeKey rPub) (rId1, "") #== "creates queue" - (sPub, sKey) <- C.generateKeyPair rsaKeySize - Resp "bcda" _ ok1 <- signSendRecv rh rKey ("bcda", rId, "KEY " <> C.serializePubKey sPub) + (sPub, sKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA + Resp "bcda" _ ok1 <- signSendRecv rh rKey ("bcda", rId, "KEY " <> C.serializeKey sPub) (ok1, OK) #== "secures queue" Resp "cdab" _ ok2 <- signSendRecv sh sKey ("cdab", sId, "SEND 5 hello ") @@ -184,22 +184,22 @@ testDuplex :: ATransport -> Spec testDuplex (ATransport t) = it "should create 2 simplex connections and exchange messages" $ smpTest2 t $ \alice bob -> do - (arPub, arKey) <- C.generateKeyPair rsaKeySize - Resp "abcd" _ (IDS aRcv aSnd) <- signSendRecv alice arKey ("abcd", "", "NEW " <> C.serializePubKey arPub) + (arPub, arKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA + Resp "abcd" _ (IDS aRcv aSnd) <- signSendRecv alice arKey ("abcd", "", "NEW " <> C.serializeKey arPub) -- aSnd ID is passed to Bob out-of-band - (bsPub, bsKey) <- C.generateKeyPair rsaKeySize - Resp "bcda" _ OK <- sendRecv bob ("", "bcda", aSnd, cmdSEND $ "key " <> C.serializePubKey bsPub) + (bsPub, bsKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA + Resp "bcda" _ OK <- sendRecv bob ("", "bcda", aSnd, cmdSEND $ "key " <> C.serializeKey bsPub) -- "key ..." is ad-hoc, different from SMP protocol Resp "" _ (MSG _ _ msg1) <- tGet fromServer alice Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, "ACK") ["key", bobKey] <- return $ B.words msg1 - (bobKey, C.serializePubKey bsPub) #== "key received from Bob" + (bobKey, C.serializeKey bsPub) #== "key received from Bob" Resp "dabc" _ OK <- signSendRecv alice arKey ("dabc", aRcv, "KEY " <> bobKey) - (brPub, brKey) <- C.generateKeyPair rsaKeySize - Resp "abcd" _ (IDS bRcv bSnd) <- signSendRecv bob brKey ("abcd", "", "NEW " <> C.serializePubKey brPub) + (brPub, brKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA + Resp "abcd" _ (IDS bRcv bSnd) <- signSendRecv bob brKey ("abcd", "", "NEW " <> C.serializeKey brPub) Resp "bcda" _ OK <- signSendRecv bob bsKey ("bcda", aSnd, cmdSEND $ "reply_id " <> encode bSnd) -- "reply_id ..." is ad-hoc, it is not a part of SMP protocol @@ -208,14 +208,14 @@ testDuplex (ATransport t) = ["reply_id", bId] <- return $ B.words msg2 (bId, encode bSnd) #== "reply queue ID received from Bob" - (asPub, asKey) <- C.generateKeyPair rsaKeySize - Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, cmdSEND $ "key " <> C.serializePubKey asPub) + (asPub, asKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA + Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, cmdSEND $ "key " <> C.serializeKey asPub) -- "key ..." is ad-hoc, different from SMP protocol Resp "" _ (MSG _ _ msg3) <- tGet fromServer bob Resp "abcd" _ OK <- signSendRecv bob brKey ("abcd", bRcv, "ACK") ["key", aliceKey] <- return $ B.words msg3 - (aliceKey, C.serializePubKey asPub) #== "key received from Alice" + (aliceKey, C.serializeKey asPub) #== "key received from Alice" Resp "bcda" _ OK <- signSendRecv bob brKey ("bcda", bRcv, "KEY " <> aliceKey) Resp "cdab" _ OK <- signSendRecv bob bsKey ("cdab", aSnd, "SEND 8 hi alice ") @@ -234,8 +234,8 @@ testSwitchSub :: ATransport -> Spec testSwitchSub (ATransport t) = it "should create simplex connections and switch subscription to another TCP connection" $ smpTest3 t $ \rh1 rh2 sh -> do - (rPub, rKey) <- C.generateKeyPair rsaKeySize - Resp "abcd" _ (IDS rId sId) <- signSendRecv rh1 rKey ("abcd", "", "NEW " <> C.serializePubKey rPub) + (rPub, rKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA + Resp "abcd" _ (IDS rId sId) <- signSendRecv rh1 rKey ("abcd", "", "NEW " <> C.serializeKey rPub) Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, "SEND 5 test1 ") (ok1, OK) #== "sent test message 1" Resp "cdab" _ ok2 <- sendRecv sh ("", "cdab", sId, cmdSEND "test2, no ACK") @@ -271,9 +271,9 @@ testSwitchSub (ATransport t) = testWithStoreLog :: ATransport -> Spec testWithStoreLog at@(ATransport t) = it "should store simplex queues to log and restore them after server restart" $ do - (sPub1, sKey1) <- C.generateKeyPair rsaKeySize - (sPub2, sKey2) <- C.generateKeyPair rsaKeySize - (nPub, nKey) <- C.generateKeyPair rsaKeySize + (sPub1, sKey1) <- C.generateSignatureKeyPair rsaKeySize C.SRSA + (sPub2, sKey2) <- C.generateSignatureKeyPair rsaKeySize C.SRSA + (nPub, nKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA senderId1 <- newTVarIO "" senderId2 <- newTVarIO "" notifierId <- newTVarIO "" @@ -281,7 +281,7 @@ testWithStoreLog at@(ATransport t) = withSmpServerStoreLogOn at testPort . runTest t $ \h -> runClient t $ \h1 -> do (sId1, rId, rKey) <- createAndSecureQueue h sPub1 atomically $ writeTVar senderId1 sId1 - Resp "abcd" _ (NID nId) <- signSendRecv h rKey ("abcd", rId, "NKEY " <> C.serializePubKey nPub) + Resp "abcd" _ (NID nId) <- signSendRecv h rKey ("abcd", rId, "NKEY " <> C.serializeKey nPub) atomically $ writeTVar notifierId nId Resp "dabc" _ OK <- signSendRecv h1 nKey ("dabc", nId, "NSUB") Resp "bcda" _ OK <- signSendRecv h sKey1 ("bcda", sId1, "SEND 5 hello ") @@ -332,11 +332,11 @@ testWithStoreLog at@(ATransport t) = Right l -> pure l Left (_ :: SomeException) -> logSize -createAndSecureQueue :: Transport c => THandle c -> SenderPublicKey -> IO (SenderId, RecipientId, C.PrivateKey) +createAndSecureQueue :: Transport c => THandle c -> SenderPublicKey -> IO (SenderId, RecipientId, C.APrivateSignKey) createAndSecureQueue h sPub = do - (rPub, rKey) <- C.generateKeyPair rsaKeySize - Resp "abcd" "" (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub) - let keyCmd = "KEY " <> C.serializePubKey sPub + (rPub, rKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA + Resp "abcd" "" (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializeKey rPub) + let keyCmd = "KEY " <> C.serializeKey sPub Resp "dabc" rId' OK <- signSendRecv h rKey ("dabc", rId, keyCmd) (rId', rId) #== "same queue ID" pure (sId, rId, rKey) @@ -347,54 +347,81 @@ testTiming (ATransport t) = smpTest2 t $ \rh sh -> mapM_ (testSameTiming rh sh) - [ (128, 128, 100), - (128, 256, 25), - (128, 384, 15), - -- (128, 512, 15), - (256, 128, 100), - (256, 256, 25), - (256, 384, 15), - -- (256, 512, 15), - (384, 128, 100), - (384, 256, 25), - (384, 384, 15) - -- (384, 512, 15), - -- (512, 128, 100), - -- (512, 256, 25), + [ (32, 32, 200), + (32, 57, 100), + (32, 128, 40), + (32, 256, 20), + (57, 32, 200), + (57, 57, 100), + (57, 128, 40), + (57, 256, 20), + (128, 32, 200), + (128, 57, 100), + (128, 128, 40), + (128, 256, 20), + (256, 32, 200), + (256, 57, 100), + (256, 128, 40), + (256, 256, 20) + -- (256, 384, 15), + -- (256, 512, 10), + -- (384, 128, 40), + -- (384, 256, 20), + -- (384, 384, 15), + -- (384, 512, 10), + -- (512, 128, 40), + -- (512, 256, 20), -- (512, 384, 15), - -- (512, 512, 15) + -- (512, 512, 10) ] where timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const - similarTime t1 t2 = abs (t1 - t2) / t1 < 0.2 `shouldBe` True + similarTime t1 t2 = abs (t2 / t1 - 1) < 0.25 `shouldBe` True testSameTiming :: Transport c => THandle c -> THandle c -> (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) + testSameTiming rh sh (goodKeySize, badKeySize, n) = do + (rPub, rKey) <- generateKeys goodKeySize + Resp "abcd" "" (IDS rId sId) <- signSendRecv rh rKey ("abcd", "", "NEW " <> C.serializeKey rPub) + Resp "cdab" _ OK <- signSendRecv rh rKey ("cdab", rId, "SUB") - (sPub, sKey) <- C.generateKeyPair senderKeySize - let keyCmd = "KEY " <> C.serializePubKey sPub + (_, badKey) <- generateKeys badKeySize + -- runTimingTest rh badKey rId "SUB" + + (sPub, sKey) <- generateKeys goodKeySize + let keyCmd = "KEY " <> C.serializeKey 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 ") - timeWrongKey <- timeRepeat n $ do - Resp "cdab" _ (ERR AUTH) <- signSendRecv sh badKey ("cdab", sId, "SEND 5 hello ") - return () - timeNoQueue <- timeRepeat n $ do - Resp "dabc" _ (ERR AUTH) <- signSendRecv sh badKey ("dabc", "1234", "SEND 5 hello ") - return () Resp "" _ (MSG _ _ "hello") <- tGet fromServer rh - similarTime timeNoQueue timeWrongKey + runTimingTest sh badKey sId "SEND 5 hello " + where + generateKeys = \case + 32 -> C.generateSignatureKeyPair 0 C.SEd25519 + 57 -> C.generateSignatureKeyPair 0 C.SEd448 + size -> C.generateSignatureKeyPair size C.SRSA + runTimingTest h badKey qId cmd = do + timeWrongKey <- timeRepeat n $ do + Resp "cdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdab", qId, cmd) + return () + timeNoQueue <- timeRepeat n $ do + Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", "1234", cmd) + return () + -- (putStrLn . unwords . map show) + -- [ fromIntegral goodKeySize, + -- fromIntegral badKeySize, + -- timeWrongKey, + -- timeNoQueue, + -- timeWrongKey / timeNoQueue - 1 + -- ] + similarTime timeNoQueue timeWrongKey testMessageNotifications :: ATransport -> Spec testMessageNotifications (ATransport t) = it "should create simplex connection, subscribe notifier and deliver notifications" $ do - (sPub, sKey) <- C.generateKeyPair rsaKeySize - (nPub, nKey) <- C.generateKeyPair rsaKeySize + (sPub, sKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA + (nPub, nKey) <- C.generateSignatureKeyPair rsaKeySize C.SRSA smpTest4 t $ \rh sh nh1 nh2 -> do (sId, rId, rKey) <- createAndSecureQueue rh sPub - Resp "1" _ (NID nId) <- signSendRecv rh rKey ("1", rId, "NKEY " <> C.serializePubKey nPub) + Resp "1" _ (NID nId) <- signSendRecv rh rKey ("1", rId, "NKEY " <> C.serializeKey nPub) Resp "2" _ OK <- signSendRecv nh1 nKey ("2", nId, "NSUB") Resp "3" _ OK <- signSendRecv sh sKey ("3", sId, "SEND 5 hello ") Resp "" _ (MSG _ _ "hello") <- tGet fromServer rh @@ -412,8 +439,8 @@ testMessageNotifications (ATransport t) = 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" +sampleSig :: Maybe C.ASignature +sampleSig = "gM8qn2Vx3GkhIp2hgrji9uhfXKpgtKDmc0maxdP8GvbORUxMCTlLG8Q/gNcl3pQVOzmbZqTZZfKcGDn9DaquJ3fT5D/NKdeW//d6ETE1EXsIbpENS0QsS+bKZDjpp3w3eQlfUxn4BNisp2S14CmJBm/FaiNj2fPkLqfkzZALcoY=" syntaxTests :: ATransport -> Spec syntaxTests (ATransport t) = do @@ -452,5 +479,5 @@ syntaxTests (ATransport t) = do 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" $ (sampleSig, "dabc", "", cmd) >#> ("", "dabc", "", "ERR CMD NO_AUTH") - (>#>) :: RawTransmission -> RawTransmission -> Expectation + (>#>) :: SignedRawTransmission -> SignedRawTransmission -> Expectation command >#> response = smpServerTest t command `shouldReturn` response From db509d0311525d624e3b67b11f4b5116fac6e100 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sun, 28 Nov 2021 21:01:34 +0000 Subject: [PATCH 10/13] update protocol docs (#209) * update protocol docs * more protocol corrections * update connection request syntax * Update protocol/agent-protocol.md Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> * Update protocol/agent-protocol.md Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> * Update protocol/agent-protocol.md Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> * Update protocol/agent-protocol.md Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> * Update protocol/simplex-messaging.md Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> --- protocol/agent-protocol.md | 145 ++++++++++++++++++++++------------ protocol/simplex-messaging.md | 31 +++++--- 2 files changed, 114 insertions(+), 62 deletions(-) diff --git a/protocol/agent-protocol.md b/protocol/agent-protocol.md index 41c1297b4..00dbc873b 100644 --- a/protocol/agent-protocol.md +++ b/protocol/agent-protocol.md @@ -31,7 +31,7 @@ The purpose of SMP agent protocol is to define the syntax and the semantics of communications between the client and the agent that connects to [SMP](./simplex-messaging.md) servers. It provides: -- convenient protocol to create and manage bi-directional (duplex) connections between the users of SMP agents consisting of two (or more) separate unidirectional (simplex) SMP queues, abstracting away multiple steps required to establish bi-directional connections and any information about the servers location from the users of the protocol. +- protocol to create and manage bi-directional (duplex) connections between the users of SMP agents consisting of two (or more) separate unidirectional (simplex) SMP queues, abstracting away multiple steps required to establish bi-directional connections and any information about the servers location from the users of the agent protocol. - management of E2E encryption between SMP agents, generating ephemeral asymmetric keys for each connection. - SMP command authentication on SMP servers, generating ephemeral keys for each SMP queue. - TCP/TLS transport handshake with SMP servers. @@ -44,48 +44,48 @@ SMP agent protocol provides no encryption or security on the client side - it is ## SMP agent -SMP agent communicates via SMP servers using [simplex messaging protocol (SMP)](./simplex-messaging.md) with other SMP agents according to the commands received from its users. This protocol is a middle layer in SimpleX protocols (above SMP protocol but below any application level protocol) - it is intended to be used by client-side applications that need secure asynchronous bi-directional communication channels ("connections"). +SMP agents communicate with each other via SMP servers using [simplex messaging protocol (SMP)](./simplex-messaging.md) according to the commands received from its users. This protocol is a middle layer in SimpleX protocols (above SMP protocol but below any application level protocol) - it is intended to be used by client-side applications that need secure asynchronous bi-directional communication channels ("connections"). -The agent must have a persistent storage to manage the states of known connections and of the client-side information of SMP queues that each connection consists of, and also the buffer of the most recent sent and received messages. The number of the messages that should be stored is implementation specific, depending on the error management approach that the agent implements; at the very least the agent must store the hash and id of the last received and sent message. +The agent must have a persistent storage to manage the states of known connections and of the client-side information of SMP queues that each connection consists of, and also the buffer of the most recent sent and received messages. The number of the messages that should be stored is implementation specific, depending on the error management approach that the agent implements; at the very least the agent must store the hashes and IDs of the last received and sent messages. ## SMP servers management -SMP agent protocol commands do not contain SMP servers that the agent will use to establish the connections. The servers are part of the agent configuration and can be dynamically added and removed by the agent implementation: +SMP agent protocol commands do not contain the addresses of the SMP servers that the agent will use to create and use the connections (excluding the server address in queue URIs used in JOIN command). The list of the servers is a part of the agent configuration and can be dynamically changed by the agent implementation: - by the client applications via any API that is outside of scope of this protocol. -- by the agents themselves based on servers availability and latency. +- by the agents themselves based on availability and latency of the configured servers. ## SMP agent protocol components SMP agent protocol has 3 main parts: -- the syntax and semantics of messages that SMP agents exchange between each other in order to: - - negotiate establishing unidirectional (simplex) encrypted queues on SMP server(s) +- the syntax and semantics of the messages that SMP agents exchange with each other in order to: + - negotiate establishing unidirectional (simplex) encrypted queues on SMP servers. - exchange client messages and delivery notifications, providing sequential message IDs and message integrity (by including the hash of the previous message). -- the syntax and semantics of the commands that are sent over TCP or other sequential protocol by agent clients to the agents. This protocol allows to create and manage multiple connections, each consisting of two or more SMP queues. -- the syntax and semantics of the message that the clients of SMP agents should send out-of-band (as pre-shared "invitation" including SMP server, queue ID and encryption key) to ensure [E2E encryption][1] the integrity of SMP queues and protection against active attacks ([MITM attacks][2]). +- the syntax and semantics of the commands that are sent by the agent clients to the agents. This protocol allows to create and manage multiple connections, each consisting of two or more SMP queues. +- the syntax and semantics of the message that the clients of SMP agents should send out-of-band (as pre-shared "invitation" including queue URIs) to protect [E2E encryption][1] from active attacks ([MITM attacks][2]). ## Duplex connection procedure ![Duplex connection procedure](./diagrams/duplex-messaging/duplex-creating.svg) -The procedure of establishing a duplex connection is explained on the example of Alice and Bob creating a bi-directional connection comprised of two unidirectional (simplex) queues, using SMP agents (A and B) to facilitate it, and two different SMP servers (which could be the same server). It is shown on the diagram above and has these steps: +The procedure of establishing a duplex connection is explained on the example of Alice and Bob creating a bi-directional connection consisting of two unidirectional (simplex) queues, using SMP agents (A and B) to facilitate it, and two different SMP servers (which could be the same server). It is shown on the diagram above and has these steps: -1. Alice requests the new connection from the SMP agent A using `NEW` command. +1. Alice requests the new connection from the SMP agent A using SMP NEW command. 2. Agent A creates an SMP connection on the server (using [SMP protocol](./simplex-messaging.md)) and responds to Alice with the invitation that contains queue information and the encryption key Bob's agent B should use. The invitation format is described in [Connection request](#connection-request). -3. Alice sends the invitation to Bob via any secure channel they have (out-of-band message). -4. Bob sends `JOIN` command with the invitation as a parameter to agent B to accept the connection. -5. Establishing Alice's SMP connection (with SMP protocol commands): - - Agent B sends an "SMP confirmation" to the SMP queue specified in the invitation - SMP confirmation is an unauthenticated message with an ephemeral key that will be used to authenticate Bob's commands to the queue, as described in SMP protocol, and Bob's info. - - Agent A receives the SMP confirmation containing Bob's key and info. +3. Alice sends the [connection request](#connection-request) to Bob via any secure channel (out-of-band message). +4. Bob sends `JOIN` command with the connection request as a parameter to agent B to accept the connection. +5. Establishing Alice's SMP queue (with SMP protocol commands): + - Agent B sends an "SMP confirmation" with SMP SEND command to the SMP queue specified in the connection request - SMP confirmation is an unauthenticated message with an ephemeral key that will be used to authenticate Bob's commands to the queue, as described in SMP protocol, and Bob's info (profile, public key for E2E encryption, etc.). This message is encrypted using key passed in the connection request (or with the derived key, in which case public key for key derivation should be sent in clear text). + - Agent A receives the SMP confirmation containing Bob's key and info as SMP MSG. - Agent A notifies Alice sending REQ notification with Bob's info. - Alice accepts connection request with ACPT command. - - Agent A secures the queue. + - Agent A secures the queue with SMP KEY command. - Agent B tries sending authenticated SMP SEND command with agent `HELLO` message until it succeeds. Once it succeeds, Bob's agent "knows" the queue is secured. 6. Agent B creates a new SMP queue on the server. 7. Establish Bob's SMP queue: - - Agent B sends `REPLY` message with the invitation to this 2nd queue to Alice's agent (via the 1st queue). - - Agent A, having received this `REPLY` message, sends unauthenticated message to SMP queue with Alice agent's ephemeral key that will be used to authenticate Alice's commands to the queue, as described in SMP protocol, and Alice's info. - - Bob's agent receives the key and Alice's information and secures the queue. + - Agent B sends `REPLY` message (SMP SEND command) with the connection request to this 2nd queue to Alice's agent (via the 1st queue) - this connection request SHOULD use "simplex" URI scheme. + - Agent A, having received `REPLY` message, sends unauthenticated message (SMP SEND) to SMP queue with Alice agent's ephemeral key that will be used to authenticate Alice's commands to the queue, as described in SMP protocol, and Alice's info. + - Bob's agent receives the key and Alice's information and secures the queue (SMP KEY). - Bob's agent sends the notification `INFO` with Alice's information to Bob. - Alice's agent keeps sending `HELLO` message until it succeeds. 8. Agents A and B notify Alice and Bob that connection is established. @@ -94,17 +94,21 @@ The procedure of establishing a duplex connection is explained on the example of At this point the duplex connection between Alice and Bob is established, they can use `SEND` command to send messages. The diagram also shows how the connection status changes for both parties, where the first part is the status of the SMP queue to receive messages, and the second part - the status of the queue to send messages. -The most communication happens between the agents and servers, from the point of view of Alice and Bob they have only 3 steps to do: +The most communication happens between the agents and servers, from the point of view of Alice and Bob there are 4 steps (not including notifications): 1. Alice requests a new connection with `NEW` command and receives the invitation. -2. Alice passes invitation out-of-band to Bob. -3. Bob accepts the connection by sending `JOIN` command with the invitation to his agent. +2. Alice passes connection request out-of-band to Bob. +3. Bob accepts the connection with `JOIN` command with the connection request to his agent. +4. Alice accepts the connection with `ACPT` command. +5. Both parties receive `CON` notification once duplex connection is established. + +Clients SHOULD support establishing duplex connection asynchronously (when parties are intermittently offline) by persisting intermediate states and resuming SMP queue subscriptions. ## Communication between SMP agents -SMP agents communicate via SMP servers managing creation, deletion and operations of SMP queues. +To establish duplex connections and to send messages on behalf of their clients, SMP agents communicate via SMP servers. -Agents can use SMP message client body (the part of the SMP message after header - see [SMP protocol](./simplex-messaging.md)) to transmit agent client messages and exchange messages between each other. +Agents use SMP message client body (the part of the SMP message after header - see [SMP protocol](./simplex-messaging.md)) to transmit agent client messages and exchange messages between each other. Each SMP message client body, once decrypted, contains 3 parts (one of them may include binary message body), as defined by `decryptedSmpMessageBody` syntax: @@ -112,8 +116,9 @@ Each SMP message client body, once decrypted, contains 3 parts (one of them may - `agentMessage` - a command/message to the other SMP agent: - to establish the connection with two SMP queues (`helloMsg`, `replyQueueMsg`) - to send and to acknowledge user messages (`clientMsg`, `acknowledgeMsg`) - - to notify another agent about queue deletion (`deleteQueueMsg`) -- `msgPadding` - an optional message padding to make all SMP messages have consistent size as an additional privacy protection measure. + - to manage SMP queue rotation (`newQueueMessage`, `deleteQueueMsg`) + - to manage encryption key rotation (TODO) +- `msgPadding` - an optional message padding to make all SMP messages have constant size, to prevent servers from observing the actual message size. ### Messages between SMP agents @@ -127,7 +132,9 @@ agentTimestamp = ; RFC3339 previousMsgHash = encoded encoded = -agentMessage = helloMsg / replyQueueMsg / deleteQueueMsg / clientMsg / acknowledgeMsg +agentMessage = helloMsg / replyQueueMsg / + clientMsg / acknowledgeMsg / + newQueueMessage / deleteQueueMsg msgPadding = *OCTET ; optional random bytes to get messages to the same size (as defined in SMP message size) @@ -135,19 +142,18 @@ helloMsg = %s"HELLO" SP signatureVerificationKey [SP %s"NO_ACK"] ; NO_ACK means that acknowledgements to client messages will NOT be sent in this connection by the agent that sent `HELLO` message. signatureVerificationKey = encoded -replyQueueMsg = %s"REPLY" SP ; `connectionRequest` is defined below +replyQueueMsg = %s"REPLY" SP connectionRequest ; `connectionRequest` is defined below ; this message can only be sent by the second connection party -deleteQueueMsg = %s"DEL" ; notification that recipient queue will be deleted -; no need to notify the other party about suspending queue separately, as suspended and deleted queues are the same to the sender -; NOT SUPPORTED with the current implementation - clientMsg = %s"MSG" SP size CRLF clientMsgBody CRLF ; CRLF is in addition to CRLF in decryptedSmpMessageBody size = 1*DIGIT clientMsgBody = *OCTET -acknowledgeMsg = %s"ACK" SP agentMsgId SP ackStatus -; NOT SUPPORTED with the current implementation +acknowledgeMsg = %s"ACK" SP agentMsgId SP msgHash SP ackStatus +; NOT SUPPORTED in the current implementation + +msgHash = encoded +; base64 encoded hash of the received message ackStatus = %s"OK" / ackError @@ -157,26 +163,47 @@ ackErrorType = ackUnknownMsg / ackProhibitedMsg / ackSyntaxErr ackUnknownMsg = %s"UNKNOWN" -ackProhibitedMsg = %s"PROHIBITED" ; e.g. "HELLO" or "REPLY" +ackProhibitedMsg = %s"PROHIBITED" ; unexpected message e.g. "HELLO" or "REPLY" ackSyntaxErr = %s"SYNTAX" SP syntaxErrCode syntaxErrCode = 1*DIGIT ; TODO + +newQueueMsg = %s"NEW" SP queueURI +; this message can be sent by any party to add SMP queue to the connection. +; NOT SUPPORTED in the current implementation + +deleteQueueMsg = %s"DEL" SP queueURI +; notification that the queue with passed URI will be deleted +; no need to notify the other party about suspending queue separately, as suspended and deleted queues are indistinguishable to the sender +; NOT SUPPORTED in the current implementation ``` #### HELLO message -This is the first message that both agents send after the respective SMP queue is secured by the receiving agent (see diagram). It contains the verification key that the sender will use to cryptographically sign the messages. +This is the first message that both agents send after the respective SMP queue is secured by the receiving agent (see diagram). It MAY contain the public key that the recipient would use to verify messages signed by the sender. -Sending agent might need to retry sending HELLO message, as it would not have any other confirmation that the queue is secured other than the success of sending this message with the signed SEND command of SMP protocol. +Sending agent might need to retry sending HELLO message, as it would not have any other confirmation that the queue is secured other than the success of sending this message with the signed SMP SEND command. #### REPLY message -This is the message that is sent by the agent that received an out-of-band invitation to pass the invitation to the reply SMP queue to the agent that originated the connection (see diagram). +This is the message that is sent by the agent that received an out-of-band connection request to pass the connection request for the reply SMP queues to the agent that originated the connection (see diagram). #### MSG message This is the agent envelope used to send client messages once the connection is established. Do not confuse it with the MSG response from SMP server to the agent and MSG response from SMP agent to the client that are sent in different contexts. +#### ACK message + +This message is sent to confirm the client message reception. It includes received message number, message hash and the reception status. + +#### NEW message + +This message is sent to add an additional SMP queue to the connection. Unlike REPLY message it can be sent at any time. + +#### DEL message + +This message is sent to notify that the queue with passed URI will be deleted - having received this message, the receiving agent should no longer send messages to this queue. In case it was the only queue in the connection to which the agent could send the messages, it MAY also delete the reply queue(s) in the connection. + ## SMP agent commands This part describes the transmissions between users and client-side SMP agents: commands that the users send to create and operate duplex connections and SMP agent responses and messages they deliver. @@ -272,9 +299,12 @@ previousMsgId = agentMsgId acknowledgeCmd = %s"ACK" SP agentMsgId ; ID assigned by receiving agent (in MSG "R") -received = %s"RCVD" SP agentMsgId ; ID assigned by sending agent (in SENT response) +received = %s"RCVD" SP agentMsgId SP msgIntegrity +; ID assigned by sending agent (in SENT response) ; currently not implemented +msgStatus = ok | error + ok = %s"OK" error = %s"ERR" SP @@ -284,13 +314,13 @@ error = %s"ERR" SP #### NEW command and INV response -`NEW` command is used to create a connection and an invitation to be sent out-of-band to another protocol user (the joining party). It should be used by the client of the agent that initiates creating a duplex connection (the initiating party). +`NEW` command is used to create a connection and a connection request to be sent out-of-band to another protocol user (the joining party). It should be used by the client of the agent that initiates creating a duplex connection (the initiating party). `INV` response is sent by the agent to the client of the initiating party. #### JOIN command -It is used to create a connection and accept the invitation received out-of-band. It should be used by the client of the agent that accepts the connection (the joining party). +It is used to create a connection and accept the connection request received out-of-band. It should be used by the client of the agent that accepts the connection (the joining party). #### REQ notification and ACPT command @@ -308,17 +338,17 @@ Once the connection is established and ready to accept client messages, both age This command can be used by the client to resume receiving messages from the connection that was created in another TCP/client session. Agent response to this command can be `OK` or `ERR` in case connection does not exist (or can only be used to send connections - e.g. when the reply queue was not created). -#### SEND command and MID, SENT and MERR responses +#### SEND command and MID, SENT, RCVD and MERR responses `SEND` command is used by the client to send messages. -`MID` notification with the message ID (the sequential message number that includes both sent and received messages in the connection) is sent to the client to confirm that the message is accepted by the agent, before it is sent to the SMP server. +`MID` response with the message ID (the sequential message number that includes both sent and received messages in the connection) is sent to the client to confirm that the message is accepted by the agent, before it is sent to the SMP server. -`SENT` response is sent by the agent to confirm that the message was delivered to the SMP server. This notification contains the same message ID as `MID` notification. `SENT` notification, depending on network availability, can be sent at any time later, potentially in the next client session. +`SENT` notification is sent by the agent to confirm that the message was delivered to at least one of SMP servers. This notification contains the same message ID as `MID` notification. `SENT` notification, depending on network availability, can be sent at any time later, potentially in the next client session. -In case of the failure to send the message for any other reason than network connection or message queue quota - e.g. authentication error (`ERR AUTH`) or syntax error (`ERR CMD error`), the agent will send to the client `MERR` notification with the message ID, and this message delivery will no longer be attempted. +`RCVD` notification is sent by the agent when it receives `ACK` message from the receiving agent. This notification contains reception status, only one successful notification will be sent, and multiple error notifications will be sent in case `ACK` had error status. -In case of client disconnecting from the agent, the pending messages will not be sent until the client re-connects to the agent and subscribes to the connection that has pending messages. +In case of the failure to send the message for any other reason than network connection or message queue quota - e.g. authentication error (`ERR AUTH`) or syntax error (`ERR CMD error`), the agent will send to the client `MERR` notification with the message ID, and this message delivery will no longer be attempted to this SMP queue. #### MSG notification @@ -347,19 +377,32 @@ It is used to delete the connection and all messages in it, as well as the recei ## Connection request -Connection request `connectionRequest` is generated by SMP agent in response to `newCmd` command (`"NEW"`), used by another party user with `joinCmd` command (`"JOIN"`), and then another invitation is sent by the agent in `replyQueueMsg` and used by the first party agent to connect to the reply queue (the second part of the process is invisible to the users). +Connection request `connectionRequest` is generated by SMP agent in response to `newCmd` command (`"NEW"`), used by another party user with `joinCmd` command (`"JOIN"`), and then another connection request is sent by the agent in `replyQueueMsg` and used by the first party agent to connect to the reply queue (the second part of the process is invisible to the users). Connection request syntax: ``` -connectionRequest = queueURI "#/connect/" encryptionScheme ":" publicKey +connectionRequest = connectionProtocol "/" action "#/?smp=" smpQueues "&e2e=" e2eEncryption +action = %s"connect" +connectionProtocol = (%s"https://" clientAppServer) | %s"simplex:" +clientAppServer = hostname [ ":" port ] +; client app server, e.g. simplex.chat +e2eEncryption = encryptionScheme ":" publicKey encryptionScheme = %s"rsa" ; end-to-end encryption and key exchange protocols, ; the current hybrid encryption scheme (RSA-OAEP/AES-256-GCM-SHA256) ; will be replaced with double ratchet protocol and DH key exchange. -publicKey = +publicKey = +smpQueues = smpQueue [ "," 1*smpQueue ] ; SMP queues for the connection +smpQueue = ``` -See SMP protocol [out-of-band messages](./simplex-messaging.md#out-of-band-messages) for syntax for queueURI. +All parameters are passed via URI hash to avoid sending them to the server (in case "https" scheme is used) - they can be used by the client-side code and processed by the client application. Parameters `smp` and `e2e` can be present in any order, any unknown additional parameters SHOULD be ignored. + +`clientAppServer` is not an SMP server - it is a server that shows the instruction on how to download the client app that will connect using this connection request. This server can also host a mobile or desktop app manifest so that this link is opened directly in the app if it is installed on the device. + +"simplex" URI scheme in `connectionProtocol` can be used instead of client app server, to connect without creating any web traffic. Client apps MUST support this URI scheme. + +See SMP protocol [out-of-band messages](./simplex-messaging.md#out-of-band-messages) for syntax of `queueURI`. [1]: https://en.wikipedia.org/wiki/End-to-end_encryption [2]: https://en.wikipedia.org/wiki/Man-in-the-middle_attack diff --git a/protocol/simplex-messaging.md b/protocol/simplex-messaging.md index d90b3353b..1ae222b1d 100644 --- a/protocol/simplex-messaging.md +++ b/protocol/simplex-messaging.md @@ -300,11 +300,11 @@ Simplex messaging clients and servers must cryptographically sign commands, resp - queue IDs response (`IDS`) - notifier queue ID response (`NID`) - delivered messages (`MSG`) - - `OK` and `ERR` responses + - `OK` and `ERR` responses (excluding error responses not related to a queue) -To sign/verify commands, messages and responses, clients and servers MUST use Ed25519 or Ed448 algorithm defined in [RFC8709][15]. +To sign/verify transmissions clients and servers MUST use Ed25519 or Ed448 algorithm defined in [RFC8709][15]. -To encrypt/decrypt message bodies delivered to the recipients, clients and servers MUST use x25519 or x448 algorithm defined in [RFC8709][15]. +To encrypt/decrypt message bodies delivered to the recipients, servers/clients MUST use x25519 or x448 algorithm defined in [RFC8709][15] to derive the shared secret (TODO encryption scheme). Clients MUST encrypt message bodies sent via SMP servers - the protocol for this end-to-end encryption should be chosen by the clients using SMP protocol. @@ -391,6 +391,8 @@ To keep the transport connection alive and to generate noise traffic the clients ping = %s"PING" ``` +This command is always send unsigned. + ### Recipient commands Sending any of the commands in this section (other than `create`, that is sent without queue ID) is only allowed with recipient's ID (`RID`). If sender's ID is used the server must respond with `"ERR AUTH"` response (see [Error responses](#error-responses)). @@ -401,17 +403,21 @@ This command is sent by the recipient to the SMP server to create a new queue. T ```abnf create = %s"NEW" SP recipientSignaturePublicKey SP recipientDhPublicKey -recipientSignaturePublicKey = signatureKey +recipientSignaturePublicKey = signaturePublicKey ; the recipient's public key to verify commands for this queue -signatureKey = signatureScheme ":" x509encoded + +signaturePublicKey = signatureScheme ":" x509encoded signatureScheme = %s"rsa" | %s"ed25519" | %s"ed448" ; "rsa" means deprecated RSA-PSS signature scheme, ; it must not be used for the new queues. + recipientDhPublicKey = dhPublicKey dhPublicKey = encryptionScheme ":" x509encoded ; the recipient's key for DH exchange to derive the secret ; that the server will use to encrypt delivered message bodies + encryptionScheme = %s"x25519" | %s"x448" +; TODO change to define the encryption scheme, e.g. "crypto_box" x509encoded = ``` @@ -425,16 +431,16 @@ serverSignaturePublicKey = signatureKey ; the server's public key to verify responses and messages for this queue serverDhPublicKey = dhPublicKey ; the server's key for DH exchange to derive the secret -; that the server will use to encrypt delivered message bodies +; that the server will use to encrypt delivered message bodies to the recipient recipientId = encoded senderId = encoded ``` -This response should be sent with empty queue ID (the third part of the transmission). - Once the queue is created, the recipient gets automatically subscribed to receive the messages from that queue, until the transport connection is closed. The `subscribe` command is needed only to start receiving the messages from the existing queue when the new transport connection is opened. -NEW `transmission` must be signed using the `recipientKey` that was passed in the transmission – this verifies that the client has the private key that will be used to sign subsequent commands for this queue. +`NEW` transmission MUST be signed using the private part of the `recipientSignaturePublicKey` – this verifies that the client has the private key that will be used to sign subsequent commands for this queue. + +`IDS` response transmission MUST be sent signed with `serverSignaturePublicKey` – this verifies that the server has the private key that will be used to sign subsequent responses and messages for this queue. This response should be sent with empty queue ID (the third part of the transmission). #### Subscribe to queue @@ -448,13 +454,16 @@ If subscription is successful the server must respond with the first available m The first message will be delivered either immediately or as soon as it is available; to receive the following message the recipient must acknowledge the reception of the message (see [Acknowledge message delivery](#acknowledge-message-delivery)). +This transmission and its response MUST be signed. + #### Secure queue command This command is sent by the recipient to the server to add sender's key to the queue: ```abnf -secure = %s"KEY" SP senderKey -senderKey = signatureScheme ":" x509encoded ; the sender's public key public key to verify SEND command for this queue +secure = %s"KEY" SP senderSignaturePublicKey +senderSignaturePublicKey = signaturePublicKey +; the sender's key to verify SEND commands for this queue ``` `senderKey` is received from the sender as part of the first message - see [Send Message](#send-message) command. From bebd1e5fb903fb30bc248f0dd8e7f05c238e8c2f Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 29 Nov 2021 23:00:09 +0000 Subject: [PATCH 11/13] simplex URI request --- protocol/simplex-uri-request.txt | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 protocol/simplex-uri-request.txt diff --git a/protocol/simplex-uri-request.txt b/protocol/simplex-uri-request.txt new file mode 100644 index 000000000..968757398 --- /dev/null +++ b/protocol/simplex-uri-request.txt @@ -0,0 +1,18 @@ +Scheme name: simplex + +Status: Provisional + +Applications/protocols that use this scheme name: +This scheme is used for connection requests in SimpleX Agent Protocol, +a middle layer protocol for managing bi-directional communication via +redundant unidirectional SimpleX Messaging Protocol queues. + +Contact: Evgeny Poberezkin + +Change controller: Evgeny Poberezkin + +References: +The syntax for connection requests in the latest version of SimpleX Agent Protocol: +https://github.com/simplex-chat/simplexmq/blob/v5/protocol/agent-protocol.md#connection-request +SimpleX Messaging Protocol: +https://github.com/simplex-chat/simplexmq/blob/v5/protocol/simplex-messaging.md From 6bdf4f3ff350b48e0597378bdf0ca1159e036426 Mon Sep 17 00:00:00 2001 From: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> Date: Mon, 6 Dec 2021 18:56:07 +0400 Subject: [PATCH 12/13] change ports for tests (fix for ports now in use on macOS) (#217) --- tests/AgentTests.hs | 2 +- tests/SMPAgentClient.hs | 2 +- tests/SMPClient.hs | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index c2bdc5841..a59888bb6 100644 --- a/tests/AgentTests.hs +++ b/tests/AgentTests.hs @@ -352,7 +352,7 @@ syntaxTests t = do -- TODO: ERROR no connection alias in the response (it does not generate it yet if not provided) -- TODO: add tests with defined connection alias it "using same server as in invitation" $ - ("311", "a", "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2Flocalhost%3A5000%2F1234-w%3D%3D%23&e2e=" <> urlEncode True samplePublicKey <> " 14\nbob's connInfo") >#> ("311", "a", "ERR SMP AUTH") + ("311", "a", "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2Flocalhost%3A5001%2F1234-w%3D%3D%23&e2e=" <> urlEncode True samplePublicKey <> " 14\nbob's connInfo") >#> ("311", "a", "ERR SMP AUTH") describe "invalid" do -- TODO: JOIN is not merged yet - to be added it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX") diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs index 99d2336ce..887ac151c 100644 --- a/tests/SMPAgentClient.hs +++ b/tests/SMPAgentClient.hs @@ -157,7 +157,7 @@ cfg :: AgentConfig cfg = defaultAgentConfig { tcpPort = agentTestPort, - smpServers = L.fromList ["localhost:5000#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="], + smpServers = L.fromList ["localhost:5001#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="], tbqSize = 1, dbFile = testDB, smpCfg = diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index fdd88725b..696de803c 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -32,10 +32,10 @@ testHost :: HostName testHost = "localhost" testPort :: ServiceName -testPort = "5000" +testPort = "5001" testPort2 :: ServiceName -testPort2 = "5001" +testPort2 = "5002" testKeyHashStr :: ByteString testKeyHashStr = "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8=" From f640e71f8276b250154751a8274ee80abb3d5d18 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 10 Dec 2021 12:21:54 +0000 Subject: [PATCH 13/13] remove BlockArguments extension (#220) --- src/Simplex/Messaging/Transport.hs | 3 +-- tests/AgentTests.hs | 21 ++++++++++---------- tests/AgentTests/SQLiteTests.hs | 31 +++++++++++++++--------------- tests/SMPAgentClient.hs | 1 - tests/SMPClient.hs | 1 - tests/ServerTests.hs | 17 ++++++++-------- 6 files changed, 34 insertions(+), 40 deletions(-) diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index 204adb0fa..99c869f46 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} @@ -129,7 +128,7 @@ data ATransport = forall c. Transport c => ATransport (TProxy c) runTransportServer :: (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> (c -> m ()) -> m () runTransportServer started port server = do clients <- newTVarIO S.empty - E.bracket (liftIO $ startTCPServer started port) (liftIO . closeServer clients) \sock -> forever $ do + E.bracket (liftIO $ startTCPServer started port) (liftIO . closeServer clients) $ \sock -> forever $ do c <- liftIO $ acceptConnection sock tid <- forkFinally (server c) (const $ liftIO $ closeConnection c) atomically . modifyTVar clients $ S.insert tid diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index 88feb0196..c9aab3a85 100644 --- a/tests/AgentTests.hs +++ b/tests/AgentTests.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -33,7 +32,7 @@ agentTests (ATransport t) = do describe "Functional API" $ functionalAPITests (ATransport t) describe "SQLite store" storeTests describe "SMP agent protocol syntax" $ syntaxTests t - describe "Establishing duplex connection" do + describe "Establishing duplex connection" $ do it "should connect via one server and one agent" $ smpAgentTest2_1_1 $ testDuplexConnection t it "should connect via one server and one agent (random IDs)" $ @@ -46,19 +45,19 @@ agentTests (ATransport t) = do smpAgentTest2_2_2 $ testDuplexConnection t it "should connect via 2 servers and 2 agents (random IDs)" $ smpAgentTest2_2_2 $ testDuplexConnRandomIds t - describe "Establishing connections via `contact connection`" do + describe "Establishing connections via `contact connection`" $ do it "should connect via contact connection with one server and 3 agents" $ smpAgentTest3 $ testContactConnection t it "should connect via contact connection with one server and 2 agents (random IDs)" $ smpAgentTest2_2_1 $ testContactConnRandomIds t it "should support rejecting contact request" $ smpAgentTest2_2_1 $ testRejectContactRequest t - describe "Connection subscriptions" do + describe "Connection subscriptions" $ do it "should connect via one server and one agent" $ smpAgentTest3_1_1 $ testSubscription t it "should send notifications to client when server disconnects" $ smpAgentServerTest $ testSubscrNotification t - describe "Message delivery" do + describe "Message delivery" $ do it "should deliver messages after losing server connection and re-connecting" $ smpAgentTest2_2_2_needs_server $ testMsgDeliveryServerRestart t it "should deliver pending messages after agent restarting" $ @@ -354,21 +353,21 @@ samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSG syntaxTests :: forall c. Transport c => TProxy c -> Spec syntaxTests t = do it "unknown command" $ ("1", "5678", "HELLO") >#> ("1", "5678", "ERR CMD SYNTAX") - describe "NEW" do - describe "valid" do + describe "NEW" $ do + describe "valid" $ do -- TODO: add tests with defined connection alias it "with correct parameter" $ ("211", "", "NEW INV") >#>= \case ("211", _, "INV" : _) -> True; _ -> False - describe "invalid" do + describe "invalid" $ do -- TODO: add tests with defined connection alias it "with incorrect parameter" $ ("222", "", "NEW hi") >#> ("222", "", "ERR CMD SYNTAX") - describe "JOIN" do - describe "valid" do + describe "JOIN" $ do + describe "valid" $ do -- TODO: ERROR no connection alias in the response (it does not generate it yet if not provided) -- TODO: add tests with defined connection alias it "using same server as in invitation" $ ("311", "a", "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2Flocalhost%3A5001%2F1234-w%3D%3D%23&e2e=" <> urlEncode True samplePublicKey <> " 14\nbob's connInfo") >#> ("311", "a", "ERR SMP AUTH") - describe "invalid" do + describe "invalid" $ do -- TODO: JOIN is not merged yet - to be added it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX") where diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 3e343484d..4662accee 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} @@ -71,42 +70,42 @@ action `throwsError` e = runExceptT action `shouldReturn` Left e -- TODO add null port tests storeTests :: Spec storeTests = do - withStore2 do + withStore2 $ do describe "stress test" testConcurrentWrites - withStore do - describe "store setup" do + withStore $ do + describe "store setup" $ do testCompiledThreadsafe testForeignKeysEnabled - describe "store methods" do - describe "Queue and Connection management" do - describe "createRcvConn" do + describe "store methods" $ do + describe "Queue and Connection management" $ do + describe "createRcvConn" $ do testCreateRcvConn testCreateRcvConnRandomId testCreateRcvConnDuplicate - describe "createSndConn" do + describe "createSndConn" $ do testCreateSndConn testCreateSndConnRandomID testCreateSndConnDuplicate describe "getAllConnIds" testGetAllConnIds describe "getRcvConn" testGetRcvConn - describe "deleteConn" do + describe "deleteConn" $ do testDeleteRcvConn testDeleteSndConn testDeleteDuplexConn - describe "upgradeRcvConnToDuplex" do + describe "upgradeRcvConnToDuplex" $ do testUpgradeRcvConnToDuplex - describe "upgradeSndConnToDuplex" do + describe "upgradeSndConnToDuplex" $ do testUpgradeSndConnToDuplex - describe "set Queue status" do - describe "setRcvQueueStatus" do + describe "set Queue status" $ do + describe "setRcvQueueStatus" $ do testSetRcvQueueStatus testSetRcvQueueStatusNoQueue - describe "setSndQueueStatus" do + describe "setSndQueueStatus" $ do testSetSndQueueStatus testSetSndQueueStatusNoQueue testSetQueueStatusDuplex - describe "Msg management" do - describe "create Msg" do + describe "Msg management" $ do + describe "create Msg" $ do testCreateRcvMsg testCreateSndMsg testCreateRcvAndSndMsgs diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs index c20dc5d11..f4570bbe4 100644 --- a/tests/SMPAgentClient.hs +++ b/tests/SMPAgentClient.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index 696de803c..c080641ae 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NumericUnderscores #-} diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 922636b36..5c4a2e6e8 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -31,10 +30,10 @@ rsaKeySize = 2048 `div` 8 serverTests :: ATransport -> Spec serverTests t = do describe "SMP syntax" $ syntaxTests t - describe "SMP queues" do + describe "SMP queues" $ do describe "NEW and KEY commands, SEND messages" $ testCreateSecure t describe "NEW, OFF and DEL commands, SEND messages" $ testCreateDelete t - describe "SMP messages" do + describe "SMP messages" $ do describe "duplex communication over 2 SMP connections" $ testDuplex t describe "switch subscription to another SMP queue" $ testSwitchSub t describe "Store log" $ testWithStoreLog t @@ -445,12 +444,12 @@ sampleSig = "gM8qn2Vx3GkhIp2hgrji9uhfXKpgtKDmc0maxdP8GvbORUxMCTlLG8Q/gNcl3pQVOzm syntaxTests :: ATransport -> Spec syntaxTests (ATransport t) = do it "unknown command" $ ("", "abcd", "1234", "HELLO") >#> ("", "abcd", "1234", "ERR CMD SYNTAX") - describe "NEW" do + describe "NEW" $ do 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" $ (sampleSig, "abcd", "12345678", "NEW " <> samplePubKey) >#> ("", "abcd", "12345678", "ERR CMD HAS_AUTH") - describe "KEY" do + describe "KEY" $ do 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") @@ -460,7 +459,7 @@ syntaxTests (ATransport t) = do noParamsSyntaxTest "ACK" noParamsSyntaxTest "OFF" noParamsSyntaxTest "DEL" - describe "SEND" do + describe "SEND" $ do 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") @@ -468,13 +467,13 @@ syntaxTests (ATransport t) = do 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 + describe "PING" $ do it "valid syntax" $ ("", "abcd", "", "PING") >#> ("", "abcd", "", "PONG") - describe "broker response not allowed" do + describe "broker response not allowed" $ do it "OK" $ (sampleSig, "bcda", "12345678", "OK") >#> ("", "bcda", "12345678", "ERR CMD PROHIBITED") where noParamsSyntaxTest :: ByteString -> Spec - noParamsSyntaxTest cmd = describe (B.unpack cmd) do + noParamsSyntaxTest cmd = describe (B.unpack cmd) $ do 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")