{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}

module Simplex.Messaging.Agent.Store
  ( RcvQueue,
    NewRcvQueue,
    StoredRcvQueue (..),
    RcvQueueSub (..),
    ClientNtfCreds (..),
    InvShortLink (..),
    SndQueue,
    NewSndQueue,
    StoredSndQueue (..),
    SMPQueueRec (..),
    SomeRcvQueue (..),
    ConnType (..),
    Connection' (..),
    Connection,
    SConnType (..),
    SomeConn' (..),
    SomeConn,
    SomeConnSub,
    ConnData (..),
    NoticeId,
    PendingCommand (..),
    AgentCmdType (..),
    AgentCommand (..),
    AgentCommandTag (..),
    InternalCommand (..),
    InternalCommandTag (..),
    NewConfirmation (..),
    AcceptedConfirmation (..),
    NewInvitation (..),
    Invitation (..),
    PrevExternalSndId,
    PrevRcvMsgHash,
    PrevSndMsgHash,
    RcvMsgData (..),
    RcvMsg (..),
    SndMsgData (..),
    SndMsgPrepData (..),
    SndMsg (..),
    PendingMsgData (..),
    PendingMsgPrepData (..),
    InternalRcvId (..),
    ExternalSndId,
    ExternalSndTs,
    BrokerId,
    BrokerTs,
    InternalSndId (..),
    MsgBase (..),
    InternalId (..),
    InternalTs,
    AsyncCmdId,
    StoreError (..),
    AnyStoreError (..),
    createStore,
    rcvQueueSub,
    clientServiceId,
    rcvSMPQueueAddress,
    canAbortRcvSwitch,
    findQ,
    removeQ,
    removeQP,
    sndAddress,
    findRQ,
    switchingRQ,
    updatedQs,
    toConnData,
    updateConnection,
    connType,
    ratchetSyncAllowed,
    ratchetSyncSendProhibited,
    agentCommandTag,
    internalCmdTag,
  ) where

import Control.Exception (Exception (..))
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Char8 (ByteString)
import Data.Int (Int64)
import Data.Kind (Type)
import Data.List (find)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as L
import Data.Maybe (isJust)
import Data.Time (UTCTime)
import Data.Type.Equality
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.RetryInterval (RI2State)
import Simplex.Messaging.Agent.Store.Entity
import Simplex.Messaging.Agent.Store.Common
import Simplex.Messaging.Agent.Store.DB (SQLError)
import Simplex.Messaging.Agent.Store.Interface (createDBStore)
import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations)
import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (MsgEncryptKeyX448, PQEncryption, PQSupport, RatchetX448)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol
  ( MsgBody,
    MsgFlags,
    MsgId,
    NotifierId,
    NtfPrivateAuthKey,
    NtfPublicAuthKey,
    QueueMode,
    RcvDhSecret,
    RcvNtfDhSecret,
    RcvPrivateAuthKey,
    SndPrivateAuthKey,
    VersionSMPC,
  )
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Util (AnyError (..), bshow)

createStore :: DBOpts -> MigrationConfig -> IO (Either MigrationError DBStore)
createStore :: DBOpts -> MigrationConfig -> IO (Either MigrationError DBStore)
createStore DBOpts
dbOpts = DBOpts
-> [Migration]
-> MigrationConfig
-> IO (Either MigrationError DBStore)
createDBStore DBOpts
dbOpts [Migration]
appMigrations

-- * Queue types

type RcvQueue = StoredRcvQueue 'DBStored

type NewRcvQueue = StoredRcvQueue 'DBNew

