From 9695786aa54d11f1103b34f3014db23accc142cd Mon Sep 17 00:00:00 2001 From: JRoberts <8711996+jr-simplex@users.noreply.github.com> Date: Thu, 30 Jun 2022 14:31:36 +0400 Subject: [PATCH] ntf: separate types into their own module (#444) --- simplexmq.cabal | 1 + src/Simplex/Messaging/Agent.hs | 2 +- src/Simplex/Messaging/Agent/Client.hs | 1 + src/Simplex/Messaging/Agent/Env/SQLite.hs | 3 +- .../Messaging/Agent/NtfSubSupervisor.hs | 2 +- src/Simplex/Messaging/Agent/Store/SQLite.hs | 2 +- src/Simplex/Messaging/Notifications/Client.hs | 193 ---------------- src/Simplex/Messaging/Notifications/Types.hs | 215 ++++++++++++++++++ 8 files changed, 221 insertions(+), 198 deletions(-) create mode 100644 src/Simplex/Messaging/Notifications/Types.hs diff --git a/simplexmq.cabal b/simplexmq.cabal index a471a2e10..977d122e0 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -64,6 +64,7 @@ library Simplex.Messaging.Notifications.Server.Store Simplex.Messaging.Notifications.Server.StoreLog Simplex.Messaging.Notifications.Transport + Simplex.Messaging.Notifications.Types Simplex.Messaging.Parsers Simplex.Messaging.Protocol Simplex.Messaging.Server diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 001d551b0..f6b42d91a 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -96,9 +96,9 @@ import qualified Simplex.Messaging.Crypto as C import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String (StrEncoding (..)) -import Simplex.Messaging.Notifications.Client import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId) import Simplex.Messaging.Notifications.Server.Push.APNS (PNMessageData (..)) +import Simplex.Messaging.Notifications.Types import Simplex.Messaging.Parsers (parse) import Simplex.Messaging.Protocol (BrokerMsg, ErrorType (AUTH), MsgBody, MsgFlags, SMPMsgMeta) import qualified Simplex.Messaging.Protocol as SMP diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index cc7e38026..7f7038be7 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -94,6 +94,7 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding import Simplex.Messaging.Notifications.Client import Simplex.Messaging.Notifications.Protocol +import Simplex.Messaging.Notifications.Types import Simplex.Messaging.Protocol (BrokerMsg, ErrorType, MsgFlags (..), MsgId, NotifierId, NtfPrivateSignKey, NtfPublicVerifyKey, ProtocolServer (..), QueueId, QueueIdsKeys (..), RcvNtfPublicDhKey, SMPMsgMeta, SndPublicVerifyKey) import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.TMap (TMap) diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index 469f543e8..ae31dc4b9 100644 --- a/src/Simplex/Messaging/Agent/Env/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs @@ -3,7 +3,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE RankNTypes #-} @@ -39,7 +38,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations import Simplex.Messaging.Client import Simplex.Messaging.Client.Agent () import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Notifications.Client (NtfServer, NtfToken) +import Simplex.Messaging.Notifications.Types import Simplex.Messaging.TMap (TMap) import qualified Simplex.Messaging.TMap as TM import Simplex.Messaging.Transport (TLS, Transport (..)) diff --git a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs index 76911ef13..f760bfcf7 100644 --- a/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs +++ b/src/Simplex/Messaging/Agent/NtfSubSupervisor.hs @@ -35,8 +35,8 @@ import Simplex.Messaging.Agent.Store import Simplex.Messaging.Agent.Store.SQLite import Simplex.Messaging.Client.Agent () import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Notifications.Client import Simplex.Messaging.Notifications.Protocol (NtfSubStatus (..), NtfTknStatus (..), SMPQueueNtf (..)) +import Simplex.Messaging.Notifications.Types import Simplex.Messaging.Protocol import Simplex.Messaging.TMap (TMap) import qualified Simplex.Messaging.TMap as TM diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 3a4d7319e..b71cfa8eb 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -123,7 +123,7 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet (RatchetX448, SkippedMsgDiff (..), SkippedMsgKeys) import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Notifications.Client +import Simplex.Messaging.Notifications.Types import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfSubscriptionId, NtfTknStatus (..), NtfTokenId, SMPQueueNtf (..)) import Simplex.Messaging.Parsers (blobFieldParser, fromTextField_) import Simplex.Messaging.Protocol (MsgBody, MsgFlags, ProtocolServer (..), RcvNtfDhSecret) diff --git a/src/Simplex/Messaging/Notifications/Client.hs b/src/Simplex/Messaging/Notifications/Client.hs index 2e8577cce..51487a618 100644 --- a/src/Simplex/Messaging/Notifications/Client.hs +++ b/src/Simplex/Messaging/Notifications/Client.hs @@ -1,29 +1,15 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} module Simplex.Messaging.Notifications.Client where import Control.Monad.Except import Control.Monad.Trans.Except -import qualified Data.Attoparsec.ByteString.Char8 as A -import Data.Text.Encoding (decodeLatin1, encodeUtf8) -import Data.Time (UTCTime) import Data.Word (Word16) -import Database.SQLite.Simple.FromField (FromField (..)) -import Database.SQLite.Simple.ToField (ToField (..)) -import Simplex.Messaging.Agent.Protocol (ConnId, NotificationsMode (..)) import Simplex.Messaging.Client import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Encoding import Simplex.Messaging.Notifications.Protocol -import Simplex.Messaging.Parsers (blobFieldDecoder, fromTextField_) -import Simplex.Messaging.Protocol (NotifierId, ProtocolServer, SMPServer) - -type NtfServer = ProtocolServer type NtfClient = ProtocolClient NtfResponse @@ -75,182 +61,3 @@ okNtfCommand cmd c pKey entId = sendNtfCommand c (Just pKey) entId cmd >>= \case NROk -> return () _ -> throwE PCEUnexpectedResponse - -data NtfTknAction - = NTARegister - | NTAVerify NtfRegCode -- code to verify token - | NTACheck - | NTADelete - deriving (Show) - -instance Encoding NtfTknAction where - smpEncode = \case - NTARegister -> "R" - NTAVerify code -> smpEncode ('V', code) - NTACheck -> "C" - NTADelete -> "D" - smpP = - A.anyChar >>= \case - 'R' -> pure NTARegister - 'V' -> NTAVerify <$> smpP - 'C' -> pure NTACheck - 'D' -> pure NTADelete - _ -> fail "bad NtfTknAction" - -instance FromField NtfTknAction where fromField = blobFieldDecoder smpDecode - -instance ToField NtfTknAction where toField = toField . smpEncode - -data NtfToken = NtfToken - { deviceToken :: DeviceToken, - ntfServer :: NtfServer, - ntfTokenId :: Maybe NtfTokenId, - -- | key used by the ntf server to verify transmissions - ntfPubKey :: C.APublicVerifyKey, - -- | key used by the ntf client to sign transmissions - ntfPrivKey :: C.APrivateSignKey, - -- | client's DH keys (to repeat registration if necessary) - ntfDhKeys :: C.KeyPair 'C.X25519, - -- | shared DH secret used to encrypt/decrypt notifications e2e - ntfDhSecret :: Maybe C.DhSecretX25519, - -- | token status - ntfTknStatus :: NtfTknStatus, - -- | pending token action and the earliest time - ntfTknAction :: Maybe NtfTknAction, - ntfMode :: NotificationsMode - } - deriving (Show) - -newNtfToken :: DeviceToken -> NtfServer -> C.ASignatureKeyPair -> C.KeyPair 'C.X25519 -> NotificationsMode -> NtfToken -newNtfToken deviceToken ntfServer (ntfPubKey, ntfPrivKey) ntfDhKeys ntfMode = - NtfToken - { deviceToken, - ntfServer, - ntfTokenId = Nothing, - ntfPubKey, - ntfPrivKey, - ntfDhKeys, - ntfDhSecret = Nothing, - ntfTknStatus = NTNew, - ntfTknAction = Just NTARegister, - ntfMode - } - -data NtfSubAction = NtfSubNTFAction NtfSubNTFAction | NtfSubSMPAction NtfSubSMPAction - -data NtfSubActionData = NtfSubActionData - { action :: NtfSubAction, - actionTs :: UTCTime, - ntfSubscription :: NtfSubscription - } - -data NtfSubNTFActionData = NtfSubNTFActionData - { ntfAction :: NtfSubNTFAction, - actionTs :: UTCTime, - ntfSubscription :: NtfSubscription - } - -data NtfSubNTFAction - = NSACreate - | NSACheck - | NSADelete - deriving (Show) - -instance Encoding NtfSubNTFAction where - smpEncode = \case - NSACreate -> "N" - NSACheck -> "C" - NSADelete -> "D" - smpP = - A.anyChar >>= \case - 'N' -> pure NSACreate - 'C' -> pure NSACheck - 'D' -> pure NSADelete - _ -> fail "bad NtfSubNTFAction" - -instance FromField NtfSubNTFAction where fromField = blobFieldDecoder smpDecode - -instance ToField NtfSubNTFAction where toField = toField . smpEncode - -data NtfSubSMPActionData = NtfSubSMPActionData - { smpAction :: NtfSubSMPAction, - actionTs :: UTCTime, - ntfSubscription :: NtfSubscription - } - -data NtfSubSMPAction - = NSASmpKey - | NSASmpDelete - deriving (Show) - -instance Encoding NtfSubSMPAction where - smpEncode = \case - NSASmpKey -> "K" - NSASmpDelete -> "D" - smpP = - A.anyChar >>= \case - 'K' -> pure NSASmpKey - 'D' -> pure NSASmpDelete - _ -> fail "bad NtfSubSMPAction" - -instance FromField NtfSubSMPAction where fromField = blobFieldDecoder smpDecode - -instance ToField NtfSubSMPAction where toField = toField . smpEncode - -data NtfAgentSubStatus - = -- | subscription started - NASNew - | -- | state after NKEY - notifier ID is assigned to queue on SMP server - NASKey - | -- | state after SNEW - subscription created on notification server - NASCreated NtfSubStatus - | -- | state after SDEL (subscription is deleted on notification server) - NASOff - | -- | state after NDEL (notifier credentials are deleted on SMP server) - -- Can only exist transiently - if subscription record was updated by notification supervisor mid worker operation, - -- and hence got updated instead of being fully deleted in the database post operation by worker - NASDeleted - deriving (Eq, Show) - -instance Encoding NtfAgentSubStatus where - smpEncode = \case - NASNew -> "NEW" - NASKey -> "KEY" - NASCreated status -> "CREATED " <> smpEncode status - NASOff -> "OFF" - NASDeleted -> "DELETED" - smpP = - A.takeTill (== ' ') >>= \case - "NEW" -> pure NASNew - "KEY" -> pure NASKey - "CREATED" -> do - _ <- A.space - NASCreated <$> smpP - "OFF" -> pure NASOff - "DELETED" -> pure NASDeleted - _ -> fail "bad NtfAgentSubStatus" - -instance FromField NtfAgentSubStatus where fromField = fromTextField_ $ either (const Nothing) Just . smpDecode . encodeUtf8 - -instance ToField NtfAgentSubStatus where toField = toField . decodeLatin1 . smpEncode - -data NtfSubscription = NtfSubscription - { connId :: ConnId, - smpServer :: SMPServer, - ntfQueueId :: Maybe NotifierId, - ntfServer :: NtfServer, - ntfSubId :: Maybe NtfSubscriptionId, - ntfSubStatus :: NtfAgentSubStatus - } - deriving (Show) - -newNtfSubscription :: ConnId -> SMPServer -> Maybe NotifierId -> NtfServer -> NtfAgentSubStatus -> NtfSubscription -newNtfSubscription connId smpServer ntfQueueId ntfServer ntfSubStatus = - NtfSubscription - { connId, - smpServer, - ntfQueueId, - ntfServer, - ntfSubId = Nothing, - ntfSubStatus - } diff --git a/src/Simplex/Messaging/Notifications/Types.hs b/src/Simplex/Messaging/Notifications/Types.hs new file mode 100644 index 000000000..69d4e30e9 --- /dev/null +++ b/src/Simplex/Messaging/Notifications/Types.hs @@ -0,0 +1,215 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Simplex.Messaging.Notifications.Types + ( NtfServer, + NtfTknAction (..), + NtfToken (..), + newNtfToken, + NtfSubAction (..), + NtfSubActionData (..), + NtfSubNTFActionData (..), + NtfSubNTFAction (..), + NtfSubSMPActionData (..), + NtfSubSMPAction (..), + NtfAgentSubStatus (..), + NtfSubscription (..), + newNtfSubscription, + ) +where + +import qualified Data.Attoparsec.ByteString.Char8 as A +import Data.Text.Encoding (decodeLatin1, encodeUtf8) +import Data.Time (UTCTime) +import Database.SQLite.Simple.FromField (FromField (..)) +import Database.SQLite.Simple.ToField (ToField (..)) +import Simplex.Messaging.Agent.Protocol (ConnId, NotificationsMode (..)) +import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Encoding +import Simplex.Messaging.Notifications.Protocol +import Simplex.Messaging.Parsers (blobFieldDecoder, fromTextField_) +import Simplex.Messaging.Protocol (NotifierId, ProtocolServer, SMPServer) + +type NtfServer = ProtocolServer + +data NtfTknAction + = NTARegister + | NTAVerify NtfRegCode -- code to verify token + | NTACheck + | NTADelete + deriving (Show) + +instance Encoding NtfTknAction where + smpEncode = \case + NTARegister -> "R" + NTAVerify code -> smpEncode ('V', code) + NTACheck -> "C" + NTADelete -> "D" + smpP = + A.anyChar >>= \case + 'R' -> pure NTARegister + 'V' -> NTAVerify <$> smpP + 'C' -> pure NTACheck + 'D' -> pure NTADelete + _ -> fail "bad NtfTknAction" + +instance FromField NtfTknAction where fromField = blobFieldDecoder smpDecode + +instance ToField NtfTknAction where toField = toField . smpEncode + +data NtfToken = NtfToken + { deviceToken :: DeviceToken, + ntfServer :: NtfServer, + ntfTokenId :: Maybe NtfTokenId, + -- | key used by the ntf server to verify transmissions + ntfPubKey :: C.APublicVerifyKey, + -- | key used by the ntf client to sign transmissions + ntfPrivKey :: C.APrivateSignKey, + -- | client's DH keys (to repeat registration if necessary) + ntfDhKeys :: C.KeyPair 'C.X25519, + -- | shared DH secret used to encrypt/decrypt notifications e2e + ntfDhSecret :: Maybe C.DhSecretX25519, + -- | token status + ntfTknStatus :: NtfTknStatus, + -- | pending token action and the earliest time + ntfTknAction :: Maybe NtfTknAction, + ntfMode :: NotificationsMode + } + deriving (Show) + +newNtfToken :: DeviceToken -> NtfServer -> C.ASignatureKeyPair -> C.KeyPair 'C.X25519 -> NotificationsMode -> NtfToken +newNtfToken deviceToken ntfServer (ntfPubKey, ntfPrivKey) ntfDhKeys ntfMode = + NtfToken + { deviceToken, + ntfServer, + ntfTokenId = Nothing, + ntfPubKey, + ntfPrivKey, + ntfDhKeys, + ntfDhSecret = Nothing, + ntfTknStatus = NTNew, + ntfTknAction = Just NTARegister, + ntfMode + } + +data NtfSubAction = NtfSubNTFAction NtfSubNTFAction | NtfSubSMPAction NtfSubSMPAction + +data NtfSubActionData = NtfSubActionData + { action :: NtfSubAction, + actionTs :: UTCTime, + ntfSubscription :: NtfSubscription + } + +data NtfSubNTFActionData = NtfSubNTFActionData + { ntfAction :: NtfSubNTFAction, + actionTs :: UTCTime, + ntfSubscription :: NtfSubscription + } + +data NtfSubNTFAction + = NSACreate + | NSACheck + | NSADelete + deriving (Show) + +instance Encoding NtfSubNTFAction where + smpEncode = \case + NSACreate -> "N" + NSACheck -> "C" + NSADelete -> "D" + smpP = + A.anyChar >>= \case + 'N' -> pure NSACreate + 'C' -> pure NSACheck + 'D' -> pure NSADelete + _ -> fail "bad NtfSubNTFAction" + +instance FromField NtfSubNTFAction where fromField = blobFieldDecoder smpDecode + +instance ToField NtfSubNTFAction where toField = toField . smpEncode + +data NtfSubSMPActionData = NtfSubSMPActionData + { smpAction :: NtfSubSMPAction, + actionTs :: UTCTime, + ntfSubscription :: NtfSubscription + } + +data NtfSubSMPAction + = NSASmpKey + | NSASmpDelete + deriving (Show) + +instance Encoding NtfSubSMPAction where + smpEncode = \case + NSASmpKey -> "K" + NSASmpDelete -> "D" + smpP = + A.anyChar >>= \case + 'K' -> pure NSASmpKey + 'D' -> pure NSASmpDelete + _ -> fail "bad NtfSubSMPAction" + +instance FromField NtfSubSMPAction where fromField = blobFieldDecoder smpDecode + +instance ToField NtfSubSMPAction where toField = toField . smpEncode + +data NtfAgentSubStatus + = -- | subscription started + NASNew + | -- | state after NKEY - notifier ID is assigned to queue on SMP server + NASKey + | -- | state after SNEW - subscription created on notification server + NASCreated NtfSubStatus + | -- | state after SDEL (subscription is deleted on notification server) + NASOff + | -- | state after NDEL (notifier credentials are deleted on SMP server) + -- Can only exist transiently - if subscription record was updated by notification supervisor mid worker operation, + -- and hence got updated instead of being fully deleted in the database post operation by worker + NASDeleted + deriving (Eq, Show) + +instance Encoding NtfAgentSubStatus where + smpEncode = \case + NASNew -> "NEW" + NASKey -> "KEY" + NASCreated status -> "CREATED " <> smpEncode status + NASOff -> "OFF" + NASDeleted -> "DELETED" + smpP = + A.takeTill (== ' ') >>= \case + "NEW" -> pure NASNew + "KEY" -> pure NASKey + "CREATED" -> do + _ <- A.space + NASCreated <$> smpP + "OFF" -> pure NASOff + "DELETED" -> pure NASDeleted + _ -> fail "bad NtfAgentSubStatus" + +instance FromField NtfAgentSubStatus where fromField = fromTextField_ $ either (const Nothing) Just . smpDecode . encodeUtf8 + +instance ToField NtfAgentSubStatus where toField = toField . decodeLatin1 . smpEncode + +data NtfSubscription = NtfSubscription + { connId :: ConnId, + smpServer :: SMPServer, + ntfQueueId :: Maybe NotifierId, + ntfServer :: NtfServer, + ntfSubId :: Maybe NtfSubscriptionId, + ntfSubStatus :: NtfAgentSubStatus + } + deriving (Show) + +newNtfSubscription :: ConnId -> SMPServer -> Maybe NotifierId -> NtfServer -> NtfAgentSubStatus -> NtfSubscription +newNtfSubscription connId smpServer ntfQueueId ntfServer ntfSubStatus = + NtfSubscription + { connId, + smpServer, + ntfQueueId, + ntfServer, + ntfSubId = Nothing, + ntfSubStatus + } \ No newline at end of file