ntf: separate types into their own module (#444)

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

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

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)

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 (..))

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

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)

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
-    }

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
+    }