-- | A receive queue. SMP queue through which the agent receives messages from a sender.
data StoredRcvQueue (q :: DBStored) = RcvQueue
  { forall (q :: DBStored). StoredRcvQueue q -> UserId
userId :: UserId,
    forall (q :: DBStored). StoredRcvQueue q -> ConnId
connId :: ConnId,
    forall (q :: DBStored). StoredRcvQueue q -> SMPServer
server :: SMPServer,
    -- | recipient queue ID
    forall (q :: DBStored). StoredRcvQueue q -> RecipientId
rcvId :: SMP.RecipientId,
    -- | key used by the recipient to authorize transmissions
    forall (q :: DBStored). StoredRcvQueue q -> RcvPrivateAuthKey
rcvPrivateKey :: RcvPrivateAuthKey,
    -- | shared DH secret used to encrypt/decrypt message bodies from server to recipient
    forall (q :: DBStored). StoredRcvQueue q -> RcvDhSecret
rcvDhSecret :: RcvDhSecret,
    -- | private DH key related to public sent to sender out-of-band (to agree simple per-queue e2e)
    forall (q :: DBStored). StoredRcvQueue q -> PrivateKeyX25519
e2ePrivKey :: C.PrivateKeyX25519,
    -- | public sender's DH key and agreed shared DH secret for simple per-queue e2e
    forall (q :: DBStored). StoredRcvQueue q -> Maybe RcvDhSecret
e2eDhSecret :: Maybe C.DhSecretX25519,
    -- | sender queue ID
    forall (q :: DBStored). StoredRcvQueue q -> RecipientId
sndId :: SMP.SenderId,
    -- | sender can secure the queue
    forall (q :: DBStored). StoredRcvQueue q -> Maybe QueueMode
queueMode :: Maybe QueueMode,
    -- | short link ID and credentials
    forall (q :: DBStored). StoredRcvQueue q -> Maybe ShortLinkCreds
shortLink :: Maybe ShortLinkCreds,
    -- | associated client service
    forall (q :: DBStored).
StoredRcvQueue q -> Maybe (StoredClientService q)
clientService :: Maybe (StoredClientService q),
    -- | queue status
    forall (q :: DBStored). StoredRcvQueue q -> QueueStatus
status :: QueueStatus,
    -- | to enable notifications for this queue - this field is duplicated from ConnData
    forall (q :: DBStored). StoredRcvQueue q -> Bool
enableNtfs :: Bool,
    -- | client notice
    forall (q :: DBStored). StoredRcvQueue q -> Maybe UserId
clientNoticeId :: Maybe NoticeId,
    -- | database queue ID (within connection)
    forall (q :: DBStored). StoredRcvQueue q -> DBEntityId' q
dbQueueId :: DBEntityId' q,
    -- | True for a primary or a next primary queue of the connection (next if dbReplaceQueueId is set)
    forall (q :: DBStored). StoredRcvQueue q -> Bool
primary :: Bool,
    -- | database queue ID to replace, Nothing if this queue is not replacing another, `Just Nothing` is used for replacing old queues
    forall (q :: DBStored). StoredRcvQueue q -> Maybe UserId
dbReplaceQueueId :: Maybe Int64,
    forall (q :: DBStored). StoredRcvQueue q -> Maybe RcvSwitchStatus
rcvSwchStatus :: Maybe RcvSwitchStatus,
    -- | SMP client version
    forall (q :: DBStored). StoredRcvQueue q -> VersionSMPC
smpClientVersion :: VersionSMPC,
    -- | credentials used in context of notifications
    forall (q :: DBStored). StoredRcvQueue q -> Maybe ClientNtfCreds
clientNtfCreds :: Maybe ClientNtfCreds,
    forall (q :: DBStored). StoredRcvQueue q -> Int
deleteErrors :: Int
  }
  deriving (Int -> StoredRcvQueue q -> ShowS
[StoredRcvQueue q] -> ShowS
StoredRcvQueue q -> String
(Int -> StoredRcvQueue q -> ShowS)
-> (StoredRcvQueue q -> String)
-> ([StoredRcvQueue q] -> ShowS)
-> Show (StoredRcvQueue q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (q :: DBStored). Int -> StoredRcvQueue q -> ShowS
forall (q :: DBStored). [StoredRcvQueue q] -> ShowS
forall (q :: DBStored). StoredRcvQueue q -> String
$cshowsPrec :: forall (q :: DBStored). Int -> StoredRcvQueue q -> ShowS
showsPrec :: Int -> StoredRcvQueue q -> ShowS
$cshow :: forall (q :: DBStored). StoredRcvQueue q -> String
show :: StoredRcvQueue q -> String
$cshowList :: forall (q :: DBStored). [StoredRcvQueue q] -> ShowS
showList :: [StoredRcvQueue q] -> ShowS
Show)

data RcvQueueSub = RcvQueueSub
  { RcvQueueSub -> UserId
userId :: UserId,
    RcvQueueSub -> ConnId
connId :: ConnId,
    RcvQueueSub -> SMPServer
server :: SMPServer,
    RcvQueueSub -> RecipientId
rcvId :: SMP.RecipientId,
    RcvQueueSub -> RcvPrivateAuthKey
rcvPrivateKey :: RcvPrivateAuthKey,
    RcvQueueSub -> QueueStatus
status :: QueueStatus,
    RcvQueueSub -> Bool
enableNtfs :: Bool,
    RcvQueueSub -> Maybe UserId
clientNoticeId :: Maybe NoticeId,
    RcvQueueSub -> UserId
dbQueueId :: Int64,
    RcvQueueSub -> Bool
primary :: Bool,
    RcvQueueSub -> Maybe UserId
dbReplaceQueueId :: Maybe Int64
  }
  deriving (Int -> RcvQueueSub -> ShowS
[RcvQueueSub] -> ShowS
RcvQueueSub -> String
(Int -> RcvQueueSub -> ShowS)
-> (RcvQueueSub -> String)
-> ([RcvQueueSub] -> ShowS)
-> Show RcvQueueSub
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RcvQueueSub -> ShowS
showsPrec :: Int -> RcvQueueSub -> ShowS
$cshow :: RcvQueueSub -> String
show :: RcvQueueSub -> String
$cshowList :: [RcvQueueSub] -> ShowS
showList :: [RcvQueueSub] -> ShowS
Show)

rcvQueueSub :: RcvQueue -> RcvQueueSub
rcvQueueSub :: RcvQueue -> RcvQueueSub
rcvQueueSub RcvQueue {UserId
$sel:userId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> UserId
userId :: UserId
userId, ConnId
$sel:connId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> ConnId
connId :: ConnId
connId, SMPServer
$sel:server:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SMPServer
server :: SMPServer
server, RecipientId
$sel:rcvId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> RecipientId
rcvId :: RecipientId
rcvId, RcvPrivateAuthKey
$sel:rcvPrivateKey:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> RcvPrivateAuthKey
rcvPrivateKey :: RcvPrivateAuthKey
rcvPrivateKey, QueueStatus
$sel:status:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> QueueStatus
status :: QueueStatus
status, Bool
$sel:enableNtfs:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Bool
enableNtfs :: Bool
enableNtfs, Maybe UserId
$sel:clientNoticeId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Maybe UserId
clientNoticeId :: Maybe UserId
clientNoticeId, $sel:dbQueueId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> DBEntityId' q
dbQueueId = DBEntityId UserId
dbQueueId, Bool
$sel:primary:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Bool
primary :: Bool
primary, Maybe UserId
$sel:dbReplaceQueueId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Maybe UserId
dbReplaceQueueId :: Maybe UserId
dbReplaceQueueId} =
  RcvQueueSub {UserId
$sel:userId:RcvQueueSub :: UserId
userId :: UserId
userId, ConnId
$sel:connId:RcvQueueSub :: ConnId
connId :: ConnId
connId, SMPServer
$sel:server:RcvQueueSub :: SMPServer
server :: SMPServer
server, RecipientId
$sel:rcvId:RcvQueueSub :: RecipientId
rcvId :: RecipientId
rcvId, RcvPrivateAuthKey
$sel:rcvPrivateKey:RcvQueueSub :: RcvPrivateAuthKey
rcvPrivateKey :: RcvPrivateAuthKey
rcvPrivateKey, QueueStatus
$sel:status:RcvQueueSub :: QueueStatus
status :: QueueStatus
status, Bool
$sel:enableNtfs:RcvQueueSub :: Bool
enableNtfs :: Bool
enableNtfs, Maybe UserId
$sel:clientNoticeId:RcvQueueSub :: Maybe UserId
clientNoticeId :: Maybe UserId
clientNoticeId, UserId
$sel:dbQueueId:RcvQueueSub :: UserId
dbQueueId :: UserId
dbQueueId, Bool
$sel:primary:RcvQueueSub :: Bool
primary :: Bool
primary, Maybe UserId
$sel:dbReplaceQueueId:RcvQueueSub :: Maybe UserId
dbReplaceQueueId :: Maybe UserId
dbReplaceQueueId}

clientServiceId :: RcvQueue -> Maybe ClientServiceId
clientServiceId :: RcvQueue -> Maybe (DBEntityId' 'DBStored)
clientServiceId = (StoredClientService 'DBStored -> DBEntityId' 'DBStored)
-> Maybe (StoredClientService 'DBStored)
-> Maybe (DBEntityId' 'DBStored)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StoredClientService 'DBStored -> DBEntityId' 'DBStored
forall (s :: DBStored). StoredClientService s -> DBEntityId' s
dbServiceId (Maybe (StoredClientService 'DBStored)
 -> Maybe (DBEntityId' 'DBStored))
-> (RcvQueue -> Maybe (StoredClientService 'DBStored))
-> RcvQueue
-> Maybe (DBEntityId' 'DBStored)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RcvQueue -> Maybe (StoredClientService 'DBStored)
forall (q :: DBStored).
StoredRcvQueue q -> Maybe (StoredClientService q)
clientService
{-# INLINE clientServiceId #-}

rcvSMPQueueAddress :: RcvQueue -> SMPQueueAddress
rcvSMPQueueAddress :: RcvQueue -> SMPQueueAddress
rcvSMPQueueAddress RcvQueue {SMPServer
$sel:server:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SMPServer
server :: SMPServer
server, RecipientId
$sel:sndId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> RecipientId
sndId :: RecipientId
sndId, PrivateKeyX25519
$sel:e2ePrivKey:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> PrivateKeyX25519
e2ePrivKey :: PrivateKeyX25519
e2ePrivKey, Maybe QueueMode
$sel:queueMode:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Maybe QueueMode
queueMode :: Maybe QueueMode
queueMode} =
  SMPServer
-> RecipientId
-> PublicKeyX25519
-> Maybe QueueMode
-> SMPQueueAddress
SMPQueueAddress SMPServer
server RecipientId
sndId (PrivateKeyX25519 -> PublicKeyX25519
forall (a :: Algorithm). PrivateKey a -> PublicKey a
C.publicKey PrivateKeyX25519
e2ePrivKey) Maybe QueueMode
queueMode

canAbortRcvSwitch :: RcvQueue -> Bool
canAbortRcvSwitch :: RcvQueue -> Bool
canAbortRcvSwitch = Bool -> (RcvSwitchStatus -> Bool) -> Maybe RcvSwitchStatus -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False RcvSwitchStatus -> Bool
canAbort (Maybe RcvSwitchStatus -> Bool)
-> (RcvQueue -> Maybe RcvSwitchStatus) -> RcvQueue -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RcvQueue -> Maybe RcvSwitchStatus
forall (q :: DBStored). StoredRcvQueue q -> Maybe RcvSwitchStatus
rcvSwchStatus
  where
    canAbort :: RcvSwitchStatus -> Bool
canAbort = \case
      RcvSwitchStatus
RSSwitchStarted -> Bool
True
      RcvSwitchStatus
RSSendingQADD -> Bool
True
      -- if switch is in RSSendingQUSE, a race condition with sender deleting the original queue is possible
      RcvSwitchStatus
RSSendingQUSE -> Bool
False
      -- if switch is in RSReceivedMessage status, aborting switch (deleting new queue)
      -- will break the connection because the sender would have original queue deleted
      RcvSwitchStatus
RSReceivedMessage -> Bool
False

data ClientNtfCreds = ClientNtfCreds
  { -- | key pair to be used by the notification server to authorize transmissions
    ClientNtfCreds -> NtfPublicAuthKey
ntfPublicKey :: NtfPublicAuthKey,
    ClientNtfCreds -> RcvPrivateAuthKey
ntfPrivateKey :: NtfPrivateAuthKey,
    -- | queue ID to be used by the notification server for NSUB command
    ClientNtfCreds -> RecipientId
notifierId :: NotifierId,
    -- | shared DH secret used to encrypt/decrypt notification metadata (NMsgMeta) from server to recipient
    ClientNtfCreds -> RcvDhSecret
rcvNtfDhSecret :: RcvNtfDhSecret
  }
  deriving (Int -> ClientNtfCreds -> ShowS
[ClientNtfCreds] -> ShowS
ClientNtfCreds -> String
(Int -> ClientNtfCreds -> ShowS)
-> (ClientNtfCreds -> String)
-> ([ClientNtfCreds] -> ShowS)
-> Show ClientNtfCreds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientNtfCreds -> ShowS
showsPrec :: Int -> ClientNtfCreds -> ShowS
$cshow :: ClientNtfCreds -> String
show :: ClientNtfCreds -> String
$cshowList :: [ClientNtfCreds] -> ShowS
showList :: [ClientNtfCreds] -> ShowS
Show)

-- This record is stored in inv_short_links table.
-- It is needed only for 1-time invitation links because of "secure-on-read" property of link data,
-- that prevents undetected access to link data from link observers.
data InvShortLink = InvShortLink
  { InvShortLink -> SMPServer
server :: SMPServer,
    InvShortLink -> RecipientId
linkId :: SMP.LinkId,
    InvShortLink -> LinkKey
linkKey :: LinkKey,
    InvShortLink -> RcvPrivateAuthKey
sndPrivateKey :: SndPrivateAuthKey, -- stored to allow retries
    InvShortLink -> Maybe RecipientId
sndId :: Maybe SMP.SenderId
  }
  deriving (Int -> InvShortLink -> ShowS
[InvShortLink] -> ShowS
InvShortLink -> String
(Int -> InvShortLink -> ShowS)
-> (InvShortLink -> String)
-> ([InvShortLink] -> ShowS)
-> Show InvShortLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvShortLink -> ShowS
showsPrec :: Int -> InvShortLink -> ShowS
$cshow :: InvShortLink -> String
show :: InvShortLink -> String
$cshowList :: [InvShortLink] -> ShowS
showList :: [InvShortLink] -> ShowS
Show)

type SndQueue = StoredSndQueue 'DBStored

type NewSndQueue = StoredSndQueue 'DBNew

-- | A send queue. SMP queue through which the agent sends messages to a recipient.
data StoredSndQueue (q :: DBStored) = SndQueue
  { forall (q :: DBStored). StoredSndQueue q -> UserId
userId :: UserId,
    forall (q :: DBStored). StoredSndQueue q -> ConnId
connId :: ConnId,
    forall (q :: DBStored). StoredSndQueue q -> SMPServer
server :: SMPServer,
    -- | sender queue ID
    forall (q :: DBStored). StoredSndQueue q -> RecipientId
sndId :: SMP.SenderId,
    -- | sender can secure the queue
    forall (q :: DBStored). StoredSndQueue q -> Maybe QueueMode
queueMode :: Maybe QueueMode,
    -- | sender key used to authorize transmissions
    forall (q :: DBStored). StoredSndQueue q -> RcvPrivateAuthKey
sndPrivateKey :: SndPrivateAuthKey,
    -- | DH public key used to negotiate per-queue e2e encryption
    forall (q :: DBStored). StoredSndQueue q -> Maybe PublicKeyX25519
e2ePubKey :: Maybe C.PublicKeyX25519,
    -- | shared DH secret agreed for simple per-queue e2e encryption
    forall (q :: DBStored). StoredSndQueue q -> RcvDhSecret
e2eDhSecret :: C.DhSecretX25519,
    -- | queue status
    forall (q :: DBStored). StoredSndQueue q -> QueueStatus
status :: QueueStatus,
    -- | database queue ID (within connection)
    forall (q :: DBStored). StoredSndQueue q -> DBEntityId' q
dbQueueId :: DBEntityId' q,
    -- | True for a primary or a next primary queue of the connection (next if dbReplaceQueueId is set)
    forall (q :: DBStored). StoredSndQueue q -> Bool
primary :: Bool,
    -- | ID of the queue this one is replacing
    forall (q :: DBStored). StoredSndQueue q -> Maybe UserId
dbReplaceQueueId :: Maybe Int64,
    forall (q :: DBStored). StoredSndQueue q -> Maybe SndSwitchStatus
sndSwchStatus :: Maybe SndSwitchStatus,
    -- | SMP client version
    forall (q :: DBStored). StoredSndQueue q -> VersionSMPC
smpClientVersion :: VersionSMPC
  }
  deriving (Int -> StoredSndQueue q -> ShowS
[StoredSndQueue q] -> ShowS
StoredSndQueue q -> String
(Int -> StoredSndQueue q -> ShowS)
-> (StoredSndQueue q -> String)
-> ([StoredSndQueue q] -> ShowS)
-> Show (StoredSndQueue q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (q :: DBStored). Int -> StoredSndQueue q -> ShowS
forall (q :: DBStored). [StoredSndQueue q] -> ShowS
forall (q :: DBStored). StoredSndQueue q -> String
$cshowsPrec :: forall (q :: DBStored). Int -> StoredSndQueue q -> ShowS
showsPrec :: Int -> StoredSndQueue q -> ShowS
$cshow :: forall (q :: DBStored). StoredSndQueue q -> String
show :: StoredSndQueue q -> String
$cshowList :: forall (q :: DBStored). [StoredSndQueue q] -> ShowS
showList :: [StoredSndQueue q] -> ShowS
Show)

instance SMPQueue RcvQueue where
  qServer :: RcvQueue -> SMPServer
qServer RcvQueue {SMPServer
$sel:server:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SMPServer
server :: SMPServer
server} = SMPServer
server
  {-# INLINE qServer #-}
  queueId :: RcvQueue -> RecipientId
queueId RcvQueue {RecipientId
$sel:rcvId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> RecipientId
rcvId :: RecipientId
rcvId} = RecipientId
rcvId
  {-# INLINE queueId #-}

instance SMPQueue NewRcvQueue where
  qServer :: NewRcvQueue -> SMPServer
qServer RcvQueue {SMPServer
$sel:server:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SMPServer
server :: SMPServer
server} = SMPServer
server
  {-# INLINE qServer #-}
  queueId :: NewRcvQueue -> RecipientId
queueId RcvQueue {RecipientId
$sel:rcvId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> RecipientId
rcvId :: RecipientId
rcvId} = RecipientId
rcvId
  {-# INLINE queueId #-}

instance SMPQueue RcvQueueSub where
  qServer :: RcvQueueSub -> SMPServer
qServer RcvQueueSub {SMPServer
$sel:server:RcvQueueSub :: RcvQueueSub -> SMPServer
server :: SMPServer
server} = SMPServer
server
  {-# INLINE qServer #-}
  queueId :: RcvQueueSub -> RecipientId
queueId RcvQueueSub {RecipientId
$sel:rcvId:RcvQueueSub :: RcvQueueSub -> RecipientId
rcvId :: RecipientId
rcvId} = RecipientId
rcvId
  {-# INLINE queueId #-}

instance SMPQueue SndQueue where
  qServer :: SndQueue -> SMPServer
qServer SndQueue {SMPServer
$sel:server:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> SMPServer
server :: SMPServer
server} = SMPServer
server
  {-# INLINE qServer #-}
  queueId :: SndQueue -> RecipientId
queueId SndQueue {RecipientId
$sel:sndId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> RecipientId
sndId :: RecipientId
sndId} = RecipientId
sndId
  {-# INLINE queueId #-}

findQ :: SMPQueue q => (SMPServer, SMP.QueueId) -> NonEmpty q -> Maybe q
findQ :: forall q.
SMPQueue q =>
(SMPServer, RecipientId) -> NonEmpty q -> Maybe q
findQ = (q -> Bool) -> NonEmpty q -> Maybe q
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((q -> Bool) -> NonEmpty q -> Maybe q)
-> ((SMPServer, RecipientId) -> q -> Bool)
-> (SMPServer, RecipientId)
-> NonEmpty q
-> Maybe q
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SMPServer, RecipientId) -> q -> Bool
forall q. SMPQueue q => (SMPServer, RecipientId) -> q -> Bool
sameQueue
{-# INLINE findQ #-}

removeQ :: SMPQueue q => (SMPServer, SMP.QueueId) -> NonEmpty q -> Maybe (q, [q])
removeQ :: forall q.
SMPQueue q =>
(SMPServer, RecipientId) -> NonEmpty q -> Maybe (q, [q])
removeQ = (q -> Bool) -> NonEmpty q -> Maybe (q, [q])
forall q. (q -> Bool) -> NonEmpty q -> Maybe (q, [q])
removeQP ((q -> Bool) -> NonEmpty q -> Maybe (q, [q]))
-> ((SMPServer, RecipientId) -> q -> Bool)
-> (SMPServer, RecipientId)
-> NonEmpty q
-> Maybe (q, [q])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SMPServer, RecipientId) -> q -> Bool
forall q. SMPQueue q => (SMPServer, RecipientId) -> q -> Bool
sameQueue
{-# INLINE removeQ #-}

removeQP :: (q -> Bool) -> NonEmpty q -> Maybe (q, [q])
removeQP :: forall q. (q -> Bool) -> NonEmpty q -> Maybe (q, [q])
removeQP q -> Bool
p NonEmpty q
qs = case (q -> Bool) -> NonEmpty q -> ([q], [q])
forall a. (a -> Bool) -> NonEmpty a -> ([a], [a])
L.break q -> Bool
p NonEmpty q
qs of
  ([q]
_, []) -> Maybe (q, [q])
forall a. Maybe a
Nothing
  ([q]
qs1, q
q : [q]
qs2) -> (q, [q]) -> Maybe (q, [q])
forall a. a -> Maybe a
Just (q
q, [q]
qs1 [q] -> [q] -> [q]
forall a. Semigroup a => a -> a -> a
<> [q]
qs2)

sndAddress :: RcvQueue -> (SMPServer, SMP.SenderId)
sndAddress :: RcvQueue -> (SMPServer, RecipientId)
sndAddress RcvQueue {SMPServer
$sel:server:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> SMPServer
server :: SMPServer
server, RecipientId
$sel:sndId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> RecipientId
sndId :: RecipientId
sndId} = (SMPServer
server, RecipientId
sndId)
{-# INLINE sndAddress #-}

findRQ :: (SMPServer, SMP.SenderId) -> NonEmpty RcvQueue -> Maybe RcvQueue
findRQ :: (SMPServer, RecipientId) -> NonEmpty RcvQueue -> Maybe RcvQueue
findRQ (SMPServer, RecipientId)
sAddr = (RcvQueue -> Bool) -> NonEmpty RcvQueue -> Maybe RcvQueue
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((RcvQueue -> Bool) -> NonEmpty RcvQueue -> Maybe RcvQueue)
-> (RcvQueue -> Bool) -> NonEmpty RcvQueue -> Maybe RcvQueue
forall a b. (a -> b) -> a -> b
$ (SMPServer, RecipientId) -> (SMPServer, RecipientId) -> Bool
sameQAddress (SMPServer, RecipientId)
sAddr ((SMPServer, RecipientId) -> Bool)
-> (RcvQueue -> (SMPServer, RecipientId)) -> RcvQueue -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RcvQueue -> (SMPServer, RecipientId)
sndAddress
{-# INLINE findRQ #-}

switchingRQ :: NonEmpty RcvQueue -> Maybe RcvQueue
switchingRQ :: NonEmpty RcvQueue -> Maybe RcvQueue
switchingRQ = (RcvQueue -> Bool) -> NonEmpty RcvQueue -> Maybe RcvQueue
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((RcvQueue -> Bool) -> NonEmpty RcvQueue -> Maybe RcvQueue)
-> (RcvQueue -> Bool) -> NonEmpty RcvQueue -> Maybe RcvQueue
forall a b. (a -> b) -> a -> b
$ Maybe RcvSwitchStatus -> Bool
forall a. Maybe a -> Bool
isJust (Maybe RcvSwitchStatus -> Bool)
-> (RcvQueue -> Maybe RcvSwitchStatus) -> RcvQueue -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RcvQueue -> Maybe RcvSwitchStatus
forall (q :: DBStored). StoredRcvQueue q -> Maybe RcvSwitchStatus
rcvSwchStatus
{-# INLINE switchingRQ #-}

updatedQs :: SMPQueueRec q => q -> NonEmpty q -> NonEmpty q
updatedQs :: forall q. SMPQueueRec q => q -> NonEmpty q -> NonEmpty q
updatedQs q
q = (q -> q) -> NonEmpty q -> NonEmpty q
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map ((q -> q) -> NonEmpty q -> NonEmpty q)
-> (q -> q) -> NonEmpty q -> NonEmpty q
forall a b. (a -> b) -> a -> b
$ \q
q' -> if q -> UserId
forall q. SMPQueueRec q => q -> UserId
dbQId q
q UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== q -> UserId
forall q. SMPQueueRec q => q -> UserId
dbQId q
q' then q
q else q
q'
{-# INLINE updatedQs #-}

class SMPQueue q => SMPQueueRec q where
  qUserId :: q -> UserId
  qConnId :: q -> ConnId
  dbQId :: q -> Int64
  qPrimary :: q -> Bool
  dbReplaceQId :: q -> Maybe Int64

instance SMPQueueRec RcvQueue where
  qUserId :: RcvQueue -> UserId
qUserId RcvQueue {UserId
$sel:userId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> UserId
userId :: UserId
userId} = UserId
userId
  {-# INLINE qUserId #-}
  qConnId :: RcvQueue -> ConnId
qConnId RcvQueue {ConnId
$sel:connId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> ConnId
connId :: ConnId
connId} = ConnId
connId
  {-# INLINE qConnId #-}
  dbQId :: RcvQueue -> UserId
dbQId RcvQueue {$sel:dbQueueId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> DBEntityId' q
dbQueueId = DBEntityId UserId
qId} = UserId
qId
  {-# INLINE dbQId #-}
  qPrimary :: RcvQueue -> Bool
qPrimary RcvQueue {Bool
$sel:primary:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Bool
primary :: Bool
primary} = Bool
primary
  {-# INLINE qPrimary #-}
  dbReplaceQId :: RcvQueue -> Maybe UserId
dbReplaceQId RcvQueue {Maybe UserId
$sel:dbReplaceQueueId:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> Maybe UserId
dbReplaceQueueId :: Maybe UserId
dbReplaceQueueId} = Maybe UserId
dbReplaceQueueId
  {-# INLINE dbReplaceQId #-}

instance SMPQueueRec RcvQueueSub where
  qUserId :: RcvQueueSub -> UserId
qUserId RcvQueueSub {UserId
$sel:userId:RcvQueueSub :: RcvQueueSub -> UserId
userId :: UserId
userId} = UserId
userId
  {-# INLINE qUserId #-}
  qConnId :: RcvQueueSub -> ConnId
qConnId RcvQueueSub {ConnId
$sel:connId:RcvQueueSub :: RcvQueueSub -> ConnId
connId :: ConnId
connId} = ConnId
connId
  {-# INLINE qConnId #-}
  dbQId :: RcvQueueSub -> UserId
dbQId RcvQueueSub {UserId
$sel:dbQueueId:RcvQueueSub :: RcvQueueSub -> UserId
dbQueueId :: UserId
dbQueueId} = UserId
dbQueueId
  {-# INLINE dbQId #-}
  qPrimary :: RcvQueueSub -> Bool
qPrimary RcvQueueSub {Bool
$sel:primary:RcvQueueSub :: RcvQueueSub -> Bool
primary :: Bool
primary} = Bool
primary
  {-# INLINE qPrimary #-}
  dbReplaceQId :: RcvQueueSub -> Maybe UserId
dbReplaceQId RcvQueueSub {Maybe UserId
$sel:dbReplaceQueueId:RcvQueueSub :: RcvQueueSub -> Maybe UserId
dbReplaceQueueId :: Maybe UserId
dbReplaceQueueId} = Maybe UserId
dbReplaceQueueId
  {-# INLINE dbReplaceQId #-}

instance SMPQueueRec SndQueue where
  qUserId :: SndQueue -> UserId
qUserId SndQueue {UserId
$sel:userId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> UserId
userId :: UserId
userId} = UserId
userId
  {-# INLINE qUserId #-}
  qConnId :: SndQueue -> ConnId
qConnId SndQueue {ConnId
$sel:connId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> ConnId
connId :: ConnId
connId} = ConnId
connId
  {-# INLINE qConnId #-}
  dbQId :: SndQueue -> UserId
dbQId SndQueue {$sel:dbQueueId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> DBEntityId' q
dbQueueId = DBEntityId UserId
qId} = UserId
qId
  {-# INLINE dbQId #-}
  qPrimary :: SndQueue -> Bool
qPrimary SndQueue {Bool
$sel:primary:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> Bool
primary :: Bool
primary} = Bool
primary
  {-# INLINE qPrimary #-}
  dbReplaceQId :: SndQueue -> Maybe UserId
dbReplaceQId SndQueue {Maybe UserId
$sel:dbReplaceQueueId:SndQueue :: forall (q :: DBStored). StoredSndQueue q -> Maybe UserId
dbReplaceQueueId :: Maybe UserId
dbReplaceQueueId} = Maybe UserId
dbReplaceQueueId
  {-# INLINE dbReplaceQId #-}

class SMPQueueRec q => SomeRcvQueue q where
  rcvAuthKey :: q -> RcvPrivateAuthKey

instance SomeRcvQueue RcvQueue where
  rcvAuthKey :: RcvQueue -> RcvPrivateAuthKey
rcvAuthKey RcvQueue {RcvPrivateAuthKey
$sel:rcvPrivateKey:RcvQueue :: forall (q :: DBStored). StoredRcvQueue q -> RcvPrivateAuthKey
rcvPrivateKey :: RcvPrivateAuthKey
rcvPrivateKey} = RcvPrivateAuthKey
rcvPrivateKey
  {-# INLINE rcvAuthKey #-}

instance SomeRcvQueue RcvQueueSub where
  rcvAuthKey :: RcvQueueSub -> RcvPrivateAuthKey
rcvAuthKey RcvQueueSub {RcvPrivateAuthKey
$sel:rcvPrivateKey:RcvQueueSub :: RcvQueueSub -> RcvPrivateAuthKey
rcvPrivateKey :: RcvPrivateAuthKey
rcvPrivateKey} = RcvPrivateAuthKey
rcvPrivateKey
  {-# INLINE rcvAuthKey #-}

-- * Connection types

-- | Type of a connection.
data ConnType = CNew | CRcv | CSnd | CDuplex | CContact deriving (ConnType -> ConnType -> Bool
(ConnType -> ConnType -> Bool)
-> (ConnType -> ConnType -> Bool) -> Eq ConnType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnType -> ConnType -> Bool
== :: ConnType -> ConnType -> Bool
$c/= :: ConnType -> ConnType -> Bool
/= :: ConnType -> ConnType -> Bool
Eq, Int -> ConnType -> ShowS
[ConnType] -> ShowS
ConnType -> String
(Int -> ConnType -> ShowS)
-> (ConnType -> String) -> ([ConnType] -> ShowS) -> Show ConnType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnType -> ShowS
showsPrec :: Int -> ConnType -> ShowS
$cshow :: ConnType -> String
show :: ConnType -> String
$cshowList :: [ConnType] -> ShowS
showList :: [ConnType] -> ShowS
Show)

-- | Connection of a specific type.
--
-- - RcvConnection is a connection that only has a receive queue set up,
--   typically created by a recipient initiating a duplex connection.
--
-- - SndConnection is a connection that only has a send queue set up, typically
--   created by a sender joining a duplex connection through a recipient's invitation.
--
-- - DuplexConnection is a connection that has both receive and send queues set up,
--   typically created by upgrading a receive or a send connection with a missing queue.
data Connection' (d :: ConnType) rq sq where
  NewConnection :: ConnData -> Connection' CNew rq sq
  RcvConnection :: ConnData -> rq -> Connection' CRcv rq sq
  SndConnection :: ConnData -> sq -> Connection' CSnd rq sq
  DuplexConnection :: ConnData -> NonEmpty rq -> NonEmpty sq -> Connection' CDuplex rq sq
  ContactConnection :: ConnData -> rq -> Connection' CContact rq sq

deriving instance (Show rq, Show sq) => Show (Connection' d rq sq)

type Connection d = Connection' d RcvQueue SndQueue

toConnData :: Connection' d rq sq -> ConnData
toConnData :: forall (d :: ConnType) rq sq. Connection' d rq sq -> ConnData
toConnData = \case
  NewConnection ConnData
cData -> ConnData
cData
  RcvConnection ConnData
cData rq
_ -> ConnData
cData
  SndConnection ConnData
cData sq
_ -> ConnData
cData
  DuplexConnection ConnData
cData NonEmpty rq
_ NonEmpty sq
_ -> ConnData
cData
  ContactConnection ConnData
cData rq
_ -> ConnData
cData

updateConnection :: ConnData -> Connection' d rq sq -> Connection' d rq sq
updateConnection :: forall (d :: ConnType) rq sq.
ConnData -> Connection' d rq sq -> Connection' d rq sq
updateConnection ConnData
cData = \case
  NewConnection ConnData
_ -> ConnData -> Connection' 'CNew rq sq
forall rq sq. ConnData -> Connection' 'CNew rq sq
NewConnection ConnData
cData
  RcvConnection ConnData
_ rq
rq -> ConnData -> rq -> Connection' 'CRcv rq sq
forall rq sq. ConnData -> rq -> Connection' 'CRcv rq sq
RcvConnection ConnData
cData rq
rq
  SndConnection ConnData
_ sq
sq -> ConnData -> sq -> Connection' 'CSnd rq sq
forall sq rq. ConnData -> sq -> Connection' 'CSnd rq sq
SndConnection ConnData
cData sq
sq
  DuplexConnection ConnData
_ NonEmpty rq
rqs NonEmpty sq
sqs -> ConnData
-> NonEmpty rq -> NonEmpty sq -> Connection' 'CDuplex rq sq
forall rq sq.
ConnData
-> NonEmpty rq -> NonEmpty sq -> Connection' 'CDuplex rq sq
DuplexConnection ConnData
cData NonEmpty rq
rqs NonEmpty sq
sqs
  ContactConnection ConnData
_ rq
rq -> ConnData -> rq -> Connection' 'CContact rq sq
forall rq sq. ConnData -> rq -> Connection' 'CContact rq sq
ContactConnection ConnData
cData rq
rq

data SConnType :: ConnType -> Type where
  SCNew :: SConnType CNew
  SCRcv :: SConnType CRcv
  SCSnd :: SConnType CSnd
  SCDuplex :: SConnType CDuplex
  SCContact :: SConnType CContact

connType :: SConnType c -> ConnType
connType :: forall (c :: ConnType). SConnType c -> ConnType
connType SConnType c
SCNew = ConnType
CNew
connType SConnType c
SCRcv = ConnType
CRcv
connType SConnType c
SCSnd = ConnType
CSnd
connType SConnType c
SCDuplex = ConnType
CDuplex
connType SConnType c
SCContact = ConnType
CContact

deriving instance Show (SConnType d)

instance TestEquality SConnType where
  testEquality :: forall (a :: ConnType) (b :: ConnType).
SConnType a -> SConnType b -> Maybe (a :~: b)
testEquality SConnType a
SCRcv SConnType b
SCRcv = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SConnType a
SCSnd SConnType b
SCSnd = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SConnType a
SCDuplex SConnType b
SCDuplex = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SConnType a
SCContact SConnType b
SCContact = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SConnType a
_ SConnType b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing

-- | Connection of an unknown type.
-- Used to refer to an arbitrary connection when retrieving from store.
data SomeConn' rq sq = forall d. SomeConn (SConnType d) (Connection' d rq sq)

deriving instance (Show rq, Show sq) => Show (SomeConn' rq sq)

type SomeConn = SomeConn' RcvQueue SndQueue

type SomeConnSub = SomeConn' RcvQueueSub SndQueue

data ConnData = ConnData
  { ConnData -> ConnId
connId :: ConnId,
    ConnData -> UserId
userId :: UserId,
    ConnData -> VersionSMPA
connAgentVersion :: VersionSMPA,
    ConnData -> Bool
enableNtfs :: Bool,
    ConnData -> UserId
lastExternalSndId :: PrevExternalSndId,
    ConnData -> Bool
deleted :: Bool,
    ConnData -> RatchetSyncState
ratchetSyncState :: RatchetSyncState,
    ConnData -> PQSupport
pqSupport :: PQSupport
  }
  deriving (ConnData -> ConnData -> Bool
(ConnData -> ConnData -> Bool)
-> (ConnData -> ConnData -> Bool) -> Eq ConnData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnData -> ConnData -> Bool
== :: ConnData -> ConnData -> Bool
$c/= :: ConnData -> ConnData -> Bool
/= :: ConnData -> ConnData -> Bool
Eq, Int -> ConnData -> ShowS
[ConnData] -> ShowS
ConnData -> String
(Int -> ConnData -> ShowS)
-> (ConnData -> String) -> ([ConnData] -> ShowS) -> Show ConnData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnData -> ShowS
showsPrec :: Int -> ConnData -> ShowS
$cshow :: ConnData -> String
show :: ConnData -> String
$cshowList :: [ConnData] -> ShowS
showList :: [ConnData] -> ShowS
Show)

type NoticeId = Int64

-- this function should be mirrored in the clients
ratchetSyncAllowed :: ConnData -> Bool
ratchetSyncAllowed :: ConnData -> Bool
ratchetSyncAllowed ConnData {RatchetSyncState
$sel:ratchetSyncState:ConnData :: ConnData -> RatchetSyncState
ratchetSyncState :: RatchetSyncState
ratchetSyncState, VersionSMPA
$sel:connAgentVersion:ConnData :: ConnData -> VersionSMPA
connAgentVersion :: VersionSMPA
connAgentVersion} =
  VersionSMPA
connAgentVersion VersionSMPA -> VersionSMPA -> Bool
forall a. Ord a => a -> a -> Bool
>= VersionSMPA
ratchetSyncSMPAgentVersion Bool -> Bool -> Bool
&& (RatchetSyncState
ratchetSyncState RatchetSyncState -> [RatchetSyncState] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([RatchetSyncState
RSAllowed, RatchetSyncState
RSRequired] :: [RatchetSyncState]))

-- this function should be mirrored in the clients
ratchetSyncSendProhibited :: ConnData -> Bool
ratchetSyncSendProhibited :: ConnData -> Bool
ratchetSyncSendProhibited ConnData {RatchetSyncState
$sel:ratchetSyncState:ConnData :: ConnData -> RatchetSyncState
ratchetSyncState :: RatchetSyncState
ratchetSyncState} =
  RatchetSyncState
ratchetSyncState RatchetSyncState -> [RatchetSyncState] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([RatchetSyncState
RSRequired, RatchetSyncState
RSStarted, RatchetSyncState
RSAgreed] :: [RatchetSyncState])

data PendingCommand = PendingCommand
  { PendingCommand -> UserId
cmdId :: AsyncCmdId,
    PendingCommand -> ConnId
corrId :: ACorrId,
    PendingCommand -> UserId
userId :: UserId,
    PendingCommand -> ConnId
connId :: ConnId,
    PendingCommand -> AgentCommand
command :: AgentCommand
  }

data AgentCmdType = ACClient | ACInternal

instance StrEncoding AgentCmdType where
  strEncode :: AgentCmdType -> ConnId
strEncode = \case
    AgentCmdType
ACClient -> ConnId
"CLIENT"
    AgentCmdType
ACInternal -> ConnId
"INTERNAL"
  strP :: Parser AgentCmdType
strP =
    (Char -> Bool) -> Parser ConnId
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ConnId
-> (ConnId -> Parser AgentCmdType) -> Parser AgentCmdType
forall a b.
Parser ConnId a -> (a -> Parser ConnId b) -> Parser ConnId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConnId
"CLIENT" -> AgentCmdType -> Parser AgentCmdType
forall a. a -> Parser ConnId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentCmdType
ACClient
      ConnId
"INTERNAL" -> AgentCmdType -> Parser AgentCmdType
forall a. a -> Parser ConnId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentCmdType
ACInternal
      ConnId
_ -> String -> Parser AgentCmdType
forall a. String -> Parser ConnId a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad AgentCmdType"

data AgentCommand
  = AClientCommand ACommand
  | AInternalCommand InternalCommand

instance StrEncoding AgentCommand where
  strEncode :: AgentCommand -> ConnId
strEncode = \case
    AClientCommand ACommand
cmd -> (AgentCmdType, Str) -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode (AgentCmdType
ACClient, ConnId -> Str
Str (ConnId -> Str) -> ConnId -> Str
forall a b. (a -> b) -> a -> b
$ ACommand -> ConnId
serializeCommand ACommand
cmd)
    AInternalCommand InternalCommand
cmd -> (AgentCmdType, InternalCommand) -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode (AgentCmdType
ACInternal, InternalCommand
cmd)
  strP :: Parser AgentCommand
strP =
    Parser AgentCmdType
forall a. StrEncoding a => Parser a
strP_ Parser AgentCmdType
-> (AgentCmdType -> Parser AgentCommand) -> Parser AgentCommand
forall a b.
Parser ConnId a -> (a -> Parser ConnId b) -> Parser ConnId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      AgentCmdType
ACClient -> ACommand -> AgentCommand
AClientCommand (ACommand -> AgentCommand)
-> Parser ConnId ACommand -> Parser AgentCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnId ACommand
dbCommandP
      AgentCmdType
ACInternal -> InternalCommand -> AgentCommand
AInternalCommand (InternalCommand -> AgentCommand)
-> Parser ConnId InternalCommand -> Parser AgentCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnId InternalCommand
forall a. StrEncoding a => Parser a
strP

data AgentCommandTag
  = AClientCommandTag ACommandTag
  | AInternalCommandTag InternalCommandTag
  deriving (Int -> AgentCommandTag -> ShowS
[AgentCommandTag] -> ShowS
AgentCommandTag -> String
(Int -> AgentCommandTag -> ShowS)
-> (AgentCommandTag -> String)
-> ([AgentCommandTag] -> ShowS)
-> Show AgentCommandTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgentCommandTag -> ShowS
showsPrec :: Int -> AgentCommandTag -> ShowS
$cshow :: AgentCommandTag -> String
show :: AgentCommandTag -> String
$cshowList :: [AgentCommandTag] -> ShowS
showList :: [AgentCommandTag] -> ShowS
Show)

instance StrEncoding AgentCommandTag where
  strEncode :: AgentCommandTag -> ConnId
strEncode = \case
    AClientCommandTag ACommandTag
t -> (AgentCmdType, ACommandTag) -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode (AgentCmdType
ACClient, ACommandTag
t)
    AInternalCommandTag InternalCommandTag
t -> (AgentCmdType, InternalCommandTag) -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode (AgentCmdType
ACInternal, InternalCommandTag
t)
  strP :: Parser AgentCommandTag
strP =
    Parser AgentCmdType
forall a. StrEncoding a => Parser a
strP_ Parser AgentCmdType
-> (AgentCmdType -> Parser AgentCommandTag)
-> Parser AgentCommandTag
forall a b.
Parser ConnId a -> (a -> Parser ConnId b) -> Parser ConnId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      AgentCmdType
ACClient -> ACommandTag -> AgentCommandTag
AClientCommandTag (ACommandTag -> AgentCommandTag)
-> Parser ConnId ACommandTag -> Parser AgentCommandTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnId ACommandTag
forall a. StrEncoding a => Parser a
strP
      AgentCmdType
ACInternal -> InternalCommandTag -> AgentCommandTag
AInternalCommandTag (InternalCommandTag -> AgentCommandTag)
-> Parser ConnId InternalCommandTag -> Parser AgentCommandTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnId InternalCommandTag
forall a. StrEncoding a => Parser a
strP

data InternalCommand
  = ICAck SMP.RecipientId MsgId
  | ICAckDel SMP.RecipientId MsgId InternalId
  | ICAllowSecure SMP.RecipientId (Maybe SMP.SndPublicAuthKey)
  | ICDuplexSecure SMP.RecipientId SMP.SndPublicAuthKey
  | ICDeleteConn
  | ICDeleteRcvQueue SMP.RecipientId
  | ICQSecure SMP.RecipientId SMP.SndPublicAuthKey
  | ICQDelete SMP.RecipientId

data InternalCommandTag
  = ICAck_
  | ICAckDel_
  | ICAllowSecure_
  | ICDuplexSecure_
  | ICDeleteConn_
  | ICDeleteRcvQueue_
  | ICQSecure_
  | ICQDelete_
  deriving (Int -> InternalCommandTag -> ShowS
[InternalCommandTag] -> ShowS
InternalCommandTag -> String
(Int -> InternalCommandTag -> ShowS)
-> (InternalCommandTag -> String)
-> ([InternalCommandTag] -> ShowS)
-> Show InternalCommandTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InternalCommandTag -> ShowS
showsPrec :: Int -> InternalCommandTag -> ShowS
$cshow :: InternalCommandTag -> String
show :: InternalCommandTag -> String
$cshowList :: [InternalCommandTag] -> ShowS
showList :: [InternalCommandTag] -> ShowS
Show)

instance StrEncoding InternalCommand where
  strEncode :: InternalCommand -> ConnId
strEncode = \case
    ICAck RecipientId
rId ConnId
srvMsgId -> (InternalCommandTag, RecipientId, ConnId) -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode (InternalCommandTag
ICAck_, RecipientId
rId, ConnId
srvMsgId)
    ICAckDel RecipientId
rId ConnId
srvMsgId InternalId
mId -> (InternalCommandTag, RecipientId, ConnId, InternalId) -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode (InternalCommandTag
ICAckDel_, RecipientId
rId, ConnId
srvMsgId, InternalId
mId)
    ICAllowSecure RecipientId
rId Maybe NtfPublicAuthKey
sndKey -> (InternalCommandTag, RecipientId, Maybe NtfPublicAuthKey) -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode (InternalCommandTag
ICAllowSecure_, RecipientId
rId, Maybe NtfPublicAuthKey
sndKey)
    ICDuplexSecure RecipientId
rId NtfPublicAuthKey
sndKey -> (InternalCommandTag, RecipientId, NtfPublicAuthKey) -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode (InternalCommandTag
ICDuplexSecure_, RecipientId
rId, NtfPublicAuthKey
sndKey)
    InternalCommand
ICDeleteConn -> InternalCommandTag -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode InternalCommandTag
ICDeleteConn_
    ICDeleteRcvQueue RecipientId
rId -> (InternalCommandTag, RecipientId) -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode (InternalCommandTag
ICDeleteRcvQueue_, RecipientId
rId)
    ICQSecure RecipientId
rId NtfPublicAuthKey
senderKey -> (InternalCommandTag, RecipientId, NtfPublicAuthKey) -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode (InternalCommandTag
ICQSecure_, RecipientId
rId, NtfPublicAuthKey
senderKey)
    ICQDelete RecipientId
rId -> (InternalCommandTag, RecipientId) -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode (InternalCommandTag
ICQDelete_, RecipientId
rId)
  strP :: Parser ConnId InternalCommand
strP =
    Parser ConnId InternalCommandTag
forall a. StrEncoding a => Parser a
strP Parser ConnId InternalCommandTag
-> (InternalCommandTag -> Parser ConnId InternalCommand)
-> Parser ConnId InternalCommand
forall a b.
Parser ConnId a -> (a -> Parser ConnId b) -> Parser ConnId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      InternalCommandTag
ICAck_ -> RecipientId -> ConnId -> InternalCommand
ICAck (RecipientId -> ConnId -> InternalCommand)
-> Parser ConnId RecipientId
-> Parser ConnId (ConnId -> InternalCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnId RecipientId
forall a. StrEncoding a => Parser a
_strP Parser ConnId (ConnId -> InternalCommand)
-> Parser ConnId -> Parser ConnId InternalCommand
forall a b.
Parser ConnId (a -> b) -> Parser ConnId a -> Parser ConnId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConnId
forall a. StrEncoding a => Parser a
_strP
      InternalCommandTag
ICAckDel_ -> RecipientId -> ConnId -> InternalId -> InternalCommand
ICAckDel (RecipientId -> ConnId -> InternalId -> InternalCommand)
-> Parser ConnId RecipientId
-> Parser ConnId (ConnId -> InternalId -> InternalCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnId RecipientId
forall a. StrEncoding a => Parser a
_strP Parser ConnId (ConnId -> InternalId -> InternalCommand)
-> Parser ConnId -> Parser ConnId (InternalId -> InternalCommand)
forall a b.
Parser ConnId (a -> b) -> Parser ConnId a -> Parser ConnId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConnId
forall a. StrEncoding a => Parser a
_strP Parser ConnId (InternalId -> InternalCommand)
-> Parser ConnId InternalId -> Parser ConnId InternalCommand
forall a b.
Parser ConnId (a -> b) -> Parser ConnId a -> Parser ConnId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConnId InternalId
forall a. StrEncoding a => Parser a
_strP
      InternalCommandTag
ICAllowSecure_ -> RecipientId -> Maybe NtfPublicAuthKey -> InternalCommand
ICAllowSecure (RecipientId -> Maybe NtfPublicAuthKey -> InternalCommand)
-> Parser ConnId RecipientId
-> Parser ConnId (Maybe NtfPublicAuthKey -> InternalCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnId RecipientId
forall a. StrEncoding a => Parser a
_strP Parser ConnId (Maybe NtfPublicAuthKey -> InternalCommand)
-> Parser ConnId (Maybe NtfPublicAuthKey)
-> Parser ConnId InternalCommand
forall a b.
Parser ConnId (a -> b) -> Parser ConnId a -> Parser ConnId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConnId (Maybe NtfPublicAuthKey)
forall a. StrEncoding a => Parser a
_strP
      InternalCommandTag
ICDuplexSecure_ -> RecipientId -> NtfPublicAuthKey -> InternalCommand
ICDuplexSecure (RecipientId -> NtfPublicAuthKey -> InternalCommand)
-> Parser ConnId RecipientId
-> Parser ConnId (NtfPublicAuthKey -> InternalCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnId RecipientId
forall a. StrEncoding a => Parser a
_strP Parser ConnId (NtfPublicAuthKey -> InternalCommand)
-> Parser ConnId NtfPublicAuthKey -> Parser ConnId InternalCommand
forall a b.
Parser ConnId (a -> b) -> Parser ConnId a -> Parser ConnId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConnId NtfPublicAuthKey
forall a. StrEncoding a => Parser a
_strP
      InternalCommandTag
ICDeleteConn_ -> InternalCommand -> Parser ConnId InternalCommand
forall a. a -> Parser ConnId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InternalCommand
ICDeleteConn
      InternalCommandTag
ICDeleteRcvQueue_ -> RecipientId -> InternalCommand
ICDeleteRcvQueue (RecipientId -> InternalCommand)
-> Parser ConnId RecipientId -> Parser ConnId InternalCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnId RecipientId
forall a. StrEncoding a => Parser a
_strP
      InternalCommandTag
ICQSecure_ -> RecipientId -> NtfPublicAuthKey -> InternalCommand
ICQSecure (RecipientId -> NtfPublicAuthKey -> InternalCommand)
-> Parser ConnId RecipientId
-> Parser ConnId (NtfPublicAuthKey -> InternalCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnId RecipientId
forall a. StrEncoding a => Parser a
_strP Parser ConnId (NtfPublicAuthKey -> InternalCommand)
-> Parser ConnId NtfPublicAuthKey -> Parser ConnId InternalCommand
forall a b.
Parser ConnId (a -> b) -> Parser ConnId a -> Parser ConnId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConnId NtfPublicAuthKey
forall a. StrEncoding a => Parser a
_strP
      InternalCommandTag
ICQDelete_ -> RecipientId -> InternalCommand
ICQDelete (RecipientId -> InternalCommand)
-> Parser ConnId RecipientId -> Parser ConnId InternalCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnId RecipientId
forall a. StrEncoding a => Parser a
_strP

instance StrEncoding InternalCommandTag where
  strEncode :: InternalCommandTag -> ConnId
strEncode = \case
    InternalCommandTag
ICAck_ -> ConnId
"ACK"
    InternalCommandTag
ICAckDel_ -> ConnId
"ACK_DEL"
    InternalCommandTag
ICAllowSecure_ -> ConnId
"ALLOW_SECURE"
    InternalCommandTag
ICDuplexSecure_ -> ConnId
"DUPLEX_SECURE"
    InternalCommandTag
ICDeleteConn_ -> ConnId
"DELETE_CONN"
    InternalCommandTag
ICDeleteRcvQueue_ -> ConnId
"DELETE_RCV_QUEUE"
    InternalCommandTag
ICQSecure_ -> ConnId
"QSECURE"
    InternalCommandTag
ICQDelete_ -> ConnId
"QDELETE"
  strP :: Parser ConnId InternalCommandTag
strP =
    (Char -> Bool) -> Parser ConnId
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ConnId
-> (ConnId -> Parser ConnId InternalCommandTag)
-> Parser ConnId InternalCommandTag
forall a b.
Parser ConnId a -> (a -> Parser ConnId b) -> Parser ConnId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConnId
"ACK" -> InternalCommandTag -> Parser ConnId InternalCommandTag
forall a. a -> Parser ConnId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InternalCommandTag
ICAck_
      ConnId
"ACK_DEL" -> InternalCommandTag -> Parser ConnId InternalCommandTag
forall a. a -> Parser ConnId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InternalCommandTag
ICAckDel_
      ConnId
"ALLOW_SECURE" -> InternalCommandTag -> Parser ConnId InternalCommandTag
forall a. a -> Parser ConnId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InternalCommandTag
ICAllowSecure_
      ConnId
"DUPLEX_SECURE" -> InternalCommandTag -> Parser ConnId InternalCommandTag
forall a. a -> Parser ConnId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InternalCommandTag
ICDuplexSecure_
      ConnId
"DELETE_CONN" -> InternalCommandTag -> Parser ConnId InternalCommandTag
forall a. a -> Parser ConnId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InternalCommandTag
ICDeleteConn_
      ConnId
"DELETE_RCV_QUEUE" -> InternalCommandTag -> Parser ConnId InternalCommandTag
forall a. a -> Parser ConnId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InternalCommandTag
ICDeleteRcvQueue_
      ConnId
"QSECURE" -> InternalCommandTag -> Parser ConnId InternalCommandTag
forall a. a -> Parser ConnId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InternalCommandTag
ICQSecure_
      ConnId
"QDELETE" -> InternalCommandTag -> Parser ConnId InternalCommandTag
forall a. a -> Parser ConnId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InternalCommandTag
ICQDelete_
      ConnId
_ -> String -> Parser ConnId InternalCommandTag
forall a. String -> Parser ConnId a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad InternalCommandTag"

agentCommandTag :: AgentCommand -> AgentCommandTag
agentCommandTag :: AgentCommand -> AgentCommandTag
agentCommandTag = \case
  AClientCommand ACommand
cmd -> ACommandTag -> AgentCommandTag
AClientCommandTag (ACommandTag -> AgentCommandTag) -> ACommandTag -> AgentCommandTag
forall a b. (a -> b) -> a -> b
$ ACommand -> ACommandTag
aCommandTag ACommand
cmd
  AInternalCommand InternalCommand
cmd -> InternalCommandTag -> AgentCommandTag
AInternalCommandTag (InternalCommandTag -> AgentCommandTag)
-> InternalCommandTag -> AgentCommandTag
forall a b. (a -> b) -> a -> b
$ InternalCommand -> InternalCommandTag
internalCmdTag InternalCommand
cmd

internalCmdTag :: InternalCommand -> InternalCommandTag
internalCmdTag :: InternalCommand -> InternalCommandTag
internalCmdTag = \case
  ICAck {} -> InternalCommandTag
ICAck_
  ICAckDel {} -> InternalCommandTag
ICAckDel_
  ICAllowSecure {} -> InternalCommandTag
ICAllowSecure_
  ICDuplexSecure {} -> InternalCommandTag
ICDuplexSecure_
  InternalCommand
ICDeleteConn -> InternalCommandTag
ICDeleteConn_
  ICDeleteRcvQueue {} -> InternalCommandTag
ICDeleteRcvQueue_
  ICQSecure {} -> InternalCommandTag
ICQSecure_
  ICQDelete RecipientId
_ -> InternalCommandTag
ICQDelete_

-- * Confirmation types

data NewConfirmation = NewConfirmation
  { NewConfirmation -> ConnId
connId :: ConnId,
    NewConfirmation -> SMPConfirmation
senderConf :: SMPConfirmation,
    NewConfirmation -> RatchetX448
ratchetState :: RatchetX448
  }

data AcceptedConfirmation = AcceptedConfirmation
  { AcceptedConfirmation -> ConnId
confirmationId :: ConfirmationId,
    AcceptedConfirmation -> ConnId
connId :: ConnId,
    AcceptedConfirmation -> SMPConfirmation
senderConf :: SMPConfirmation,
    AcceptedConfirmation -> RatchetX448
ratchetState :: RatchetX448,
    AcceptedConfirmation -> ConnId
ownConnInfo :: ConnInfo
  }

-- * Invitations

data NewInvitation = NewInvitation
  { NewInvitation -> ConnId
contactConnId :: ConnId,
    NewInvitation -> ConnectionRequestUri 'CMInvitation
connReq :: ConnectionRequestUri 'CMInvitation,
    NewInvitation -> ConnId
recipientConnInfo :: ConnInfo
  }

data Invitation = Invitation
  { Invitation -> ConnId
invitationId :: InvitationId,
    Invitation -> Maybe ConnId
contactConnId_ :: Maybe ConnId,
    Invitation -> ConnectionRequestUri 'CMInvitation
connReq :: ConnectionRequestUri 'CMInvitation,
    Invitation -> ConnId
recipientConnInfo :: ConnInfo,
    Invitation -> Maybe ConnId
ownConnInfo :: Maybe ConnInfo,
    Invitation -> Bool
accepted :: Bool
  }

-- * Message integrity validation types

-- | Corresponds to `last_external_snd_msg_id` in `connections` table
type PrevExternalSndId = Int64

-- | Corresponds to `last_rcv_msg_hash` in `connections` table
type PrevRcvMsgHash = MsgHash

-- | Corresponds to `last_snd_msg_hash` in `connections` table
type PrevSndMsgHash = MsgHash

-- * Message data containers

data RcvMsgData = RcvMsgData
  { RcvMsgData -> MsgMeta
msgMeta :: MsgMeta,
    RcvMsgData -> AgentMessageType
msgType :: AgentMessageType,
    RcvMsgData -> MsgFlags
msgFlags :: MsgFlags,
    RcvMsgData -> ConnId
msgBody :: MsgBody,
    RcvMsgData -> InternalRcvId
internalRcvId :: InternalRcvId,
    RcvMsgData -> ConnId
internalHash :: MsgHash,
    RcvMsgData -> ConnId
externalPrevSndHash :: MsgHash,
    RcvMsgData -> ConnId
encryptedMsgHash :: MsgHash
  }

data RcvMsg = RcvMsg
  { RcvMsg -> InternalId
internalId :: InternalId,
    RcvMsg -> MsgMeta
msgMeta :: MsgMeta,
    RcvMsg -> AgentMessageType
msgType :: AgentMessageType,
    RcvMsg -> ConnId
msgBody :: MsgBody,
    RcvMsg -> ConnId
internalHash :: MsgHash,
    RcvMsg -> Maybe MsgReceipt
msgReceipt :: Maybe MsgReceipt, -- if this message is a delivery receipt
    RcvMsg -> Bool
userAck :: Bool
  }

data SndMsgData = SndMsgData
  { SndMsgData -> InternalId
internalId :: InternalId,
    SndMsgData -> InternalSndId
internalSndId :: InternalSndId,
    SndMsgData -> InternalTs
internalTs :: InternalTs,
    SndMsgData -> AgentMessageType
msgType :: AgentMessageType,
    SndMsgData -> MsgFlags
msgFlags :: MsgFlags,
    SndMsgData -> ConnId
msgBody :: MsgBody,
    SndMsgData -> PQEncryption
pqEncryption :: PQEncryption,
    SndMsgData -> ConnId
internalHash :: MsgHash,
    SndMsgData -> ConnId
prevMsgHash :: MsgHash,
    SndMsgData -> Maybe SndMsgPrepData
sndMsgPrepData_ :: Maybe SndMsgPrepData
  }

data SndMsgPrepData = SndMsgPrepData
  { SndMsgPrepData -> MsgEncryptKeyX448
encryptKey :: MsgEncryptKeyX448,
    SndMsgPrepData -> Int
paddedLen :: Int,
    SndMsgPrepData -> UserId
sndMsgBodyId :: Int64
  }
  deriving (Int -> SndMsgPrepData -> ShowS
[SndMsgPrepData] -> ShowS
SndMsgPrepData -> String
(Int -> SndMsgPrepData -> ShowS)
-> (SndMsgPrepData -> String)
-> ([SndMsgPrepData] -> ShowS)
-> Show SndMsgPrepData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SndMsgPrepData -> ShowS
showsPrec :: Int -> SndMsgPrepData -> ShowS
$cshow :: SndMsgPrepData -> String
show :: SndMsgPrepData -> String
$cshowList :: [SndMsgPrepData] -> ShowS
showList :: [SndMsgPrepData] -> ShowS
Show)

data SndMsg = SndMsg
  { SndMsg -> InternalId
internalId :: InternalId,
    SndMsg -> InternalSndId
internalSndId :: InternalSndId,
    SndMsg -> AgentMessageType
msgType :: AgentMessageType,
    SndMsg -> ConnId
internalHash :: MsgHash,
    SndMsg -> Maybe MsgReceipt
msgReceipt :: Maybe MsgReceipt
  }

data PendingMsgData = PendingMsgData
  { PendingMsgData -> InternalId
msgId :: InternalId,
    PendingMsgData -> AgentMessageType
msgType :: AgentMessageType,
    PendingMsgData -> MsgFlags
msgFlags :: MsgFlags,
    PendingMsgData -> ConnId
msgBody :: MsgBody,
    PendingMsgData -> PQEncryption
pqEncryption :: PQEncryption,
    PendingMsgData -> Maybe RI2State
msgRetryState :: Maybe RI2State,
    PendingMsgData -> InternalTs
internalTs :: InternalTs,
    PendingMsgData -> InternalSndId
internalSndId :: InternalSndId,
    PendingMsgData -> ConnId
prevMsgHash :: PrevSndMsgHash,
    PendingMsgData -> Maybe PendingMsgPrepData
pendingMsgPrepData_ :: Maybe PendingMsgPrepData
  }
  deriving (Int -> PendingMsgData -> ShowS
[PendingMsgData] -> ShowS
PendingMsgData -> String
(Int -> PendingMsgData -> ShowS)
-> (PendingMsgData -> String)
-> ([PendingMsgData] -> ShowS)
-> Show PendingMsgData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PendingMsgData -> ShowS
showsPrec :: Int -> PendingMsgData -> ShowS
$cshow :: PendingMsgData -> String
show :: PendingMsgData -> String
$cshowList :: [PendingMsgData] -> ShowS
showList :: [PendingMsgData] -> ShowS
Show)

data PendingMsgPrepData = PendingMsgPrepData
  { PendingMsgPrepData -> MsgEncryptKeyX448
encryptKey :: MsgEncryptKeyX448,
    PendingMsgPrepData -> Int
paddedLen :: Int,
    PendingMsgPrepData -> AMessage
sndMsgBody :: AMessage
  }
  deriving (Int -> PendingMsgPrepData -> ShowS
[PendingMsgPrepData] -> ShowS
PendingMsgPrepData -> String
(Int -> PendingMsgPrepData -> ShowS)
-> (PendingMsgPrepData -> String)
-> ([PendingMsgPrepData] -> ShowS)
-> Show PendingMsgPrepData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PendingMsgPrepData -> ShowS
showsPrec :: Int -> PendingMsgPrepData -> ShowS
$cshow :: PendingMsgPrepData -> String
show :: PendingMsgPrepData -> String
$cshowList :: [PendingMsgPrepData] -> ShowS
showList :: [PendingMsgPrepData] -> ShowS
Show)

-- internal Ids are newtypes to prevent mixing them up
newtype InternalRcvId = InternalRcvId {InternalRcvId -> UserId
unRcvId :: Int64} deriving (InternalRcvId -> InternalRcvId -> Bool
(InternalRcvId -> InternalRcvId -> Bool)
-> (InternalRcvId -> InternalRcvId -> Bool) -> Eq InternalRcvId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InternalRcvId -> InternalRcvId -> Bool
== :: InternalRcvId -> InternalRcvId -> Bool
$c/= :: InternalRcvId -> InternalRcvId -> Bool
/= :: InternalRcvId -> InternalRcvId -> Bool
Eq, Int -> InternalRcvId -> ShowS
[InternalRcvId] -> ShowS
InternalRcvId -> String
(Int -> InternalRcvId -> ShowS)
-> (InternalRcvId -> String)
-> ([InternalRcvId] -> ShowS)
-> Show InternalRcvId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InternalRcvId -> ShowS
showsPrec :: Int -> InternalRcvId -> ShowS
$cshow :: InternalRcvId -> String
show :: InternalRcvId -> String
$cshowList :: [InternalRcvId] -> ShowS
showList :: [InternalRcvId] -> ShowS
Show)

type ExternalSndId = Int64

type ExternalSndTs = UTCTime

type BrokerId = MsgId

type BrokerTs = UTCTime

newtype InternalSndId = InternalSndId {InternalSndId -> UserId
unSndId :: Int64} deriving (InternalSndId -> InternalSndId -> Bool
(InternalSndId -> InternalSndId -> Bool)
-> (InternalSndId -> InternalSndId -> Bool) -> Eq InternalSndId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InternalSndId -> InternalSndId -> Bool
== :: InternalSndId -> InternalSndId -> Bool
$c/= :: InternalSndId -> InternalSndId -> Bool
/= :: InternalSndId -> InternalSndId -> Bool
Eq, Int -> InternalSndId -> ShowS
[InternalSndId] -> ShowS
InternalSndId -> String
(Int -> InternalSndId -> ShowS)
-> (InternalSndId -> String)
-> ([InternalSndId] -> ShowS)
-> Show InternalSndId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InternalSndId -> ShowS
showsPrec :: Int -> InternalSndId -> ShowS
$cshow :: InternalSndId -> String
show :: InternalSndId -> String
$cshowList :: [InternalSndId] -> ShowS
showList :: [InternalSndId] -> ShowS
Show)

-- | Base message data independent of direction.
data MsgBase = MsgBase
  { MsgBase -> ConnId
connId :: ConnId,
    -- | Monotonically increasing id of a message per connection, internal to the agent.
    -- Internal Id preserves ordering between both received and sent messages, and is needed
    -- to track the order of the conversation (which can be different for the sender / receiver)
    -- and address messages in commands. External [sender] Id cannot be used for this purpose
    -- due to a possibility of implementation errors in different agents.
    MsgBase -> InternalId
internalId :: InternalId,
    MsgBase -> InternalTs
internalTs :: InternalTs,
    MsgBase -> ConnId
msgBody :: MsgBody,
    -- | Hash of the message as computed by agent.
    MsgBase -> ConnId
internalHash :: MsgHash
  }
  deriving (MsgBase -> MsgBase -> Bool
(MsgBase -> MsgBase -> Bool)
-> (MsgBase -> MsgBase -> Bool) -> Eq MsgBase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgBase -> MsgBase -> Bool
== :: MsgBase -> MsgBase -> Bool
$c/= :: MsgBase -> MsgBase -> Bool
/= :: MsgBase -> MsgBase -> Bool
Eq, Int -> MsgBase -> ShowS
[MsgBase] -> ShowS
MsgBase -> String
(Int -> MsgBase -> ShowS)
-> (MsgBase -> String) -> ([MsgBase] -> ShowS) -> Show MsgBase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgBase -> ShowS
showsPrec :: Int -> MsgBase -> ShowS
$cshow :: MsgBase -> String
show :: MsgBase -> String
$cshowList :: [MsgBase] -> ShowS
showList :: [MsgBase] -> ShowS
Show)

newtype InternalId = InternalId {InternalId -> UserId
unId :: Int64} deriving (InternalId -> InternalId -> Bool
(InternalId -> InternalId -> Bool)
-> (InternalId -> InternalId -> Bool) -> Eq InternalId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InternalId -> InternalId -> Bool
== :: InternalId -> InternalId -> Bool
$c/= :: InternalId -> InternalId -> Bool
/= :: InternalId -> InternalId -> Bool
Eq, Int -> InternalId -> ShowS
[InternalId] -> ShowS
InternalId -> String
(Int -> InternalId -> ShowS)
-> (InternalId -> String)
-> ([InternalId] -> ShowS)
-> Show InternalId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InternalId -> ShowS
showsPrec :: Int -> InternalId -> ShowS
$cshow :: InternalId -> String
show :: InternalId -> String
$cshowList :: [InternalId] -> ShowS
showList :: [InternalId] -> ShowS
Show)

instance StrEncoding InternalId where
  strEncode :: InternalId -> ConnId
strEncode = UserId -> ConnId
forall a. StrEncoding a => a -> ConnId
strEncode (UserId -> ConnId)
-> (InternalId -> UserId) -> InternalId -> ConnId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalId -> UserId
unId
  strP :: Parser ConnId InternalId
strP = UserId -> InternalId
InternalId (UserId -> InternalId)
-> Parser ConnId UserId -> Parser ConnId InternalId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnId UserId
forall a. StrEncoding a => Parser a
strP

type InternalTs = UTCTime

type AsyncCmdId = Int64

-- * Store errors

-- | Agent store error.
data StoreError
  = -- | IO exceptions in store actions.
    SEInternal ByteString
  | -- | Database busy
    SEDatabaseBusy ByteString
  | -- | Failed to generate unique random ID
    SEUniqueID
  | -- | User ID not found
    SEUserNotFound
  | -- | Connection not found (or both queues absent).
    SEConnNotFound
  | -- | Server not found.
    SEServerNotFound
  | -- | Connection already used.
    SEConnDuplicate
  | -- | Confirmed snd queue already exists.
    SESndQueueExists
  | -- | Wrong connection type, e.g. "send" connection when "receive" or "duplex" is expected, or vice versa.
    -- 'upgradeRcvConnToDuplex' and 'upgradeSndConnToDuplex' do not allow duplex connections - they would also return this error.
    SEBadConnType String ConnType
  | -- | Confirmation not found.
    SEConfirmationNotFound
  | -- | Invitation not found
    SEInvitationNotFound String InvitationId
  | -- | Message not found
    SEMsgNotFound String
  | -- | Command not found
    SECmdNotFound
  | -- | Currently not used. The intention was to pass current expected queue status in methods,
    -- as we always know what it should be at any stage of the protocol,
    -- and in case it does not match use this error.
    SEBadQueueStatus
  | -- | connection does not have associated double-ratchet state
    SERatchetNotFound
  | -- | connection does not have associated x3dh keys
    SEX3dhKeysNotFound
  | -- | Used to wrap agent errors inside store operations to avoid race conditions
    SEAgentError AgentErrorType
  | -- | XFTP Server not found.
    SEXFTPServerNotFound
  | -- | XFTP File not found.
    SEFileNotFound
  | -- | XFTP Deleted snd chunk replica not found.
    SEDeletedSndChunkReplicaNotFound
  | -- | Error when reading work item that suspends worker - do not use!
    SEWorkItemError {StoreError -> String
errContext :: String}
  | -- | Servers stats not found.
    SEServersStatsNotFound
  deriving (StoreError -> StoreError -> Bool
(StoreError -> StoreError -> Bool)
-> (StoreError -> StoreError -> Bool) -> Eq StoreError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoreError -> StoreError -> Bool
== :: StoreError -> StoreError -> Bool
$c/= :: StoreError -> StoreError -> Bool
/= :: StoreError -> StoreError -> Bool
Eq, Int -> StoreError -> ShowS
[StoreError] -> ShowS
StoreError -> String
(Int -> StoreError -> ShowS)
-> (StoreError -> String)
-> ([StoreError] -> ShowS)
-> Show StoreError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoreError -> ShowS
showsPrec :: Int -> StoreError -> ShowS
$cshow :: StoreError -> String
show :: StoreError -> String
$cshowList :: [StoreError] -> ShowS
showList :: [StoreError] -> ShowS
Show, Show StoreError
Typeable StoreError
(Typeable StoreError, Show StoreError) =>
(StoreError -> SomeException)
-> (SomeException -> Maybe StoreError)
-> (StoreError -> String)
-> Exception StoreError
SomeException -> Maybe StoreError
StoreError -> String
StoreError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: StoreError -> SomeException
toException :: StoreError -> SomeException
$cfromException :: SomeException -> Maybe StoreError
fromException :: SomeException -> Maybe StoreError
$cdisplayException :: StoreError -> String
displayException :: StoreError -> String
Exception)

instance AnyError StoreError where
  fromSomeException :: SomeException -> StoreError
fromSomeException SomeException
e = ConnId -> StoreError
SEInternal (ConnId -> StoreError) -> ConnId -> StoreError
forall a b. (a -> b) -> a -> b
$ case SomeException -> Maybe SQLError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
    Just (SQLError
e' :: SQLError) -> SQLError -> ConnId
forall a. Show a => a -> ConnId
bshow SQLError
e'
    Maybe SQLError
Nothing -> SomeException -> ConnId
forall a. Show a => a -> ConnId
bshow SomeException
e

class (Show e, AnyError e) => AnyStoreError e where
  isWorkItemError :: e -> Bool
  mkWorkItemError :: String -> e

instance AnyStoreError StoreError where
  isWorkItemError :: StoreError -> Bool
isWorkItemError = \case
    SEWorkItemError {} -> Bool
True
    StoreError
_ -> Bool
False
  mkWorkItemError :: String -> StoreError
mkWorkItemError String
errContext = SEWorkItemError {String
$sel:errContext:SEInternal :: String
errContext :: String
errContext}