{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}

-- |
-- Module      : Simplex.Messaging.Agent.Protocol
-- Copyright   : (c) simplex.chat
-- License     : AGPL-3
--
-- Maintainer  : chat@simplex.chat
-- Stability   : experimental
-- Portability : non-portable
--
-- Types, parsers, serializers and functions to send and receive SMP agent protocol commands and responses.
--
-- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md
module Simplex.Messaging.Agent.Protocol
  ( -- * Protocol parameters
    VersionSMPA,
    VersionRangeSMPA,
    pattern VersionSMPA,
    duplexHandshakeSMPAgentVersion,
    ratchetSyncSMPAgentVersion,
    deliveryRcptsSMPAgentVersion,
    pqdrSMPAgentVersion,
    sndAuthKeySMPAgentVersion,
    ratchetOnConfSMPAgentVersion,
    currentSMPAgentVersion,
    supportedSMPAgentVRange,
    e2eEncConnInfoLength,
    e2eEncAgentMsgLength,

    -- * SMP agent protocol types
    ConnInfo,
    SndQueueSecured,
    AEntityId,
    ACommand (..),
    AEvent (..),
    AEvt (..),
    ACommandTag (..),
    AEventTag (..),
    AEvtTag (..),
    aCommandTag,
    aEventTag,
    AEntity (..),
    SAEntity (..),
    AEntityI (..),
    MsgHash,
    MsgMeta (..),
    RcvQueueInfo (..),
    SndQueueInfo (..),
    SubscriptionStatus (..),
    ConnectionStats (..),
    SwitchPhase (..),
    RcvSwitchStatus (..),
    SndSwitchStatus (..),
    QueueDirection (..),
    RatchetSyncState (..),
    SMPConfirmation (..),
    AgentMsgEnvelope (..),
    AgentMessage (..),
    AgentMessageType (..),
    APrivHeader (..),
    AMessage (..),
    AMessageReceipt (..),
    MsgReceipt (..),
    MsgReceiptInfo,
    MsgReceiptStatus (..),
    SndQAddr,
    SMPServer,
    pattern SMPServer,
    pattern ProtoServerWithAuth,
    SMPServerWithAuth,
    SrvLoc (..),
    SMPQueue (..),
    qAddress,
    sameQueue,
    sameQAddress,
    noAuthSrv,
    SMPQueueUri (..),
    SMPQueueInfo (..),
    SMPQueueAddress (..),
    ConnectionMode (..),
    SConnectionMode (..),
    AConnectionMode (..),
    ConnectionModeI (..),
    ConnectionRequestUri (..),
    AConnectionRequestUri (..),
    ShortLinkCreds (..),
    ConnReqUriData (..),
    CRClientData,
    ServiceScheme,
    FixedLinkData (..),
    AConnLinkData (..),
    ConnLinkData (..),
    AUserConnLinkData (..),
    UserConnLinkData (..),
    UserContactData (..),
    UserLinkData (..),
    OwnerAuth (..),
    OwnerId,
    ConnectionLink (..),
    AConnectionLink (..),
    ConnShortLink (..),
    AConnShortLink (..),
    CreatedConnLink (..),
    ACreatedConnLink (..),
    ContactConnType (..),
    ShortLinkScheme (..),
    LinkKey (..),
    PreparedLinkParams (..),
    StoredClientService (..),
    ClientService,
    ClientServiceId,
    validateOwners,
    validateLinkOwners,
    sameConnReqContact,
    sameShortLinkContact,
    simplexChat,
    connReqUriP',
    simplexConnReqUri,
    simplexShortLink,
    AgentErrorType (..),
    CommandErrorType (..),
    ConnectionErrorType (..),
    BrokerErrorType (..),
    SMPAgentError (..),
    DroppedMsg (..),
    AgentCryptoError (..),
    cryptoErrToSyncState,
    ATransmission,
    ConnId,
    ConfirmationId,
    InvitationId,
    MsgIntegrity (..),
    MsgErrorType (..),
    QueueStatus (..),
    UserId,
    ACorrId,
    AgentMsgId,
    NotificationsMode (..),
    NotificationInfo (..),
    ConnMsgReq (..),

    -- * Encode/decode
    serializeCommand,
    connMode,
    connMode',
    dbCommandP,
    connModeT,
    serializeQueueStatus,
    queueStatusT,
    agentMessageType,
    aMessageType,
    extraSMPServerHosts,
    updateSMPServerHosts,
    shortenShortLink,
    restoreShortLink,
    isPresetServer,
    linkUserData,
    linkUserData',
  )
where

import Control.Applicative (optional, (<|>))
import Control.Exception (BlockedIndefinitelyOnMVar (..), BlockedIndefinitelyOnSTM (..), fromException)
import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), (.:), (.:?))
import qualified Data.Aeson as J'
import qualified Data.Aeson.Encoding as JE
import qualified Data.Aeson.TH as J
import qualified Data.Aeson.Types as JT
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Base64.URL as B64
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Char (toLower, toUpper)
import Data.Foldable (find)
import Data.Functor (($>))
import Data.Int (Int64)
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.System (SystemTime)
import Data.Type.Equality
import Data.Typeable (Typeable)
import Data.Word (Word16, Word32)
import Simplex.FileTransfer.Description
import Simplex.FileTransfer.Protocol (FileParty (..))
import Simplex.FileTransfer.Transport (XFTPErrorType)
import Simplex.FileTransfer.Types (FileErrorType)
import Simplex.Messaging.Agent.QueryString
import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder, fromTextField_)
import Simplex.Messaging.Agent.Store.Entity
import Simplex.Messaging.Client (ProxyClientError)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet
  ( InitialKeys (..),
    PQEncryption (..),
    PQSupport,
    RcvE2ERatchetParams,
    RcvE2ERatchetParamsUri,
    SndE2ERatchetParams,
    pattern PQSupportOff,
    pattern PQSupportOn,
  )
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers
import Simplex.Messaging.Protocol
  ( AProtocolType,
    BrokerErrorType (..),
    ErrorType,
    MsgBody,
    MsgFlags,
    MsgId,
    NMsgMeta,
    ProtocolServer (..),
    QueueMode (..),
    SMPClientVersion,
    SMPServer,
    SMPServerWithAuth,
    SndPublicAuthKey,
    SubscriptionMode,
    VersionRangeSMPC,
    VersionSMPC,
    initialSMPClientVersion,
    legacyEncodeServer,
    legacyServerP,
    legacyStrEncodeServer,
    noAuthSrv,
    sameSrvAddr,
    senderCanSecure,
    shortLinksSMPClientVersion,
    sndAuthKeySMPClientVersion,
    srvHostnamesSMPClientVersion,
    pattern ProtoServerWithAuth,
    pattern SMPServer,
  )
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.ServiceScheme
import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts_ (..))
import Simplex.Messaging.Util
import Simplex.Messaging.Version
import Simplex.Messaging.Version.Internal
import Simplex.RemoteControl.Types
import UnliftIO.Exception (Exception)

-- SMP agent protocol version history:
-- 1 - binary protocol encoding (1/1/2022)
-- 2 - "duplex" (more efficient) connection handshake (6/9/2022)
-- 3 - support ratchet renegotiation (6/30/2023)
-- 4 - delivery receipts (7/13/2023)
-- 5 - post-quantum double ratchet (3/14/2024)
-- 6 - secure reply queues with provided keys (6/14/2024)
-- 7 - initialize ratchet on processing confirmation (7/18/2024)

data SMPAgentVersion

instance VersionScope SMPAgentVersion

type VersionSMPA = Version SMPAgentVersion

type VersionRangeSMPA = VersionRange SMPAgentVersion

pattern VersionSMPA :: Word16 -> VersionSMPA
pattern $mVersionSMPA :: forall {r}. VersionSMPA -> (Word16 -> r) -> ((# #) -> r) -> r
$bVersionSMPA :: Word16 -> VersionSMPA
VersionSMPA v = Version v

duplexHandshakeSMPAgentVersion :: VersionSMPA
duplexHandshakeSMPAgentVersion :: VersionSMPA
duplexHandshakeSMPAgentVersion = Word16 -> VersionSMPA
VersionSMPA Word16
2

ratchetSyncSMPAgentVersion :: VersionSMPA
ratchetSyncSMPAgentVersion :: VersionSMPA
ratchetSyncSMPAgentVersion = Word16 -> VersionSMPA
VersionSMPA Word16
3

deliveryRcptsSMPAgentVersion :: VersionSMPA
deliveryRcptsSMPAgentVersion :: VersionSMPA
deliveryRcptsSMPAgentVersion = Word16 -> VersionSMPA
VersionSMPA Word16
4

pqdrSMPAgentVersion :: VersionSMPA
pqdrSMPAgentVersion :: VersionSMPA
pqdrSMPAgentVersion = Word16 -> VersionSMPA
VersionSMPA Word16
5

sndAuthKeySMPAgentVersion :: VersionSMPA
sndAuthKeySMPAgentVersion :: VersionSMPA
sndAuthKeySMPAgentVersion = Word16 -> VersionSMPA
VersionSMPA Word16
6

ratchetOnConfSMPAgentVersion :: VersionSMPA
ratchetOnConfSMPAgentVersion :: VersionSMPA
ratchetOnConfSMPAgentVersion = Word16 -> VersionSMPA
VersionSMPA Word16
7

minSupportedSMPAgentVersion :: VersionSMPA
minSupportedSMPAgentVersion :: VersionSMPA
minSupportedSMPAgentVersion = VersionSMPA
duplexHandshakeSMPAgentVersion

currentSMPAgentVersion :: VersionSMPA
currentSMPAgentVersion :: VersionSMPA
currentSMPAgentVersion = Word16 -> VersionSMPA
VersionSMPA Word16
7

supportedSMPAgentVRange :: VersionRangeSMPA
supportedSMPAgentVRange :: VersionRangeSMPA
supportedSMPAgentVRange = VersionSMPA -> VersionSMPA -> VersionRangeSMPA
forall v. Version v -> Version v -> VersionRange v
mkVersionRange VersionSMPA
minSupportedSMPAgentVersion VersionSMPA
currentSMPAgentVersion

-- it is shorter to allow all handshake headers,
-- including E2E (double-ratchet) parameters and
-- signing key of the sender for the server
e2eEncConnInfoLength :: VersionSMPA -> PQSupport -> Int
e2eEncConnInfoLength :: VersionSMPA -> PQSupport -> Int
e2eEncConnInfoLength VersionSMPA
v = \case
  -- reduced by 3726 (roughly the increase of message ratchet header size + key and ciphertext in reply link)
  PQSupport
PQSupportOn | VersionSMPA
v VersionSMPA -> VersionSMPA -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
>= VersionSMPA
pqdrSMPAgentVersion -> Int
11106
  PQSupport
_ -> Int
14832

e2eEncAgentMsgLength :: VersionSMPA -> PQSupport -> Int
e2eEncAgentMsgLength :: VersionSMPA -> PQSupport -> Int
e2eEncAgentMsgLength VersionSMPA
v = \case
  -- reduced by 2222 (the increase of message ratchet header size)
  PQSupport
PQSupportOn | VersionSMPA
v VersionSMPA -> VersionSMPA -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
>= VersionSMPA
pqdrSMPAgentVersion -> Int
13618
  PQSupport
_ -> Int
15840

-- | SMP agent event
type ATransmission = (ACorrId, AEntityId, AEvt)

type UserId = Int64

type AEntityId = ByteString

type ACorrId = ByteString

data AEntity = AEConn | AERcvFile | AESndFile | AENone
  deriving (AEntity -> AEntity -> SndQueueSecured
(AEntity -> AEntity -> SndQueueSecured)
-> (AEntity -> AEntity -> SndQueueSecured) -> Eq AEntity
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: AEntity -> AEntity -> SndQueueSecured
== :: AEntity -> AEntity -> SndQueueSecured
$c/= :: AEntity -> AEntity -> SndQueueSecured
/= :: AEntity -> AEntity -> SndQueueSecured
Eq, Int -> AEntity -> ShowS
[AEntity] -> ShowS
AEntity -> FilePath
(Int -> AEntity -> ShowS)
-> (AEntity -> FilePath) -> ([AEntity] -> ShowS) -> Show AEntity
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AEntity -> ShowS
showsPrec :: Int -> AEntity -> ShowS
$cshow :: AEntity -> FilePath
show :: AEntity -> FilePath
$cshowList :: [AEntity] -> ShowS
showList :: [AEntity] -> ShowS
Show)

data SAEntity :: AEntity -> Type where
  SAEConn :: SAEntity AEConn
  SAERcvFile :: SAEntity AERcvFile
  SAESndFile :: SAEntity AESndFile
  SAENone :: SAEntity AENone

deriving instance Show (SAEntity e)

instance TestEquality SAEntity where
  testEquality :: forall (a :: AEntity) (b :: AEntity).
SAEntity a -> SAEntity b -> Maybe (a :~: b)
testEquality SAEntity a
SAEConn SAEntity b
SAEConn = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SAEntity a
SAERcvFile SAEntity b
SAERcvFile = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SAEntity a
SAESndFile SAEntity b
SAESndFile = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SAEntity a
SAENone SAEntity b
SAENone = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SAEntity a
_ SAEntity b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing

class AEntityI (e :: AEntity) where sAEntity :: SAEntity e

instance AEntityI AEConn where sAEntity :: SAEntity 'AEConn
sAEntity = SAEntity 'AEConn
SAEConn

instance AEntityI AERcvFile where sAEntity :: SAEntity 'AERcvFile
sAEntity = SAEntity 'AERcvFile
SAERcvFile

instance AEntityI AESndFile where sAEntity :: SAEntity 'AESndFile
sAEntity = SAEntity 'AESndFile
SAESndFile

instance AEntityI AENone where sAEntity :: SAEntity 'AENone
sAEntity = SAEntity 'AENone
SAENone

data AEvt = forall e. AEntityI e => AEvt (SAEntity e) (AEvent e)

instance Eq AEvt where
  AEvt SAEntity e
e AEvent e
evt == :: AEvt -> AEvt -> SndQueueSecured
== AEvt SAEntity e
e' AEvent e
evt' = case SAEntity e -> SAEntity e -> Maybe (e :~: e)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: AEntity) (b :: AEntity).
SAEntity a -> SAEntity b -> Maybe (a :~: b)
testEquality SAEntity e
e SAEntity e
e' of
    Just e :~: e
Refl -> AEvent e
evt AEvent e -> AEvent e -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== AEvent e
AEvent e
evt'
    Maybe (e :~: e)
Nothing -> SndQueueSecured
False

deriving instance Show AEvt

type ConnInfo = ByteString

type SndQueueSecured = Bool

-- | Parameterized type for SMP agent events
data AEvent (e :: AEntity) where
  INV :: AConnectionRequestUri -> Maybe ClientServiceId -> AEvent AEConn
  LINK :: ConnShortLink 'CMContact -> UserConnLinkData 'CMContact -> AEvent AEConn
  LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> AEvent AEConn
  CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake
  REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender
  INFO :: PQSupport -> ConnInfo -> AEvent AEConn
  CON :: PQEncryption -> AEvent AEConn -- notification that connection is established
  END :: AEvent AEConn
  DELD :: AEvent AEConn
  CONNECT :: AProtocolType -> TransportHost -> AEvent AENone
  DISCONNECT :: AProtocolType -> TransportHost -> AEvent AENone
  DOWN :: SMPServer -> [ConnId] -> AEvent AENone
  UP :: SMPServer -> [ConnId] -> AEvent AENone
  SWITCH :: QueueDirection -> SwitchPhase -> ConnectionStats -> AEvent AEConn
  RSYNC :: RatchetSyncState -> Maybe AgentCryptoError -> ConnectionStats -> AEvent AEConn
  SENT :: AgentMsgId -> Maybe SMPServer -> AEvent AEConn
  MWARN :: AgentMsgId -> AgentErrorType -> AEvent AEConn
  MERR :: AgentMsgId -> AgentErrorType -> AEvent AEConn
  MERRS :: NonEmpty AgentMsgId -> AgentErrorType -> AEvent AEConn
  MSG :: MsgMeta -> MsgFlags -> MsgBody -> AEvent AEConn
  MSGNTF :: MsgId -> Maybe UTCTime -> AEvent AEConn
  RCVD :: MsgMeta -> NonEmpty MsgReceipt -> AEvent AEConn
  QCONT :: AEvent AEConn
  DEL_RCVQS :: NonEmpty (ConnId, SMPServer, SMP.RecipientId, Maybe AgentErrorType) -> AEvent AEConn
  DEL_CONNS :: NonEmpty ConnId -> AEvent AEConn
  DEL_USER :: Int64 -> AEvent AENone
  STAT :: ConnectionStats -> AEvent AEConn
  OK :: AEvent AEConn
  JOINED :: SndQueueSecured -> Maybe ClientServiceId -> AEvent AEConn
  ERR :: AgentErrorType -> AEvent AEConn
  ERRS :: NonEmpty (ConnId, AgentErrorType) -> AEvent AENone
  SUSPENDED :: AEvent AENone
  RFPROG :: Int64 -> Int64 -> AEvent AERcvFile
  RFDONE :: FilePath -> AEvent AERcvFile
  RFERR :: AgentErrorType -> AEvent AERcvFile
  RFWARN :: AgentErrorType -> AEvent AERcvFile
  SFPROG :: Int64 -> Int64 -> AEvent AESndFile
  SFDONE :: ValidFileDescription 'FSender -> [ValidFileDescription 'FRecipient] -> AEvent AESndFile
  SFERR :: AgentErrorType -> AEvent AESndFile
  SFWARN :: AgentErrorType -> AEvent AESndFile

deriving instance Eq (AEvent e)

deriving instance Show (AEvent e)

data AEvtTag = forall e. AEntityI e => AEvtTag (SAEntity e) (AEventTag e)

instance Eq AEvtTag where
  AEvtTag SAEntity e
e AEventTag e
evt == :: AEvtTag -> AEvtTag -> SndQueueSecured
== AEvtTag SAEntity e
e' AEventTag e
evt' = case SAEntity e -> SAEntity e -> Maybe (e :~: e)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: AEntity) (b :: AEntity).
SAEntity a -> SAEntity b -> Maybe (a :~: b)
testEquality SAEntity e
e SAEntity e
e' of
    Just e :~: e
Refl -> AEventTag e
evt AEventTag e -> AEventTag e -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== AEventTag e
AEventTag e
evt'
    Maybe (e :~: e)
Nothing -> SndQueueSecured
False

deriving instance Show AEvtTag

data ACommand
  = NEW Bool AConnectionMode InitialKeys SubscriptionMode -- response INV
  | LSET (UserConnLinkData 'CMContact) (Maybe CRClientData) -- response LINK
  | LGET (ConnShortLink 'CMContact) -- response LDATA
  | JOIN Bool AConnectionRequestUri PQSupport SubscriptionMode ConnInfo
  | LET ConfirmationId ConnInfo -- ConnInfo is from client
  | ACK AgentMsgId (Maybe MsgReceiptInfo)
  | SWCH
  | DEL
  deriving (ACommand -> ACommand -> SndQueueSecured
(ACommand -> ACommand -> SndQueueSecured)
-> (ACommand -> ACommand -> SndQueueSecured) -> Eq ACommand
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: ACommand -> ACommand -> SndQueueSecured
== :: ACommand -> ACommand -> SndQueueSecured
$c/= :: ACommand -> ACommand -> SndQueueSecured
/= :: ACommand -> ACommand -> SndQueueSecured
Eq, Int -> ACommand -> ShowS
[ACommand] -> ShowS
ACommand -> FilePath
(Int -> ACommand -> ShowS)
-> (ACommand -> FilePath) -> ([ACommand] -> ShowS) -> Show ACommand
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ACommand -> ShowS
showsPrec :: Int -> ACommand -> ShowS
$cshow :: ACommand -> FilePath
show :: ACommand -> FilePath
$cshowList :: [ACommand] -> ShowS
showList :: [ACommand] -> ShowS
Show)

data ACommandTag
  = NEW_
  | LSET_
  | LGET_
  | JOIN_
  | LET_
  | ACK_
  | SWCH_
  | DEL_
  deriving (Int -> ACommandTag -> ShowS
[ACommandTag] -> ShowS
ACommandTag -> FilePath
(Int -> ACommandTag -> ShowS)
-> (ACommandTag -> FilePath)
-> ([ACommandTag] -> ShowS)
-> Show ACommandTag
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ACommandTag -> ShowS
showsPrec :: Int -> ACommandTag -> ShowS
$cshow :: ACommandTag -> FilePath
show :: ACommandTag -> FilePath
$cshowList :: [ACommandTag] -> ShowS
showList :: [ACommandTag] -> ShowS
Show)

data AEventTag (e :: AEntity) where
  INV_ :: AEventTag AEConn
  LINK_ :: AEventTag AEConn
  LDATA_ :: AEventTag AEConn
  CONF_ :: AEventTag AEConn
  REQ_ :: AEventTag AEConn
  INFO_ :: AEventTag AEConn
  CON_ :: AEventTag AEConn
  END_ :: AEventTag AEConn
  DELD_ :: AEventTag AEConn
  CONNECT_ :: AEventTag AENone
  DISCONNECT_ :: AEventTag AENone
  DOWN_ :: AEventTag AENone
  UP_ :: AEventTag AENone
  SWITCH_ :: AEventTag AEConn
  RSYNC_ :: AEventTag AEConn
  SENT_ :: AEventTag AEConn
  MWARN_ :: AEventTag AEConn
  MERR_ :: AEventTag AEConn
  MERRS_ :: AEventTag AEConn
  MSG_ :: AEventTag AEConn
  MSGNTF_ :: AEventTag AEConn
  RCVD_ :: AEventTag AEConn
  QCONT_ :: AEventTag AEConn
  DEL_RCVQS_ :: AEventTag AEConn
  DEL_CONNS_ :: AEventTag AEConn
  DEL_USER_ :: AEventTag AENone
  STAT_ :: AEventTag AEConn
  OK_ :: AEventTag AEConn
  JOINED_ :: AEventTag AEConn
  ERR_ :: AEventTag AEConn
  ERRS_ :: AEventTag AENone
  SUSPENDED_ :: AEventTag AENone
  -- XFTP commands and responses
  RFDONE_ :: AEventTag AERcvFile
  RFPROG_ :: AEventTag AERcvFile
  RFERR_ :: AEventTag AERcvFile
  RFWARN_ :: AEventTag AERcvFile
  SFPROG_ :: AEventTag AESndFile
  SFDONE_ :: AEventTag AESndFile
  SFERR_ :: AEventTag AESndFile
  SFWARN_ :: AEventTag AESndFile

deriving instance Eq (AEventTag e)

deriving instance Show (AEventTag e)

aCommandTag :: ACommand -> ACommandTag
aCommandTag :: ACommand -> ACommandTag
aCommandTag = \case
  NEW {} -> ACommandTag
NEW_
  LSET {} -> ACommandTag
LSET_
  LGET ConnShortLink 'CMContact
_ -> ACommandTag
LGET_
  JOIN {} -> ACommandTag
JOIN_
  LET {} -> ACommandTag
LET_
  ACK {} -> ACommandTag
ACK_
  ACommand
SWCH -> ACommandTag
SWCH_
  ACommand
DEL -> ACommandTag
DEL_

aEventTag :: AEvent e -> AEventTag e
aEventTag :: forall (e :: AEntity). AEvent e -> AEventTag e
aEventTag = \case
  INV {} -> AEventTag e
AEventTag 'AEConn
INV_
  LINK {} -> AEventTag e
AEventTag 'AEConn
LINK_
  LDATA {} -> AEventTag e
AEventTag 'AEConn
LDATA_
  CONF {} -> AEventTag e
AEventTag 'AEConn
CONF_
  REQ {} -> AEventTag e
AEventTag 'AEConn
REQ_
  INFO {} -> AEventTag e
AEventTag 'AEConn
INFO_
  CON PQEncryption
_ -> AEventTag e
AEventTag 'AEConn
CON_
  AEvent e
END -> AEventTag e
AEventTag 'AEConn
END_
  AEvent e
DELD -> AEventTag e
AEventTag 'AEConn
DELD_
  CONNECT {} -> AEventTag e
AEventTag 'AENone
CONNECT_
  DISCONNECT {} -> AEventTag e
AEventTag 'AENone
DISCONNECT_
  DOWN {} -> AEventTag e
AEventTag 'AENone
DOWN_
  UP {} -> AEventTag e
AEventTag 'AENone
UP_
  SWITCH {} -> AEventTag e
AEventTag 'AEConn
SWITCH_
  RSYNC {} -> AEventTag e
AEventTag 'AEConn
RSYNC_
  SENT {} -> AEventTag e
AEventTag 'AEConn
SENT_
  MWARN {} -> AEventTag e
AEventTag 'AEConn
MWARN_
  MERR {} -> AEventTag e
AEventTag 'AEConn
MERR_
  MERRS {} -> AEventTag e
AEventTag 'AEConn
MERRS_
  MSG {} -> AEventTag e
AEventTag 'AEConn
MSG_
  MSGNTF {} -> AEventTag e
AEventTag 'AEConn
MSGNTF_
  RCVD {} -> AEventTag e
AEventTag 'AEConn
RCVD_
  AEvent e
QCONT -> AEventTag e
AEventTag 'AEConn
QCONT_
  DEL_RCVQS NonEmpty (ConfirmationId, SMPServer, LinkId, Maybe AgentErrorType)
_ -> AEventTag e
AEventTag 'AEConn
DEL_RCVQS_
  DEL_CONNS NonEmpty ConfirmationId
_ -> AEventTag e
AEventTag 'AEConn
DEL_CONNS_
  DEL_USER AgentMsgId
_ -> AEventTag e
AEventTag 'AENone
DEL_USER_
  STAT ConnectionStats
_ -> AEventTag e
AEventTag 'AEConn
STAT_
  AEvent e
OK -> AEventTag e
AEventTag 'AEConn
OK_
  JOINED {} -> AEventTag e
AEventTag 'AEConn
JOINED_
  ERR AgentErrorType
_ -> AEventTag e
AEventTag 'AEConn
ERR_
  ERRS NonEmpty (ConfirmationId, AgentErrorType)
_ -> AEventTag e
AEventTag 'AENone
ERRS_
  AEvent e
SUSPENDED -> AEventTag e
AEventTag 'AENone
SUSPENDED_
  RFPROG {} -> AEventTag e
AEventTag 'AERcvFile
RFPROG_
  RFDONE {} -> AEventTag e
AEventTag 'AERcvFile
RFDONE_
  RFERR {} -> AEventTag e
AEventTag 'AERcvFile
RFERR_
  RFWARN {} -> AEventTag e
AEventTag 'AERcvFile
RFWARN_
  SFPROG {} -> AEventTag e
AEventTag 'AESndFile
SFPROG_
  SFDONE {} -> AEventTag e
AEventTag 'AESndFile
SFDONE_
  SFERR {} -> AEventTag e
AEventTag 'AESndFile
SFERR_
  SFWARN {} -> AEventTag e
AEventTag 'AESndFile
SFWARN_

data QueueDirection = QDRcv | QDSnd
  deriving (QueueDirection -> QueueDirection -> SndQueueSecured
(QueueDirection -> QueueDirection -> SndQueueSecured)
-> (QueueDirection -> QueueDirection -> SndQueueSecured)
-> Eq QueueDirection
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: QueueDirection -> QueueDirection -> SndQueueSecured
== :: QueueDirection -> QueueDirection -> SndQueueSecured
$c/= :: QueueDirection -> QueueDirection -> SndQueueSecured
/= :: QueueDirection -> QueueDirection -> SndQueueSecured
Eq, Int -> QueueDirection -> ShowS
[QueueDirection] -> ShowS
QueueDirection -> FilePath
(Int -> QueueDirection -> ShowS)
-> (QueueDirection -> FilePath)
-> ([QueueDirection] -> ShowS)
-> Show QueueDirection
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueueDirection -> ShowS
showsPrec :: Int -> QueueDirection -> ShowS
$cshow :: QueueDirection -> FilePath
show :: QueueDirection -> FilePath
$cshowList :: [QueueDirection] -> ShowS
showList :: [QueueDirection] -> ShowS
Show)

data SwitchPhase = SPStarted | SPConfirmed | SPSecured | SPCompleted
  deriving (SwitchPhase -> SwitchPhase -> SndQueueSecured
(SwitchPhase -> SwitchPhase -> SndQueueSecured)
-> (SwitchPhase -> SwitchPhase -> SndQueueSecured)
-> Eq SwitchPhase
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: SwitchPhase -> SwitchPhase -> SndQueueSecured
== :: SwitchPhase -> SwitchPhase -> SndQueueSecured
$c/= :: SwitchPhase -> SwitchPhase -> SndQueueSecured
/= :: SwitchPhase -> SwitchPhase -> SndQueueSecured
Eq, Int -> SwitchPhase -> ShowS
[SwitchPhase] -> ShowS
SwitchPhase -> FilePath
(Int -> SwitchPhase -> ShowS)
-> (SwitchPhase -> FilePath)
-> ([SwitchPhase] -> ShowS)
-> Show SwitchPhase
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SwitchPhase -> ShowS
showsPrec :: Int -> SwitchPhase -> ShowS
$cshow :: SwitchPhase -> FilePath
show :: SwitchPhase -> FilePath
$cshowList :: [SwitchPhase] -> ShowS
showList :: [SwitchPhase] -> ShowS
Show)

data RcvSwitchStatus
  = RSSwitchStarted
  | RSSendingQADD
  | RSSendingQUSE
  | RSReceivedMessage
  deriving (RcvSwitchStatus -> RcvSwitchStatus -> SndQueueSecured
(RcvSwitchStatus -> RcvSwitchStatus -> SndQueueSecured)
-> (RcvSwitchStatus -> RcvSwitchStatus -> SndQueueSecured)
-> Eq RcvSwitchStatus
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: RcvSwitchStatus -> RcvSwitchStatus -> SndQueueSecured
== :: RcvSwitchStatus -> RcvSwitchStatus -> SndQueueSecured
$c/= :: RcvSwitchStatus -> RcvSwitchStatus -> SndQueueSecured
/= :: RcvSwitchStatus -> RcvSwitchStatus -> SndQueueSecured
Eq, Int -> RcvSwitchStatus -> ShowS
[RcvSwitchStatus] -> ShowS
RcvSwitchStatus -> FilePath
(Int -> RcvSwitchStatus -> ShowS)
-> (RcvSwitchStatus -> FilePath)
-> ([RcvSwitchStatus] -> ShowS)
-> Show RcvSwitchStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RcvSwitchStatus -> ShowS
showsPrec :: Int -> RcvSwitchStatus -> ShowS
$cshow :: RcvSwitchStatus -> FilePath
show :: RcvSwitchStatus -> FilePath
$cshowList :: [RcvSwitchStatus] -> ShowS
showList :: [RcvSwitchStatus] -> ShowS
Show)

instance StrEncoding RcvSwitchStatus where
  strEncode :: RcvSwitchStatus -> ConfirmationId
strEncode = \case
    RcvSwitchStatus
RSSwitchStarted -> ConfirmationId
"switch_started"
    RcvSwitchStatus
RSSendingQADD -> ConfirmationId
"sending_qadd"
    RcvSwitchStatus
RSSendingQUSE -> ConfirmationId
"sending_quse"
    RcvSwitchStatus
RSReceivedMessage -> ConfirmationId
"received_message"
  strP :: Parser RcvSwitchStatus
strP =
    (Char -> SndQueueSecured) -> Parser ConfirmationId ConfirmationId
A.takeTill (Char -> Char -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== Char
' ') Parser ConfirmationId ConfirmationId
-> (ConfirmationId -> Parser RcvSwitchStatus)
-> Parser RcvSwitchStatus
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConfirmationId
"switch_started" -> RcvSwitchStatus -> Parser RcvSwitchStatus
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvSwitchStatus
RSSwitchStarted
      ConfirmationId
"sending_qadd" -> RcvSwitchStatus -> Parser RcvSwitchStatus
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvSwitchStatus
RSSendingQADD
      ConfirmationId
"sending_quse" -> RcvSwitchStatus -> Parser RcvSwitchStatus
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvSwitchStatus
RSSendingQUSE
      ConfirmationId
"received_message" -> RcvSwitchStatus -> Parser RcvSwitchStatus
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvSwitchStatus
RSReceivedMessage
      ConfirmationId
_ -> FilePath -> Parser RcvSwitchStatus
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad RcvSwitchStatus"

instance ToField RcvSwitchStatus where toField :: RcvSwitchStatus -> SQLData
toField = CRClientData -> SQLData
forall a. ToField a => a -> SQLData
toField (CRClientData -> SQLData)
-> (RcvSwitchStatus -> CRClientData) -> RcvSwitchStatus -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> CRClientData
decodeLatin1 (ConfirmationId -> CRClientData)
-> (RcvSwitchStatus -> ConfirmationId)
-> RcvSwitchStatus
-> CRClientData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RcvSwitchStatus -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode

instance FromField RcvSwitchStatus where fromField :: FieldParser RcvSwitchStatus
fromField = (CRClientData -> Maybe RcvSwitchStatus)
-> FieldParser RcvSwitchStatus
forall a. Typeable a => (CRClientData -> Maybe a) -> Field -> Ok a
fromTextField_ ((CRClientData -> Maybe RcvSwitchStatus)
 -> FieldParser RcvSwitchStatus)
-> (CRClientData -> Maybe RcvSwitchStatus)
-> FieldParser RcvSwitchStatus
forall a b. (a -> b) -> a -> b
$ Either FilePath RcvSwitchStatus -> Maybe RcvSwitchStatus
forall a b. Either a b -> Maybe b
eitherToMaybe (Either FilePath RcvSwitchStatus -> Maybe RcvSwitchStatus)
-> (CRClientData -> Either FilePath RcvSwitchStatus)
-> CRClientData
-> Maybe RcvSwitchStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> Either FilePath RcvSwitchStatus
forall a. StrEncoding a => ConfirmationId -> Either FilePath a
strDecode (ConfirmationId -> Either FilePath RcvSwitchStatus)
-> (CRClientData -> ConfirmationId)
-> CRClientData
-> Either FilePath RcvSwitchStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRClientData -> ConfirmationId
encodeUtf8

instance ToJSON RcvSwitchStatus where
  toEncoding :: RcvSwitchStatus -> Encoding
toEncoding = RcvSwitchStatus -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding
  toJSON :: RcvSwitchStatus -> Value
toJSON = RcvSwitchStatus -> Value
forall a. StrEncoding a => a -> Value
strToJSON

instance FromJSON RcvSwitchStatus where
  parseJSON :: Value -> Parser RcvSwitchStatus
parseJSON = FilePath -> Value -> Parser RcvSwitchStatus
forall a. StrEncoding a => FilePath -> Value -> Parser a
strParseJSON FilePath
"RcvSwitchStatus"

data SndSwitchStatus
  = SSSendingQKEY
  | SSSendingQTEST
  deriving (SndSwitchStatus -> SndSwitchStatus -> SndQueueSecured
(SndSwitchStatus -> SndSwitchStatus -> SndQueueSecured)
-> (SndSwitchStatus -> SndSwitchStatus -> SndQueueSecured)
-> Eq SndSwitchStatus
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: SndSwitchStatus -> SndSwitchStatus -> SndQueueSecured
== :: SndSwitchStatus -> SndSwitchStatus -> SndQueueSecured
$c/= :: SndSwitchStatus -> SndSwitchStatus -> SndQueueSecured
/= :: SndSwitchStatus -> SndSwitchStatus -> SndQueueSecured
Eq, Int -> SndSwitchStatus -> ShowS
[SndSwitchStatus] -> ShowS
SndSwitchStatus -> FilePath
(Int -> SndSwitchStatus -> ShowS)
-> (SndSwitchStatus -> FilePath)
-> ([SndSwitchStatus] -> ShowS)
-> Show SndSwitchStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SndSwitchStatus -> ShowS
showsPrec :: Int -> SndSwitchStatus -> ShowS
$cshow :: SndSwitchStatus -> FilePath
show :: SndSwitchStatus -> FilePath
$cshowList :: [SndSwitchStatus] -> ShowS
showList :: [SndSwitchStatus] -> ShowS
Show)

instance StrEncoding SndSwitchStatus where
  strEncode :: SndSwitchStatus -> ConfirmationId
strEncode = \case
    SndSwitchStatus
SSSendingQKEY -> ConfirmationId
"sending_qkey"
    SndSwitchStatus
SSSendingQTEST -> ConfirmationId
"sending_qtest"
  strP :: Parser SndSwitchStatus
strP =
    (Char -> SndQueueSecured) -> Parser ConfirmationId ConfirmationId
A.takeTill (Char -> Char -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== Char
' ') Parser ConfirmationId ConfirmationId
-> (ConfirmationId -> Parser SndSwitchStatus)
-> Parser SndSwitchStatus
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConfirmationId
"sending_qkey" -> SndSwitchStatus -> Parser SndSwitchStatus
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndSwitchStatus
SSSendingQKEY
      ConfirmationId
"sending_qtest" -> SndSwitchStatus -> Parser SndSwitchStatus
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SndSwitchStatus
SSSendingQTEST
      ConfirmationId
_ -> FilePath -> Parser SndSwitchStatus
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad SndSwitchStatus"

instance ToField SndSwitchStatus where toField :: SndSwitchStatus -> SQLData
toField = CRClientData -> SQLData
forall a. ToField a => a -> SQLData
toField (CRClientData -> SQLData)
-> (SndSwitchStatus -> CRClientData) -> SndSwitchStatus -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> CRClientData
decodeLatin1 (ConfirmationId -> CRClientData)
-> (SndSwitchStatus -> ConfirmationId)
-> SndSwitchStatus
-> CRClientData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SndSwitchStatus -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode

instance FromField SndSwitchStatus where fromField :: FieldParser SndSwitchStatus
fromField = (CRClientData -> Maybe SndSwitchStatus)
-> FieldParser SndSwitchStatus
forall a. Typeable a => (CRClientData -> Maybe a) -> Field -> Ok a
fromTextField_ ((CRClientData -> Maybe SndSwitchStatus)
 -> FieldParser SndSwitchStatus)
-> (CRClientData -> Maybe SndSwitchStatus)
-> FieldParser SndSwitchStatus
forall a b. (a -> b) -> a -> b
$ Either FilePath SndSwitchStatus -> Maybe SndSwitchStatus
forall a b. Either a b -> Maybe b
eitherToMaybe (Either FilePath SndSwitchStatus -> Maybe SndSwitchStatus)
-> (CRClientData -> Either FilePath SndSwitchStatus)
-> CRClientData
-> Maybe SndSwitchStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> Either FilePath SndSwitchStatus
forall a. StrEncoding a => ConfirmationId -> Either FilePath a
strDecode (ConfirmationId -> Either FilePath SndSwitchStatus)
-> (CRClientData -> ConfirmationId)
-> CRClientData
-> Either FilePath SndSwitchStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRClientData -> ConfirmationId
encodeUtf8

instance ToJSON SndSwitchStatus where
  toEncoding :: SndSwitchStatus -> Encoding
toEncoding = SndSwitchStatus -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding
  toJSON :: SndSwitchStatus -> Value
toJSON = SndSwitchStatus -> Value
forall a. StrEncoding a => a -> Value
strToJSON

instance FromJSON SndSwitchStatus where
  parseJSON :: Value -> Parser SndSwitchStatus
parseJSON = FilePath -> Value -> Parser SndSwitchStatus
forall a. StrEncoding a => FilePath -> Value -> Parser a
strParseJSON FilePath
"SndSwitchStatus"

data RatchetSyncState
  = RSOk
  | RSAllowed
  | RSRequired
  | RSStarted
  | RSAgreed
  deriving (RatchetSyncState -> RatchetSyncState -> SndQueueSecured
(RatchetSyncState -> RatchetSyncState -> SndQueueSecured)
-> (RatchetSyncState -> RatchetSyncState -> SndQueueSecured)
-> Eq RatchetSyncState
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: RatchetSyncState -> RatchetSyncState -> SndQueueSecured
== :: RatchetSyncState -> RatchetSyncState -> SndQueueSecured
$c/= :: RatchetSyncState -> RatchetSyncState -> SndQueueSecured
/= :: RatchetSyncState -> RatchetSyncState -> SndQueueSecured
Eq, Int -> RatchetSyncState -> ShowS
[RatchetSyncState] -> ShowS
RatchetSyncState -> FilePath
(Int -> RatchetSyncState -> ShowS)
-> (RatchetSyncState -> FilePath)
-> ([RatchetSyncState] -> ShowS)
-> Show RatchetSyncState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RatchetSyncState -> ShowS
showsPrec :: Int -> RatchetSyncState -> ShowS
$cshow :: RatchetSyncState -> FilePath
show :: RatchetSyncState -> FilePath
$cshowList :: [RatchetSyncState] -> ShowS
showList :: [RatchetSyncState] -> ShowS
Show)

instance StrEncoding RatchetSyncState where
  strEncode :: RatchetSyncState -> ConfirmationId
strEncode = \case
    RatchetSyncState
RSOk -> ConfirmationId
"ok"
    RatchetSyncState
RSAllowed -> ConfirmationId
"allowed"
    RatchetSyncState
RSRequired -> ConfirmationId
"required"
    RatchetSyncState
RSStarted -> ConfirmationId
"started"
    RatchetSyncState
RSAgreed -> ConfirmationId
"agreed"
  strP :: Parser RatchetSyncState
strP =
    (Char -> SndQueueSecured) -> Parser ConfirmationId ConfirmationId
A.takeTill (Char -> Char -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== Char
' ') Parser ConfirmationId ConfirmationId
-> (ConfirmationId -> Parser RatchetSyncState)
-> Parser RatchetSyncState
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConfirmationId
"ok" -> RatchetSyncState -> Parser RatchetSyncState
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RatchetSyncState
RSOk
      ConfirmationId
"allowed" -> RatchetSyncState -> Parser RatchetSyncState
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RatchetSyncState
RSAllowed
      ConfirmationId
"required" -> RatchetSyncState -> Parser RatchetSyncState
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RatchetSyncState
RSRequired
      ConfirmationId
"started" -> RatchetSyncState -> Parser RatchetSyncState
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RatchetSyncState
RSStarted
      ConfirmationId
"agreed" -> RatchetSyncState -> Parser RatchetSyncState
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RatchetSyncState
RSAgreed
      ConfirmationId
_ -> FilePath -> Parser RatchetSyncState
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad RatchetSyncState"

instance FromField RatchetSyncState where fromField :: FieldParser RatchetSyncState
fromField = (CRClientData -> Maybe RatchetSyncState)
-> FieldParser RatchetSyncState
forall a. Typeable a => (CRClientData -> Maybe a) -> Field -> Ok a
fromTextField_ ((CRClientData -> Maybe RatchetSyncState)
 -> FieldParser RatchetSyncState)
-> (CRClientData -> Maybe RatchetSyncState)
-> FieldParser RatchetSyncState
forall a b. (a -> b) -> a -> b
$ Either FilePath RatchetSyncState -> Maybe RatchetSyncState
forall a b. Either a b -> Maybe b
eitherToMaybe (Either FilePath RatchetSyncState -> Maybe RatchetSyncState)
-> (CRClientData -> Either FilePath RatchetSyncState)
-> CRClientData
-> Maybe RatchetSyncState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> Either FilePath RatchetSyncState
forall a. StrEncoding a => ConfirmationId -> Either FilePath a
strDecode (ConfirmationId -> Either FilePath RatchetSyncState)
-> (CRClientData -> ConfirmationId)
-> CRClientData
-> Either FilePath RatchetSyncState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRClientData -> ConfirmationId
encodeUtf8

instance ToField RatchetSyncState where toField :: RatchetSyncState -> SQLData
toField = CRClientData -> SQLData
forall a. ToField a => a -> SQLData
toField (CRClientData -> SQLData)
-> (RatchetSyncState -> CRClientData)
-> RatchetSyncState
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> CRClientData
decodeLatin1 (ConfirmationId -> CRClientData)
-> (RatchetSyncState -> ConfirmationId)
-> RatchetSyncState
-> CRClientData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatchetSyncState -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode

instance ToJSON RatchetSyncState where
  toEncoding :: RatchetSyncState -> Encoding
toEncoding = RatchetSyncState -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding
  toJSON :: RatchetSyncState -> Value
toJSON = RatchetSyncState -> Value
forall a. StrEncoding a => a -> Value
strToJSON

instance FromJSON RatchetSyncState where
  parseJSON :: Value -> Parser RatchetSyncState
parseJSON = FilePath -> Value -> Parser RatchetSyncState
forall a. StrEncoding a => FilePath -> Value -> Parser a
strParseJSON FilePath
"RatchetSyncState"

data RcvQueueInfo = RcvQueueInfo
  { RcvQueueInfo -> SMPServer
rcvServer :: SMPServer,
    RcvQueueInfo -> QueueStatus
status :: QueueStatus,
    RcvQueueInfo -> Maybe RcvSwitchStatus
rcvSwitchStatus :: Maybe RcvSwitchStatus,
    RcvQueueInfo -> SndQueueSecured
canAbortSwitch :: Bool,
    RcvQueueInfo -> SubscriptionStatus
subStatus :: SubscriptionStatus
  }
  deriving (RcvQueueInfo -> RcvQueueInfo -> SndQueueSecured
(RcvQueueInfo -> RcvQueueInfo -> SndQueueSecured)
-> (RcvQueueInfo -> RcvQueueInfo -> SndQueueSecured)
-> Eq RcvQueueInfo
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: RcvQueueInfo -> RcvQueueInfo -> SndQueueSecured
== :: RcvQueueInfo -> RcvQueueInfo -> SndQueueSecured
$c/= :: RcvQueueInfo -> RcvQueueInfo -> SndQueueSecured
/= :: RcvQueueInfo -> RcvQueueInfo -> SndQueueSecured
Eq, Int -> RcvQueueInfo -> ShowS
[RcvQueueInfo] -> ShowS
RcvQueueInfo -> FilePath
(Int -> RcvQueueInfo -> ShowS)
-> (RcvQueueInfo -> FilePath)
-> ([RcvQueueInfo] -> ShowS)
-> Show RcvQueueInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RcvQueueInfo -> ShowS
showsPrec :: Int -> RcvQueueInfo -> ShowS
$cshow :: RcvQueueInfo -> FilePath
show :: RcvQueueInfo -> FilePath
$cshowList :: [RcvQueueInfo] -> ShowS
showList :: [RcvQueueInfo] -> ShowS
Show)

data SndQueueInfo = SndQueueInfo
  { SndQueueInfo -> SMPServer
sndServer :: SMPServer,
    SndQueueInfo -> QueueStatus
status :: QueueStatus,
    SndQueueInfo -> Maybe SndSwitchStatus
sndSwitchStatus :: Maybe SndSwitchStatus
  }
  deriving (SndQueueInfo -> SndQueueInfo -> SndQueueSecured
(SndQueueInfo -> SndQueueInfo -> SndQueueSecured)
-> (SndQueueInfo -> SndQueueInfo -> SndQueueSecured)
-> Eq SndQueueInfo
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: SndQueueInfo -> SndQueueInfo -> SndQueueSecured
== :: SndQueueInfo -> SndQueueInfo -> SndQueueSecured
$c/= :: SndQueueInfo -> SndQueueInfo -> SndQueueSecured
/= :: SndQueueInfo -> SndQueueInfo -> SndQueueSecured
Eq, Int -> SndQueueInfo -> ShowS
[SndQueueInfo] -> ShowS
SndQueueInfo -> FilePath
(Int -> SndQueueInfo -> ShowS)
-> (SndQueueInfo -> FilePath)
-> ([SndQueueInfo] -> ShowS)
-> Show SndQueueInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SndQueueInfo -> ShowS
showsPrec :: Int -> SndQueueInfo -> ShowS
$cshow :: SndQueueInfo -> FilePath
show :: SndQueueInfo -> FilePath
$cshowList :: [SndQueueInfo] -> ShowS
showList :: [SndQueueInfo] -> ShowS
Show)

data SubscriptionStatus
  = SSActive
  | SSPending
  | SSRemoved {SubscriptionStatus -> FilePath
subError :: String}
  | SSNoSub
  deriving (SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
(SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured)
-> (SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured)
-> Eq SubscriptionStatus
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
== :: SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
$c/= :: SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
/= :: SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
Eq, Eq SubscriptionStatus
Eq SubscriptionStatus =>
(SubscriptionStatus -> SubscriptionStatus -> Ordering)
-> (SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured)
-> (SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured)
-> (SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured)
-> (SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured)
-> (SubscriptionStatus -> SubscriptionStatus -> SubscriptionStatus)
-> (SubscriptionStatus -> SubscriptionStatus -> SubscriptionStatus)
-> Ord SubscriptionStatus
SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
SubscriptionStatus -> SubscriptionStatus -> Ordering
SubscriptionStatus -> SubscriptionStatus -> SubscriptionStatus
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> SndQueueSecured)
-> (a -> a -> SndQueueSecured)
-> (a -> a -> SndQueueSecured)
-> (a -> a -> SndQueueSecured)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SubscriptionStatus -> SubscriptionStatus -> Ordering
compare :: SubscriptionStatus -> SubscriptionStatus -> Ordering
$c< :: SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
< :: SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
$c<= :: SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
<= :: SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
$c> :: SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
> :: SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
$c>= :: SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
>= :: SubscriptionStatus -> SubscriptionStatus -> SndQueueSecured
$cmax :: SubscriptionStatus -> SubscriptionStatus -> SubscriptionStatus
max :: SubscriptionStatus -> SubscriptionStatus -> SubscriptionStatus
$cmin :: SubscriptionStatus -> SubscriptionStatus -> SubscriptionStatus
min :: SubscriptionStatus -> SubscriptionStatus -> SubscriptionStatus
Ord, Int -> SubscriptionStatus -> ShowS
[SubscriptionStatus] -> ShowS
SubscriptionStatus -> FilePath
(Int -> SubscriptionStatus -> ShowS)
-> (SubscriptionStatus -> FilePath)
-> ([SubscriptionStatus] -> ShowS)
-> Show SubscriptionStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubscriptionStatus -> ShowS
showsPrec :: Int -> SubscriptionStatus -> ShowS
$cshow :: SubscriptionStatus -> FilePath
show :: SubscriptionStatus -> FilePath
$cshowList :: [SubscriptionStatus] -> ShowS
showList :: [SubscriptionStatus] -> ShowS
Show)

data ConnectionStats = ConnectionStats
  { ConnectionStats -> VersionSMPA
connAgentVersion :: VersionSMPA,
    ConnectionStats -> [RcvQueueInfo]
rcvQueuesInfo :: [RcvQueueInfo],
    ConnectionStats -> [SndQueueInfo]
sndQueuesInfo :: [SndQueueInfo],
    ConnectionStats -> RatchetSyncState
ratchetSyncState :: RatchetSyncState,
    ConnectionStats -> SndQueueSecured
ratchetSyncSupported :: Bool,
    ConnectionStats -> Maybe SubscriptionStatus
subStatus :: Maybe SubscriptionStatus
  }
  deriving (ConnectionStats -> ConnectionStats -> SndQueueSecured
(ConnectionStats -> ConnectionStats -> SndQueueSecured)
-> (ConnectionStats -> ConnectionStats -> SndQueueSecured)
-> Eq ConnectionStats
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: ConnectionStats -> ConnectionStats -> SndQueueSecured
== :: ConnectionStats -> ConnectionStats -> SndQueueSecured
$c/= :: ConnectionStats -> ConnectionStats -> SndQueueSecured
/= :: ConnectionStats -> ConnectionStats -> SndQueueSecured
Eq, Int -> ConnectionStats -> ShowS
[ConnectionStats] -> ShowS
ConnectionStats -> FilePath
(Int -> ConnectionStats -> ShowS)
-> (ConnectionStats -> FilePath)
-> ([ConnectionStats] -> ShowS)
-> Show ConnectionStats
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionStats -> ShowS
showsPrec :: Int -> ConnectionStats -> ShowS
$cshow :: ConnectionStats -> FilePath
show :: ConnectionStats -> FilePath
$cshowList :: [ConnectionStats] -> ShowS
showList :: [ConnectionStats] -> ShowS
Show)

data NotificationsMode = NMPeriodic | NMInstant
  deriving (NotificationsMode -> NotificationsMode -> SndQueueSecured
(NotificationsMode -> NotificationsMode -> SndQueueSecured)
-> (NotificationsMode -> NotificationsMode -> SndQueueSecured)
-> Eq NotificationsMode
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: NotificationsMode -> NotificationsMode -> SndQueueSecured
== :: NotificationsMode -> NotificationsMode -> SndQueueSecured
$c/= :: NotificationsMode -> NotificationsMode -> SndQueueSecured
/= :: NotificationsMode -> NotificationsMode -> SndQueueSecured
Eq, Int -> NotificationsMode -> ShowS
[NotificationsMode] -> ShowS
NotificationsMode -> FilePath
(Int -> NotificationsMode -> ShowS)
-> (NotificationsMode -> FilePath)
-> ([NotificationsMode] -> ShowS)
-> Show NotificationsMode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotificationsMode -> ShowS
showsPrec :: Int -> NotificationsMode -> ShowS
$cshow :: NotificationsMode -> FilePath
show :: NotificationsMode -> FilePath
$cshowList :: [NotificationsMode] -> ShowS
showList :: [NotificationsMode] -> ShowS
Show)

instance StrEncoding NotificationsMode where
  strEncode :: NotificationsMode -> ConfirmationId
strEncode = \case
    NotificationsMode
NMPeriodic -> ConfirmationId
"PERIODIC"
    NotificationsMode
NMInstant -> ConfirmationId
"INSTANT"
  strP :: Parser NotificationsMode
strP =
    (Char -> SndQueueSecured) -> Parser ConfirmationId ConfirmationId
A.takeTill (Char -> Char -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== Char
' ') Parser ConfirmationId ConfirmationId
-> (ConfirmationId -> Parser NotificationsMode)
-> Parser NotificationsMode
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConfirmationId
"PERIODIC" -> NotificationsMode -> Parser NotificationsMode
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NotificationsMode
NMPeriodic
      ConfirmationId
"INSTANT" -> NotificationsMode -> Parser NotificationsMode
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NotificationsMode
NMInstant
      ConfirmationId
_ -> FilePath -> Parser NotificationsMode
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad NotificationsMode"

instance ToJSON NotificationsMode where
  toEncoding :: NotificationsMode -> Encoding
toEncoding = NotificationsMode -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding
  toJSON :: NotificationsMode -> Value
toJSON = NotificationsMode -> Value
forall a. StrEncoding a => a -> Value
strToJSON

instance FromJSON NotificationsMode where
  parseJSON :: Value -> Parser NotificationsMode
parseJSON = FilePath -> Value -> Parser NotificationsMode
forall a. StrEncoding a => FilePath -> Value -> Parser a
strParseJSON FilePath
"NotificationsMode"

instance ToField NotificationsMode where toField :: NotificationsMode -> SQLData
toField = CRClientData -> SQLData
forall a. ToField a => a -> SQLData
toField (CRClientData -> SQLData)
-> (NotificationsMode -> CRClientData)
-> NotificationsMode
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> CRClientData
decodeLatin1 (ConfirmationId -> CRClientData)
-> (NotificationsMode -> ConfirmationId)
-> NotificationsMode
-> CRClientData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NotificationsMode -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode

instance FromField NotificationsMode where fromField :: FieldParser NotificationsMode
fromField = (CRClientData -> Maybe NotificationsMode)
-> FieldParser NotificationsMode
forall a. Typeable a => (CRClientData -> Maybe a) -> Field -> Ok a
fromTextField_ ((CRClientData -> Maybe NotificationsMode)
 -> FieldParser NotificationsMode)
-> (CRClientData -> Maybe NotificationsMode)
-> FieldParser NotificationsMode
forall a b. (a -> b) -> a -> b
$ Either FilePath NotificationsMode -> Maybe NotificationsMode
forall a b. Either a b -> Maybe b
eitherToMaybe (Either FilePath NotificationsMode -> Maybe NotificationsMode)
-> (CRClientData -> Either FilePath NotificationsMode)
-> CRClientData
-> Maybe NotificationsMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> Either FilePath NotificationsMode
forall a. StrEncoding a => ConfirmationId -> Either FilePath a
strDecode (ConfirmationId -> Either FilePath NotificationsMode)
-> (CRClientData -> ConfirmationId)
-> CRClientData
-> Either FilePath NotificationsMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRClientData -> ConfirmationId
encodeUtf8

data NotificationInfo = NotificationInfo
  { NotificationInfo -> ConfirmationId
ntfConnId :: ConnId,
    NotificationInfo -> AgentMsgId
ntfDbQueueId :: Int64,
    NotificationInfo -> SystemTime
ntfTs :: SystemTime,
    -- Nothing means that the message failed to decrypt or to decode,
    -- we can still show event notification
    NotificationInfo -> Maybe NMsgMeta
ntfMsgMeta :: Maybe NMsgMeta
  }
  deriving (Int -> NotificationInfo -> ShowS
[NotificationInfo] -> ShowS
NotificationInfo -> FilePath
(Int -> NotificationInfo -> ShowS)
-> (NotificationInfo -> FilePath)
-> ([NotificationInfo] -> ShowS)
-> Show NotificationInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotificationInfo -> ShowS
showsPrec :: Int -> NotificationInfo -> ShowS
$cshow :: NotificationInfo -> FilePath
show :: NotificationInfo -> FilePath
$cshowList :: [NotificationInfo] -> ShowS
showList :: [NotificationInfo] -> ShowS
Show)

data ConnMsgReq = ConnMsgReq
  { ConnMsgReq -> ConfirmationId
msgConnId :: ConnId,
    ConnMsgReq -> AgentMsgId
msgDbQueueId :: Int64,
    ConnMsgReq -> Maybe UTCTime
msgTs :: Maybe UTCTime
  }
  deriving (Int -> ConnMsgReq -> ShowS
[ConnMsgReq] -> ShowS
ConnMsgReq -> FilePath
(Int -> ConnMsgReq -> ShowS)
-> (ConnMsgReq -> FilePath)
-> ([ConnMsgReq] -> ShowS)
-> Show ConnMsgReq
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnMsgReq -> ShowS
showsPrec :: Int -> ConnMsgReq -> ShowS
$cshow :: ConnMsgReq -> FilePath
show :: ConnMsgReq -> FilePath
$cshowList :: [ConnMsgReq] -> ShowS
showList :: [ConnMsgReq] -> ShowS
Show)

data ConnectionMode = CMInvitation | CMContact
  deriving (ConnectionMode -> ConnectionMode -> SndQueueSecured
(ConnectionMode -> ConnectionMode -> SndQueueSecured)
-> (ConnectionMode -> ConnectionMode -> SndQueueSecured)
-> Eq ConnectionMode
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: ConnectionMode -> ConnectionMode -> SndQueueSecured
== :: ConnectionMode -> ConnectionMode -> SndQueueSecured
$c/= :: ConnectionMode -> ConnectionMode -> SndQueueSecured
/= :: ConnectionMode -> ConnectionMode -> SndQueueSecured
Eq, Int -> ConnectionMode -> ShowS
[ConnectionMode] -> ShowS
ConnectionMode -> FilePath
(Int -> ConnectionMode -> ShowS)
-> (ConnectionMode -> FilePath)
-> ([ConnectionMode] -> ShowS)
-> Show ConnectionMode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionMode -> ShowS
showsPrec :: Int -> ConnectionMode -> ShowS
$cshow :: ConnectionMode -> FilePath
show :: ConnectionMode -> FilePath
$cshowList :: [ConnectionMode] -> ShowS
showList :: [ConnectionMode] -> ShowS
Show)

data SConnectionMode (m :: ConnectionMode) where
  SCMInvitation :: SConnectionMode CMInvitation
  SCMContact :: SConnectionMode CMContact

deriving instance Eq (SConnectionMode m)

deriving instance Show (SConnectionMode m)

instance TestEquality SConnectionMode where
  testEquality :: forall (a :: ConnectionMode) (b :: ConnectionMode).
SConnectionMode a -> SConnectionMode b -> Maybe (a :~: b)
testEquality SConnectionMode a
SCMInvitation SConnectionMode b
SCMInvitation = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SConnectionMode a
SCMContact SConnectionMode b
SCMContact = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality SConnectionMode a
_ SConnectionMode b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing

data AConnectionMode = forall m. ConnectionModeI m => ACM (SConnectionMode m)

instance Eq AConnectionMode where
  ACM SConnectionMode m
m == :: AConnectionMode -> AConnectionMode -> SndQueueSecured
== ACM SConnectionMode m
m' = Maybe (m :~: m) -> SndQueueSecured
forall a. Maybe a -> SndQueueSecured
isJust (Maybe (m :~: m) -> SndQueueSecured)
-> Maybe (m :~: m) -> SndQueueSecured
forall a b. (a -> b) -> a -> b
$ SConnectionMode m -> SConnectionMode m -> Maybe (m :~: m)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: ConnectionMode) (b :: ConnectionMode).
SConnectionMode a -> SConnectionMode b -> Maybe (a :~: b)
testEquality SConnectionMode m
m SConnectionMode m
m'

deriving instance Show AConnectionMode

connMode :: SConnectionMode m -> ConnectionMode
connMode :: forall (m :: ConnectionMode). SConnectionMode m -> ConnectionMode
connMode SConnectionMode m
SCMInvitation = ConnectionMode
CMInvitation
connMode SConnectionMode m
SCMContact = ConnectionMode
CMContact
{-# INLINE connMode #-}

connMode' :: ConnectionMode -> AConnectionMode
connMode' :: ConnectionMode -> AConnectionMode
connMode' ConnectionMode
CMInvitation = SConnectionMode 'CMInvitation -> AConnectionMode
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> AConnectionMode
ACM SConnectionMode 'CMInvitation
SCMInvitation
connMode' ConnectionMode
CMContact = SConnectionMode 'CMContact -> AConnectionMode
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> AConnectionMode
ACM SConnectionMode 'CMContact
SCMContact
{-# INLINE connMode' #-}

class ConnectionModeI (m :: ConnectionMode) where sConnectionMode :: SConnectionMode m

instance ConnectionModeI CMInvitation where sConnectionMode :: SConnectionMode 'CMInvitation
sConnectionMode = SConnectionMode 'CMInvitation
SCMInvitation

instance ConnectionModeI CMContact where sConnectionMode :: SConnectionMode 'CMContact
sConnectionMode = SConnectionMode 'CMContact
SCMContact

type MsgHash = ByteString

-- | Agent message metadata sent to the client
data MsgMeta = MsgMeta
  { MsgMeta -> MsgIntegrity
integrity :: MsgIntegrity,
    MsgMeta -> (AgentMsgId, UTCTime)
recipient :: (AgentMsgId, UTCTime),
    MsgMeta -> (ConfirmationId, UTCTime)
broker :: (MsgId, UTCTime),
    MsgMeta -> AgentMsgId
sndMsgId :: AgentMsgId,
    MsgMeta -> PQEncryption
pqEncryption :: PQEncryption
  }
  deriving (MsgMeta -> MsgMeta -> SndQueueSecured
(MsgMeta -> MsgMeta -> SndQueueSecured)
-> (MsgMeta -> MsgMeta -> SndQueueSecured) -> Eq MsgMeta
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: MsgMeta -> MsgMeta -> SndQueueSecured
== :: MsgMeta -> MsgMeta -> SndQueueSecured
$c/= :: MsgMeta -> MsgMeta -> SndQueueSecured
/= :: MsgMeta -> MsgMeta -> SndQueueSecured
Eq, Int -> MsgMeta -> ShowS
[MsgMeta] -> ShowS
MsgMeta -> FilePath
(Int -> MsgMeta -> ShowS)
-> (MsgMeta -> FilePath) -> ([MsgMeta] -> ShowS) -> Show MsgMeta
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgMeta -> ShowS
showsPrec :: Int -> MsgMeta -> ShowS
$cshow :: MsgMeta -> FilePath
show :: MsgMeta -> FilePath
$cshowList :: [MsgMeta] -> ShowS
showList :: [MsgMeta] -> ShowS
Show)

data DroppedMsg = DroppedMsg
  { DroppedMsg -> UTCTime
brokerTs :: UTCTime,
    DroppedMsg -> Int
attempts :: Int
  }
  deriving (DroppedMsg -> DroppedMsg -> SndQueueSecured
(DroppedMsg -> DroppedMsg -> SndQueueSecured)
-> (DroppedMsg -> DroppedMsg -> SndQueueSecured) -> Eq DroppedMsg
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: DroppedMsg -> DroppedMsg -> SndQueueSecured
== :: DroppedMsg -> DroppedMsg -> SndQueueSecured
$c/= :: DroppedMsg -> DroppedMsg -> SndQueueSecured
/= :: DroppedMsg -> DroppedMsg -> SndQueueSecured
Eq, Int -> DroppedMsg -> ShowS
[DroppedMsg] -> ShowS
DroppedMsg -> FilePath
(Int -> DroppedMsg -> ShowS)
-> (DroppedMsg -> FilePath)
-> ([DroppedMsg] -> ShowS)
-> Show DroppedMsg
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DroppedMsg -> ShowS
showsPrec :: Int -> DroppedMsg -> ShowS
$cshow :: DroppedMsg -> FilePath
show :: DroppedMsg -> FilePath
$cshowList :: [DroppedMsg] -> ShowS
showList :: [DroppedMsg] -> ShowS
Show)

data SMPConfirmation = SMPConfirmation
  { -- | sender's public key to use for authentication of sender's commands at the recepient's server
    SMPConfirmation -> Maybe SndPublicAuthKey
senderKey :: Maybe SndPublicAuthKey,
    -- | sender's DH public key for simple per-queue e2e encryption
    SMPConfirmation -> PublicKeyX25519
e2ePubKey :: C.PublicKeyX25519,
    -- | sender's information to be associated with the connection, e.g. sender's profile information
    SMPConfirmation -> ConfirmationId
connInfo :: ConnInfo,
    -- | optional reply queues included in confirmation (added in agent protocol v2)
    SMPConfirmation -> [SMPQueueInfo]
smpReplyQueues :: [SMPQueueInfo],
    -- | SMP client version
    SMPConfirmation -> VersionSMPC
smpClientVersion :: VersionSMPC
  }
  deriving (Int -> SMPConfirmation -> ShowS
[SMPConfirmation] -> ShowS
SMPConfirmation -> FilePath
(Int -> SMPConfirmation -> ShowS)
-> (SMPConfirmation -> FilePath)
-> ([SMPConfirmation] -> ShowS)
-> Show SMPConfirmation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SMPConfirmation -> ShowS
showsPrec :: Int -> SMPConfirmation -> ShowS
$cshow :: SMPConfirmation -> FilePath
show :: SMPConfirmation -> FilePath
$cshowList :: [SMPConfirmation] -> ShowS
showList :: [SMPConfirmation] -> ShowS
Show)

data AgentMsgEnvelope
  = AgentConfirmation
      { AgentMsgEnvelope -> VersionSMPA
agentVersion :: VersionSMPA,
        AgentMsgEnvelope -> Maybe (SndE2ERatchetParams 'X448)
e2eEncryption_ :: Maybe (SndE2ERatchetParams 'C.X448),
        AgentMsgEnvelope -> ConfirmationId
encConnInfo :: ByteString
      }
  | AgentMsgEnvelope
      { agentVersion :: VersionSMPA,
        AgentMsgEnvelope -> ConfirmationId
encAgentMessage :: ByteString
      }
  | AgentInvitation -- the connInfo in contactInvite is only encrypted with per-queue E2E, not with double ratchet,
      { agentVersion :: VersionSMPA,
        AgentMsgEnvelope -> ConnectionRequestUri 'CMInvitation
connReq :: ConnectionRequestUri 'CMInvitation,
        AgentMsgEnvelope -> ConfirmationId
connInfo :: ByteString -- this message is only encrypted with per-queue E2E, not with double ratchet,
      }
  | AgentRatchetKey
      { agentVersion :: VersionSMPA,
        AgentMsgEnvelope -> RcvE2ERatchetParams 'X448
e2eEncryption :: RcvE2ERatchetParams 'C.X448,
        AgentMsgEnvelope -> ConfirmationId
info :: ByteString
      }
  deriving (Int -> AgentMsgEnvelope -> ShowS
[AgentMsgEnvelope] -> ShowS
AgentMsgEnvelope -> FilePath
(Int -> AgentMsgEnvelope -> ShowS)
-> (AgentMsgEnvelope -> FilePath)
-> ([AgentMsgEnvelope] -> ShowS)
-> Show AgentMsgEnvelope
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgentMsgEnvelope -> ShowS
showsPrec :: Int -> AgentMsgEnvelope -> ShowS
$cshow :: AgentMsgEnvelope -> FilePath
show :: AgentMsgEnvelope -> FilePath
$cshowList :: [AgentMsgEnvelope] -> ShowS
showList :: [AgentMsgEnvelope] -> ShowS
Show)

instance Encoding AgentMsgEnvelope where
  smpEncode :: AgentMsgEnvelope -> ConfirmationId
smpEncode = \case
    AgentConfirmation {VersionSMPA
$sel:agentVersion:AgentConfirmation :: AgentMsgEnvelope -> VersionSMPA
agentVersion :: VersionSMPA
agentVersion, Maybe (SndE2ERatchetParams 'X448)
$sel:e2eEncryption_:AgentConfirmation :: AgentMsgEnvelope -> Maybe (SndE2ERatchetParams 'X448)
e2eEncryption_ :: Maybe (SndE2ERatchetParams 'X448)
e2eEncryption_, ConfirmationId
$sel:encConnInfo:AgentConfirmation :: AgentMsgEnvelope -> ConfirmationId
encConnInfo :: ConfirmationId
encConnInfo} ->
      (VersionSMPA, Char, Maybe (SndE2ERatchetParams 'X448), Tail)
-> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (VersionSMPA
agentVersion, Char
'C', Maybe (SndE2ERatchetParams 'X448)
e2eEncryption_, ConfirmationId -> Tail
Tail ConfirmationId
encConnInfo)
    AgentMsgEnvelope {VersionSMPA
$sel:agentVersion:AgentConfirmation :: AgentMsgEnvelope -> VersionSMPA
agentVersion :: VersionSMPA
agentVersion, ConfirmationId
$sel:encAgentMessage:AgentConfirmation :: AgentMsgEnvelope -> ConfirmationId
encAgentMessage :: ConfirmationId
encAgentMessage} ->
      (VersionSMPA, Char, Tail) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (VersionSMPA
agentVersion, Char
'M', ConfirmationId -> Tail
Tail ConfirmationId
encAgentMessage)
    AgentInvitation {VersionSMPA
$sel:agentVersion:AgentConfirmation :: AgentMsgEnvelope -> VersionSMPA
agentVersion :: VersionSMPA
agentVersion, ConnectionRequestUri 'CMInvitation
$sel:connReq:AgentConfirmation :: AgentMsgEnvelope -> ConnectionRequestUri 'CMInvitation
connReq :: ConnectionRequestUri 'CMInvitation
connReq, ConfirmationId
$sel:connInfo:AgentConfirmation :: AgentMsgEnvelope -> ConfirmationId
connInfo :: ConfirmationId
connInfo} ->
      (VersionSMPA, Char, Large, Tail) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (VersionSMPA
agentVersion, Char
'I', ConfirmationId -> Large
Large (ConfirmationId -> Large) -> ConfirmationId -> Large
forall a b. (a -> b) -> a -> b
$ ConnectionRequestUri 'CMInvitation -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode ConnectionRequestUri 'CMInvitation
connReq, ConfirmationId -> Tail
Tail ConfirmationId
connInfo)
    AgentRatchetKey {VersionSMPA
$sel:agentVersion:AgentConfirmation :: AgentMsgEnvelope -> VersionSMPA
agentVersion :: VersionSMPA
agentVersion, RcvE2ERatchetParams 'X448
$sel:e2eEncryption:AgentConfirmation :: AgentMsgEnvelope -> RcvE2ERatchetParams 'X448
e2eEncryption :: RcvE2ERatchetParams 'X448
e2eEncryption, ConfirmationId
$sel:info:AgentConfirmation :: AgentMsgEnvelope -> ConfirmationId
info :: ConfirmationId
info} ->
      (VersionSMPA, Char, RcvE2ERatchetParams 'X448, Tail)
-> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (VersionSMPA
agentVersion, Char
'R', RcvE2ERatchetParams 'X448
e2eEncryption, ConfirmationId -> Tail
Tail ConfirmationId
info)
  smpP :: Parser AgentMsgEnvelope
smpP = do
    VersionSMPA
agentVersion <- Parser VersionSMPA
forall a. Encoding a => Parser a
smpP
    Parser Char
forall a. Encoding a => Parser a
smpP Parser Char
-> (Char -> Parser AgentMsgEnvelope) -> Parser AgentMsgEnvelope
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Char
'C' -> do
        (Maybe (SndE2ERatchetParams 'X448)
e2eEncryption_, Tail ConfirmationId
encConnInfo) <- Parser (Maybe (SndE2ERatchetParams 'X448), Tail)
forall a. Encoding a => Parser a
smpP
        AgentMsgEnvelope -> Parser AgentMsgEnvelope
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentConfirmation {VersionSMPA
$sel:agentVersion:AgentConfirmation :: VersionSMPA
agentVersion :: VersionSMPA
agentVersion, Maybe (SndE2ERatchetParams 'X448)
$sel:e2eEncryption_:AgentConfirmation :: Maybe (SndE2ERatchetParams 'X448)
e2eEncryption_ :: Maybe (SndE2ERatchetParams 'X448)
e2eEncryption_, ConfirmationId
$sel:encConnInfo:AgentConfirmation :: ConfirmationId
encConnInfo :: ConfirmationId
encConnInfo}
      Char
'M' -> do
        Tail ConfirmationId
encAgentMessage <- Parser Tail
forall a. Encoding a => Parser a
smpP
        AgentMsgEnvelope -> Parser AgentMsgEnvelope
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMsgEnvelope {VersionSMPA
$sel:agentVersion:AgentConfirmation :: VersionSMPA
agentVersion :: VersionSMPA
agentVersion, ConfirmationId
$sel:encAgentMessage:AgentConfirmation :: ConfirmationId
encAgentMessage :: ConfirmationId
encAgentMessage}
      Char
'I' -> do
        ConnectionRequestUri 'CMInvitation
connReq <- ConfirmationId
-> Either FilePath (ConnectionRequestUri 'CMInvitation)
forall a. StrEncoding a => ConfirmationId -> Either FilePath a
strDecode (ConfirmationId
 -> Either FilePath (ConnectionRequestUri 'CMInvitation))
-> (Large -> ConfirmationId)
-> Large
-> Either FilePath (ConnectionRequestUri 'CMInvitation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Large -> ConfirmationId
unLarge (Large -> Either FilePath (ConnectionRequestUri 'CMInvitation))
-> Parser ConfirmationId Large
-> Parser ConfirmationId (ConnectionRequestUri 'CMInvitation)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either FilePath b) -> m a -> m b
<$?> Parser ConfirmationId Large
forall a. Encoding a => Parser a
smpP
        Tail ConfirmationId
connInfo <- Parser Tail
forall a. Encoding a => Parser a
smpP
        AgentMsgEnvelope -> Parser AgentMsgEnvelope
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentInvitation {VersionSMPA
$sel:agentVersion:AgentConfirmation :: VersionSMPA
agentVersion :: VersionSMPA
agentVersion, ConnectionRequestUri 'CMInvitation
$sel:connReq:AgentConfirmation :: ConnectionRequestUri 'CMInvitation
connReq :: ConnectionRequestUri 'CMInvitation
connReq, ConfirmationId
$sel:connInfo:AgentConfirmation :: ConfirmationId
connInfo :: ConfirmationId
connInfo}
      Char
'R' -> do
        RcvE2ERatchetParams 'X448
e2eEncryption <- Parser (RcvE2ERatchetParams 'X448)
forall a. Encoding a => Parser a
smpP
        Tail ConfirmationId
info <- Parser Tail
forall a. Encoding a => Parser a
smpP
        AgentMsgEnvelope -> Parser AgentMsgEnvelope
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentRatchetKey {VersionSMPA
$sel:agentVersion:AgentConfirmation :: VersionSMPA
agentVersion :: VersionSMPA
agentVersion, RcvE2ERatchetParams 'X448
$sel:e2eEncryption:AgentConfirmation :: RcvE2ERatchetParams 'X448
e2eEncryption :: RcvE2ERatchetParams 'X448
e2eEncryption, ConfirmationId
$sel:info:AgentConfirmation :: ConfirmationId
info :: ConfirmationId
info}
      Char
_ -> FilePath -> Parser AgentMsgEnvelope
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad AgentMsgEnvelope"

-- SMP agent message formats (after double ratchet decryption,
-- or in case of AgentInvitation - in plain text body)
-- AgentRatchetInfo is not encrypted with double ratchet, but with per-queue E2E encryption
data AgentMessage
  = -- used by the initiating party when confirming reply queue
    AgentConnInfo ConnInfo
  | -- AgentConnInfoReply is used by accepting party in duplexHandshake mode (v2), allowing to include reply queue(s) in the initial confirmation.
    -- It made removed REPLY message unnecessary.
    AgentConnInfoReply (NonEmpty SMPQueueInfo) ConnInfo
  | AgentRatchetInfo ByteString
  | AgentMessage APrivHeader AMessage
  deriving (Int -> AgentMessage -> ShowS
[AgentMessage] -> ShowS
AgentMessage -> FilePath
(Int -> AgentMessage -> ShowS)
-> (AgentMessage -> FilePath)
-> ([AgentMessage] -> ShowS)
-> Show AgentMessage
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgentMessage -> ShowS
showsPrec :: Int -> AgentMessage -> ShowS
$cshow :: AgentMessage -> FilePath
show :: AgentMessage -> FilePath
$cshowList :: [AgentMessage] -> ShowS
showList :: [AgentMessage] -> ShowS
Show)

instance Encoding AgentMessage where
  smpEncode :: AgentMessage -> ConfirmationId
smpEncode = \case
    AgentConnInfo ConfirmationId
cInfo -> (Char, Tail) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (Char
'I', ConfirmationId -> Tail
Tail ConfirmationId
cInfo)
    AgentConnInfoReply NonEmpty SMPQueueInfo
smpQueues ConfirmationId
cInfo -> (Char, NonEmpty SMPQueueInfo, Tail) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (Char
'D', NonEmpty SMPQueueInfo
smpQueues, ConfirmationId -> Tail
Tail ConfirmationId
cInfo) -- 'D' stands for "duplex"
    AgentRatchetInfo ConfirmationId
info -> (Char, Tail) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (Char
'R', ConfirmationId -> Tail
Tail ConfirmationId
info)
    AgentMessage APrivHeader
hdr AMessage
aMsg -> (Char, APrivHeader, AMessage) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (Char
'M', APrivHeader
hdr, AMessage
aMsg)
  smpP :: Parser AgentMessage
smpP =
    Parser Char
forall a. Encoding a => Parser a
smpP Parser Char -> (Char -> Parser AgentMessage) -> Parser AgentMessage
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Char
'I' -> ConfirmationId -> AgentMessage
AgentConnInfo (ConfirmationId -> AgentMessage)
-> (Tail -> ConfirmationId) -> Tail -> AgentMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tail -> ConfirmationId
unTail (Tail -> AgentMessage) -> Parser Tail -> Parser AgentMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tail
forall a. Encoding a => Parser a
smpP
      Char
'D' -> NonEmpty SMPQueueInfo -> ConfirmationId -> AgentMessage
AgentConnInfoReply (NonEmpty SMPQueueInfo -> ConfirmationId -> AgentMessage)
-> Parser ConfirmationId (NonEmpty SMPQueueInfo)
-> Parser ConfirmationId (ConfirmationId -> AgentMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId (NonEmpty SMPQueueInfo)
forall a. Encoding a => Parser a
smpP Parser ConfirmationId (ConfirmationId -> AgentMessage)
-> Parser ConfirmationId ConfirmationId -> Parser AgentMessage
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tail -> ConfirmationId
unTail (Tail -> ConfirmationId)
-> Parser Tail -> Parser ConfirmationId ConfirmationId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tail
forall a. Encoding a => Parser a
smpP)
      Char
'R' -> ConfirmationId -> AgentMessage
AgentRatchetInfo (ConfirmationId -> AgentMessage)
-> (Tail -> ConfirmationId) -> Tail -> AgentMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tail -> ConfirmationId
unTail (Tail -> AgentMessage) -> Parser Tail -> Parser AgentMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tail
forall a. Encoding a => Parser a
smpP
      Char
'M' -> APrivHeader -> AMessage -> AgentMessage
AgentMessage (APrivHeader -> AMessage -> AgentMessage)
-> Parser ConfirmationId APrivHeader
-> Parser ConfirmationId (AMessage -> AgentMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId APrivHeader
forall a. Encoding a => Parser a
smpP Parser ConfirmationId (AMessage -> AgentMessage)
-> Parser ConfirmationId AMessage -> Parser AgentMessage
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfirmationId AMessage
forall a. Encoding a => Parser a
smpP
      Char
_ -> FilePath -> Parser AgentMessage
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad AgentMessage"

-- internal type for storing message type in the database
data AgentMessageType
  = AM_CONN_INFO
  | AM_CONN_INFO_REPLY
  | AM_RATCHET_INFO
  | AM_HELLO_
  | AM_A_MSG_
  | AM_A_RCVD_
  | AM_QCONT_
  | AM_QADD_
  | AM_QKEY_
  | AM_QUSE_
  | AM_QTEST_
  | AM_EREADY_
  deriving (AgentMessageType -> AgentMessageType -> SndQueueSecured
(AgentMessageType -> AgentMessageType -> SndQueueSecured)
-> (AgentMessageType -> AgentMessageType -> SndQueueSecured)
-> Eq AgentMessageType
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: AgentMessageType -> AgentMessageType -> SndQueueSecured
== :: AgentMessageType -> AgentMessageType -> SndQueueSecured
$c/= :: AgentMessageType -> AgentMessageType -> SndQueueSecured
/= :: AgentMessageType -> AgentMessageType -> SndQueueSecured
Eq, Int -> AgentMessageType -> ShowS
[AgentMessageType] -> ShowS
AgentMessageType -> FilePath
(Int -> AgentMessageType -> ShowS)
-> (AgentMessageType -> FilePath)
-> ([AgentMessageType] -> ShowS)
-> Show AgentMessageType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgentMessageType -> ShowS
showsPrec :: Int -> AgentMessageType -> ShowS
$cshow :: AgentMessageType -> FilePath
show :: AgentMessageType -> FilePath
$cshowList :: [AgentMessageType] -> ShowS
showList :: [AgentMessageType] -> ShowS
Show)

instance Encoding AgentMessageType where
  smpEncode :: AgentMessageType -> ConfirmationId
smpEncode = \case
    AgentMessageType
AM_CONN_INFO -> ConfirmationId
"C"
    AgentMessageType
AM_CONN_INFO_REPLY -> ConfirmationId
"D"
    AgentMessageType
AM_RATCHET_INFO -> ConfirmationId
"S"
    AgentMessageType
AM_HELLO_ -> ConfirmationId
"H"
    AgentMessageType
AM_A_MSG_ -> ConfirmationId
"M"
    AgentMessageType
AM_A_RCVD_ -> ConfirmationId
"V"
    AgentMessageType
AM_QCONT_ -> ConfirmationId
"QC"
    AgentMessageType
AM_QADD_ -> ConfirmationId
"QA"
    AgentMessageType
AM_QKEY_ -> ConfirmationId
"QK"
    AgentMessageType
AM_QUSE_ -> ConfirmationId
"QU"
    AgentMessageType
AM_QTEST_ -> ConfirmationId
"QT"
    AgentMessageType
AM_EREADY_ -> ConfirmationId
"E"
  smpP :: Parser AgentMessageType
smpP =
    Parser Char
A.anyChar Parser Char
-> (Char -> Parser AgentMessageType) -> Parser AgentMessageType
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Char
'C' -> AgentMessageType -> Parser AgentMessageType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMessageType
AM_CONN_INFO
      Char
'D' -> AgentMessageType -> Parser AgentMessageType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMessageType
AM_CONN_INFO_REPLY
      Char
'S' -> AgentMessageType -> Parser AgentMessageType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMessageType
AM_RATCHET_INFO
      Char
'H' -> AgentMessageType -> Parser AgentMessageType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMessageType
AM_HELLO_
      Char
'M' -> AgentMessageType -> Parser AgentMessageType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMessageType
AM_A_MSG_
      Char
'V' -> AgentMessageType -> Parser AgentMessageType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMessageType
AM_A_RCVD_
      Char
'Q' ->
        Parser Char
A.anyChar Parser Char
-> (Char -> Parser AgentMessageType) -> Parser AgentMessageType
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Char
'C' -> AgentMessageType -> Parser AgentMessageType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMessageType
AM_QCONT_
          Char
'A' -> AgentMessageType -> Parser AgentMessageType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMessageType
AM_QADD_
          Char
'K' -> AgentMessageType -> Parser AgentMessageType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMessageType
AM_QKEY_
          Char
'U' -> AgentMessageType -> Parser AgentMessageType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMessageType
AM_QUSE_
          Char
'T' -> AgentMessageType -> Parser AgentMessageType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMessageType
AM_QTEST_
          Char
_ -> FilePath -> Parser AgentMessageType
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad AgentMessageType"
      Char
'E' -> AgentMessageType -> Parser AgentMessageType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AgentMessageType
AM_EREADY_
      Char
_ -> FilePath -> Parser AgentMessageType
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad AgentMessageType"

agentMessageType :: AgentMessage -> AgentMessageType
agentMessageType :: AgentMessage -> AgentMessageType
agentMessageType = \case
  AgentConnInfo ConfirmationId
_ -> AgentMessageType
AM_CONN_INFO
  AgentConnInfoReply {} -> AgentMessageType
AM_CONN_INFO_REPLY
  AgentRatchetInfo ConfirmationId
_ -> AgentMessageType
AM_RATCHET_INFO
  AgentMessage APrivHeader
_ AMessage
aMsg -> AMessage -> AgentMessageType
aMessageType AMessage
aMsg

data APrivHeader = APrivHeader
  { -- | sequential ID assigned by the sending agent
    APrivHeader -> AgentMsgId
sndMsgId :: AgentMsgId,
    -- | digest of the previous message
    APrivHeader -> ConfirmationId
prevMsgHash :: MsgHash
  }
  deriving (Int -> APrivHeader -> ShowS
[APrivHeader] -> ShowS
APrivHeader -> FilePath
(Int -> APrivHeader -> ShowS)
-> (APrivHeader -> FilePath)
-> ([APrivHeader] -> ShowS)
-> Show APrivHeader
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> APrivHeader -> ShowS
showsPrec :: Int -> APrivHeader -> ShowS
$cshow :: APrivHeader -> FilePath
show :: APrivHeader -> FilePath
$cshowList :: [APrivHeader] -> ShowS
showList :: [APrivHeader] -> ShowS
Show)

instance Encoding APrivHeader where
  smpEncode :: APrivHeader -> ConfirmationId
smpEncode APrivHeader {AgentMsgId
$sel:sndMsgId:APrivHeader :: APrivHeader -> AgentMsgId
sndMsgId :: AgentMsgId
sndMsgId, ConfirmationId
$sel:prevMsgHash:APrivHeader :: APrivHeader -> ConfirmationId
prevMsgHash :: ConfirmationId
prevMsgHash} =
    (AgentMsgId, ConfirmationId) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (AgentMsgId
sndMsgId, ConfirmationId
prevMsgHash)
  smpP :: Parser ConfirmationId APrivHeader
smpP = AgentMsgId -> ConfirmationId -> APrivHeader
APrivHeader (AgentMsgId -> ConfirmationId -> APrivHeader)
-> Parser ConfirmationId AgentMsgId
-> Parser ConfirmationId (ConfirmationId -> APrivHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId AgentMsgId
forall a. Encoding a => Parser a
smpP Parser ConfirmationId (ConfirmationId -> APrivHeader)
-> Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId APrivHeader
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfirmationId ConfirmationId
forall a. Encoding a => Parser a
smpP

data AMsgType
  = HELLO_
  | A_MSG_
  | A_RCVD_
  | A_QCONT_
  | QADD_
  | QKEY_
  | QUSE_
  | QTEST_
  | EREADY_
  deriving (AMsgType -> AMsgType -> SndQueueSecured
(AMsgType -> AMsgType -> SndQueueSecured)
-> (AMsgType -> AMsgType -> SndQueueSecured) -> Eq AMsgType
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: AMsgType -> AMsgType -> SndQueueSecured
== :: AMsgType -> AMsgType -> SndQueueSecured
$c/= :: AMsgType -> AMsgType -> SndQueueSecured
/= :: AMsgType -> AMsgType -> SndQueueSecured
Eq)

instance Encoding AMsgType where
  smpEncode :: AMsgType -> ConfirmationId
smpEncode = \case
    AMsgType
HELLO_ -> ConfirmationId
"H"
    AMsgType
A_MSG_ -> ConfirmationId
"M"
    AMsgType
A_RCVD_ -> ConfirmationId
"V"
    AMsgType
A_QCONT_ -> ConfirmationId
"QC"
    AMsgType
QADD_ -> ConfirmationId
"QA"
    AMsgType
QKEY_ -> ConfirmationId
"QK"
    AMsgType
QUSE_ -> ConfirmationId
"QU"
    AMsgType
QTEST_ -> ConfirmationId
"QT"
    AMsgType
EREADY_ -> ConfirmationId
"E"
  smpP :: Parser AMsgType
smpP =
    Parser Char
A.anyChar Parser Char -> (Char -> Parser AMsgType) -> Parser AMsgType
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Char
'H' -> AMsgType -> Parser AMsgType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AMsgType
HELLO_
      Char
'M' -> AMsgType -> Parser AMsgType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AMsgType
A_MSG_
      Char
'V' -> AMsgType -> Parser AMsgType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AMsgType
A_RCVD_
      Char
'Q' ->
        Parser Char
A.anyChar Parser Char -> (Char -> Parser AMsgType) -> Parser AMsgType
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Char
'C' -> AMsgType -> Parser AMsgType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AMsgType
A_QCONT_
          Char
'A' -> AMsgType -> Parser AMsgType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AMsgType
QADD_
          Char
'K' -> AMsgType -> Parser AMsgType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AMsgType
QKEY_
          Char
'U' -> AMsgType -> Parser AMsgType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AMsgType
QUSE_
          Char
'T' -> AMsgType -> Parser AMsgType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AMsgType
QTEST_
          Char
_ -> FilePath -> Parser AMsgType
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad AMsgType"
      Char
'E' -> AMsgType -> Parser AMsgType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AMsgType
EREADY_
      Char
_ -> FilePath -> Parser AMsgType
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad AMsgType"

-- | Messages sent between SMP agents once SMP queue is secured.
--
-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents
data AMessage
  = -- | the first message in the queue to validate it is secured
    HELLO
  | -- | agent envelope for the client message
    A_MSG MsgBody
  | -- | agent envelope for delivery receipt
    A_RCVD (NonEmpty AMessageReceipt)
  | -- | the message instructing the client to continue sending messages (after ERR QUOTA)
    A_QCONT SndQAddr
  | -- add queue to connection (sent by recipient), with optional address of the replaced queue
    QADD (NonEmpty (SMPQueueUri, Maybe SndQAddr))
  | -- key to secure the added queues and agree e2e encryption key (sent by sender)
    QKEY (NonEmpty (SMPQueueInfo, SndPublicAuthKey))
  | -- inform that the queues are ready to use (sent by recipient)
    QUSE (NonEmpty (SndQAddr, Bool))
  | -- sent by the sender to test new queues and to complete switching
    QTEST (NonEmpty SndQAddr)
  | -- ratchet re-synchronization is complete, with last decrypted sender message id (recipient's `last_external_snd_msg_id`)
    EREADY AgentMsgId
  deriving (Int -> AMessage -> ShowS
[AMessage] -> ShowS
AMessage -> FilePath
(Int -> AMessage -> ShowS)
-> (AMessage -> FilePath) -> ([AMessage] -> ShowS) -> Show AMessage
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AMessage -> ShowS
showsPrec :: Int -> AMessage -> ShowS
$cshow :: AMessage -> FilePath
show :: AMessage -> FilePath
$cshowList :: [AMessage] -> ShowS
showList :: [AMessage] -> ShowS
Show)

aMessageType :: AMessage -> AgentMessageType
aMessageType :: AMessage -> AgentMessageType
aMessageType = \case
  -- HELLO is used both in v1 and in v2, but differently.
  -- - in v1 (and, possibly, in v2 for simplex connections) can be sent multiple times,
  --   until the queue is secured - the OK response from the server instead of initial AUTH errors confirms it.
  -- - in v2 duplexHandshake it is sent only once, when it is known that the queue was secured.
  AMessage
HELLO -> AgentMessageType
AM_HELLO_
  A_MSG ConfirmationId
_ -> AgentMessageType
AM_A_MSG_
  A_RCVD {} -> AgentMessageType
AM_A_RCVD_
  A_QCONT SndQAddr
_ -> AgentMessageType
AM_QCONT_
  QADD NonEmpty (SMPQueueUri, Maybe SndQAddr)
_ -> AgentMessageType
AM_QADD_
  QKEY NonEmpty (SMPQueueInfo, SndPublicAuthKey)
_ -> AgentMessageType
AM_QKEY_
  QUSE NonEmpty (SndQAddr, SndQueueSecured)
_ -> AgentMessageType
AM_QUSE_
  QTEST NonEmpty SndQAddr
_ -> AgentMessageType
AM_QTEST_
  EREADY AgentMsgId
_ -> AgentMessageType
AM_EREADY_

-- | this type is used to send as part of the protocol between different clients
-- TODO possibly, rename fields and types referring to external and internal IDs to make them different
data AMessageReceipt = AMessageReceipt
  { AMessageReceipt -> AgentMsgId
agentMsgId :: AgentMsgId, -- this is an external snd message ID referenced by the message recipient
    AMessageReceipt -> ConfirmationId
msgHash :: MsgHash,
    AMessageReceipt -> ConfirmationId
rcptInfo :: MsgReceiptInfo
  }
  deriving (Int -> AMessageReceipt -> ShowS
[AMessageReceipt] -> ShowS
AMessageReceipt -> FilePath
(Int -> AMessageReceipt -> ShowS)
-> (AMessageReceipt -> FilePath)
-> ([AMessageReceipt] -> ShowS)
-> Show AMessageReceipt
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AMessageReceipt -> ShowS
showsPrec :: Int -> AMessageReceipt -> ShowS
$cshow :: AMessageReceipt -> FilePath
show :: AMessageReceipt -> FilePath
$cshowList :: [AMessageReceipt] -> ShowS
showList :: [AMessageReceipt] -> ShowS
Show)

-- | this type is used as part of agent protocol to communicate with the user application
data MsgReceipt = MsgReceipt
  { MsgReceipt -> AgentMsgId
agentMsgId :: AgentMsgId, -- this is an internal agent message ID of received message
    MsgReceipt -> MsgReceiptStatus
msgRcptStatus :: MsgReceiptStatus
  }
  deriving (MsgReceipt -> MsgReceipt -> SndQueueSecured
(MsgReceipt -> MsgReceipt -> SndQueueSecured)
-> (MsgReceipt -> MsgReceipt -> SndQueueSecured) -> Eq MsgReceipt
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: MsgReceipt -> MsgReceipt -> SndQueueSecured
== :: MsgReceipt -> MsgReceipt -> SndQueueSecured
$c/= :: MsgReceipt -> MsgReceipt -> SndQueueSecured
/= :: MsgReceipt -> MsgReceipt -> SndQueueSecured
Eq, Int -> MsgReceipt -> ShowS
[MsgReceipt] -> ShowS
MsgReceipt -> FilePath
(Int -> MsgReceipt -> ShowS)
-> (MsgReceipt -> FilePath)
-> ([MsgReceipt] -> ShowS)
-> Show MsgReceipt
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgReceipt -> ShowS
showsPrec :: Int -> MsgReceipt -> ShowS
$cshow :: MsgReceipt -> FilePath
show :: MsgReceipt -> FilePath
$cshowList :: [MsgReceipt] -> ShowS
showList :: [MsgReceipt] -> ShowS
Show)

data MsgReceiptStatus = MROk | MRBadMsgHash
  deriving (MsgReceiptStatus -> MsgReceiptStatus -> SndQueueSecured
(MsgReceiptStatus -> MsgReceiptStatus -> SndQueueSecured)
-> (MsgReceiptStatus -> MsgReceiptStatus -> SndQueueSecured)
-> Eq MsgReceiptStatus
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: MsgReceiptStatus -> MsgReceiptStatus -> SndQueueSecured
== :: MsgReceiptStatus -> MsgReceiptStatus -> SndQueueSecured
$c/= :: MsgReceiptStatus -> MsgReceiptStatus -> SndQueueSecured
/= :: MsgReceiptStatus -> MsgReceiptStatus -> SndQueueSecured
Eq, Int -> MsgReceiptStatus -> ShowS
[MsgReceiptStatus] -> ShowS
MsgReceiptStatus -> FilePath
(Int -> MsgReceiptStatus -> ShowS)
-> (MsgReceiptStatus -> FilePath)
-> ([MsgReceiptStatus] -> ShowS)
-> Show MsgReceiptStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgReceiptStatus -> ShowS
showsPrec :: Int -> MsgReceiptStatus -> ShowS
$cshow :: MsgReceiptStatus -> FilePath
show :: MsgReceiptStatus -> FilePath
$cshowList :: [MsgReceiptStatus] -> ShowS
showList :: [MsgReceiptStatus] -> ShowS
Show)

instance StrEncoding MsgReceiptStatus where
  strEncode :: MsgReceiptStatus -> ConfirmationId
strEncode = \case
    MsgReceiptStatus
MROk -> ConfirmationId
"ok"
    MsgReceiptStatus
MRBadMsgHash -> ConfirmationId
"badMsgHash"
  strP :: Parser MsgReceiptStatus
strP =
    (Char -> SndQueueSecured) -> Parser ConfirmationId ConfirmationId
A.takeWhile1 (Char -> Char -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
/= Char
' ') Parser ConfirmationId ConfirmationId
-> (ConfirmationId -> Parser MsgReceiptStatus)
-> Parser MsgReceiptStatus
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConfirmationId
"ok" -> MsgReceiptStatus -> Parser MsgReceiptStatus
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgReceiptStatus
MROk
      ConfirmationId
"badMsgHash" -> MsgReceiptStatus -> Parser MsgReceiptStatus
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgReceiptStatus
MRBadMsgHash
      ConfirmationId
_ -> FilePath -> Parser MsgReceiptStatus
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad MsgReceiptStatus"

instance ToJSON MsgReceiptStatus where
  toJSON :: MsgReceiptStatus -> Value
toJSON = MsgReceiptStatus -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  toEncoding :: MsgReceiptStatus -> Encoding
toEncoding = MsgReceiptStatus -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding

instance FromJSON MsgReceiptStatus where
  parseJSON :: Value -> Parser MsgReceiptStatus
parseJSON = FilePath -> Value -> Parser MsgReceiptStatus
forall a. StrEncoding a => FilePath -> Value -> Parser a
strParseJSON FilePath
"MsgReceiptStatus"

type MsgReceiptInfo = ByteString

type SndQAddr = (SMPServer, SMP.SenderId)

instance Encoding AMessage where
  smpEncode :: AMessage -> ConfirmationId
smpEncode = \case
    AMessage
HELLO -> AMsgType -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode AMsgType
HELLO_
    A_MSG ConfirmationId
body -> (AMsgType, Tail) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (AMsgType
A_MSG_, ConfirmationId -> Tail
Tail ConfirmationId
body)
    A_RCVD NonEmpty AMessageReceipt
mrs -> (AMsgType, NonEmpty AMessageReceipt) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (AMsgType
A_RCVD_, NonEmpty AMessageReceipt
mrs)
    A_QCONT SndQAddr
addr -> (AMsgType, SndQAddr) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (AMsgType
A_QCONT_, SndQAddr
addr)
    QADD NonEmpty (SMPQueueUri, Maybe SndQAddr)
qs -> (AMsgType, NonEmpty (SMPQueueUri, Maybe SndQAddr))
-> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (AMsgType
QADD_, NonEmpty (SMPQueueUri, Maybe SndQAddr)
qs)
    QKEY NonEmpty (SMPQueueInfo, SndPublicAuthKey)
qs -> (AMsgType, NonEmpty (SMPQueueInfo, SndPublicAuthKey))
-> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (AMsgType
QKEY_, NonEmpty (SMPQueueInfo, SndPublicAuthKey)
qs)
    QUSE NonEmpty (SndQAddr, SndQueueSecured)
qs -> (AMsgType, NonEmpty (SndQAddr, SndQueueSecured)) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (AMsgType
QUSE_, NonEmpty (SndQAddr, SndQueueSecured)
qs)
    QTEST NonEmpty SndQAddr
qs -> (AMsgType, NonEmpty SndQAddr) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (AMsgType
QTEST_, NonEmpty SndQAddr
qs)
    EREADY AgentMsgId
lastDecryptedMsgId -> (AMsgType, AgentMsgId) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (AMsgType
EREADY_, AgentMsgId
lastDecryptedMsgId)
  smpP :: Parser ConfirmationId AMessage
smpP =
    Parser AMsgType
forall a. Encoding a => Parser a
smpP
      Parser AMsgType
-> (AMsgType -> Parser ConfirmationId AMessage)
-> Parser ConfirmationId AMessage
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        AMsgType
HELLO_ -> AMessage -> Parser ConfirmationId AMessage
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AMessage
HELLO
        AMsgType
A_MSG_ -> ConfirmationId -> AMessage
A_MSG (ConfirmationId -> AMessage)
-> (Tail -> ConfirmationId) -> Tail -> AMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tail -> ConfirmationId
unTail (Tail -> AMessage) -> Parser Tail -> Parser ConfirmationId AMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tail
forall a. Encoding a => Parser a
smpP
        AMsgType
A_RCVD_ -> NonEmpty AMessageReceipt -> AMessage
A_RCVD (NonEmpty AMessageReceipt -> AMessage)
-> Parser ConfirmationId (NonEmpty AMessageReceipt)
-> Parser ConfirmationId AMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId (NonEmpty AMessageReceipt)
forall a. Encoding a => Parser a
smpP
        AMsgType
A_QCONT_ -> SndQAddr -> AMessage
A_QCONT (SndQAddr -> AMessage)
-> Parser ConfirmationId SndQAddr -> Parser ConfirmationId AMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId SndQAddr
forall a. Encoding a => Parser a
smpP
        AMsgType
QADD_ -> NonEmpty (SMPQueueUri, Maybe SndQAddr) -> AMessage
QADD (NonEmpty (SMPQueueUri, Maybe SndQAddr) -> AMessage)
-> Parser ConfirmationId (NonEmpty (SMPQueueUri, Maybe SndQAddr))
-> Parser ConfirmationId AMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId (NonEmpty (SMPQueueUri, Maybe SndQAddr))
forall a. Encoding a => Parser a
smpP
        AMsgType
QKEY_ -> NonEmpty (SMPQueueInfo, SndPublicAuthKey) -> AMessage
QKEY (NonEmpty (SMPQueueInfo, SndPublicAuthKey) -> AMessage)
-> Parser
     ConfirmationId (NonEmpty (SMPQueueInfo, SndPublicAuthKey))
-> Parser ConfirmationId AMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId (NonEmpty (SMPQueueInfo, SndPublicAuthKey))
forall a. Encoding a => Parser a
smpP
        AMsgType
QUSE_ -> NonEmpty (SndQAddr, SndQueueSecured) -> AMessage
QUSE (NonEmpty (SndQAddr, SndQueueSecured) -> AMessage)
-> Parser ConfirmationId (NonEmpty (SndQAddr, SndQueueSecured))
-> Parser ConfirmationId AMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId (NonEmpty (SndQAddr, SndQueueSecured))
forall a. Encoding a => Parser a
smpP
        AMsgType
QTEST_ -> NonEmpty SndQAddr -> AMessage
QTEST (NonEmpty SndQAddr -> AMessage)
-> Parser ConfirmationId (NonEmpty SndQAddr)
-> Parser ConfirmationId AMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId (NonEmpty SndQAddr)
forall a. Encoding a => Parser a
smpP
        AMsgType
EREADY_ -> AgentMsgId -> AMessage
EREADY (AgentMsgId -> AMessage)
-> Parser ConfirmationId AgentMsgId
-> Parser ConfirmationId AMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId AgentMsgId
forall a. Encoding a => Parser a
smpP

instance ToField AMessage where toField :: AMessage -> SQLData
toField = Binary ConfirmationId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ConfirmationId -> SQLData)
-> (AMessage -> Binary ConfirmationId) -> AMessage -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> Binary ConfirmationId
forall a. a -> Binary a
Binary (ConfirmationId -> Binary ConfirmationId)
-> (AMessage -> ConfirmationId)
-> AMessage
-> Binary ConfirmationId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AMessage -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode

instance FromField AMessage where fromField :: FieldParser AMessage
fromField = (ConfirmationId -> Either FilePath AMessage)
-> FieldParser AMessage
forall k.
Typeable k =>
(ConfirmationId -> Either FilePath k) -> FieldParser k
blobFieldDecoder ConfirmationId -> Either FilePath AMessage
forall a. Encoding a => ConfirmationId -> Either FilePath a
smpDecode

instance Encoding AMessageReceipt where
  smpEncode :: AMessageReceipt -> ConfirmationId
smpEncode AMessageReceipt {AgentMsgId
$sel:agentMsgId:AMessageReceipt :: AMessageReceipt -> AgentMsgId
agentMsgId :: AgentMsgId
agentMsgId, ConfirmationId
$sel:msgHash:AMessageReceipt :: AMessageReceipt -> ConfirmationId
msgHash :: ConfirmationId
msgHash, ConfirmationId
$sel:rcptInfo:AMessageReceipt :: AMessageReceipt -> ConfirmationId
rcptInfo :: ConfirmationId
rcptInfo} =
    (AgentMsgId, ConfirmationId, Large) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (AgentMsgId
agentMsgId, ConfirmationId
msgHash, ConfirmationId -> Large
Large ConfirmationId
rcptInfo)
  smpP :: Parser AMessageReceipt
smpP = do
    (AgentMsgId
agentMsgId, ConfirmationId
msgHash, Large ConfirmationId
rcptInfo) <- Parser (AgentMsgId, ConfirmationId, Large)
forall a. Encoding a => Parser a
smpP
    AMessageReceipt -> Parser AMessageReceipt
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AMessageReceipt {AgentMsgId
$sel:agentMsgId:AMessageReceipt :: AgentMsgId
agentMsgId :: AgentMsgId
agentMsgId, ConfirmationId
$sel:msgHash:AMessageReceipt :: ConfirmationId
msgHash :: ConfirmationId
msgHash, ConfirmationId
$sel:rcptInfo:AMessageReceipt :: ConfirmationId
rcptInfo :: ConfirmationId
rcptInfo}

instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where
  strEncode :: ConnectionRequestUri m -> ConfirmationId
strEncode = \case
    CRInvitationUri ConnReqUriData
crData RcvE2ERatchetParamsUri 'X448
e2eParams -> ConfirmationId
-> ConnReqUriData
-> Maybe (RcvE2ERatchetParamsUri 'X448)
-> ConfirmationId
crEncode ConfirmationId
"invitation" ConnReqUriData
crData (RcvE2ERatchetParamsUri 'X448
-> Maybe (RcvE2ERatchetParamsUri 'X448)
forall a. a -> Maybe a
Just RcvE2ERatchetParamsUri 'X448
e2eParams)
    CRContactUri ConnReqUriData
crData -> ConfirmationId
-> ConnReqUriData
-> Maybe (RcvE2ERatchetParamsUri 'X448)
-> ConfirmationId
crEncode ConfirmationId
"contact" ConnReqUriData
crData Maybe (RcvE2ERatchetParamsUri 'X448)
forall a. Maybe a
Nothing
    where
      crEncode :: ByteString -> ConnReqUriData -> Maybe (RcvE2ERatchetParamsUri 'C.X448) -> ByteString
      crEncode :: ConfirmationId
-> ConnReqUriData
-> Maybe (RcvE2ERatchetParamsUri 'X448)
-> ConfirmationId
crEncode ConfirmationId
crMode ConnReqUriData {ServiceScheme
crScheme :: ServiceScheme
$sel:crScheme:ConnReqUriData :: ConnReqUriData -> ServiceScheme
crScheme, VersionRangeSMPA
crAgentVRange :: VersionRangeSMPA
$sel:crAgentVRange:ConnReqUriData :: ConnReqUriData -> VersionRangeSMPA
crAgentVRange, NonEmpty SMPQueueUri
crSmpQueues :: NonEmpty SMPQueueUri
$sel:crSmpQueues:ConnReqUriData :: ConnReqUriData -> NonEmpty SMPQueueUri
crSmpQueues, Maybe CRClientData
crClientData :: Maybe CRClientData
$sel:crClientData:ConnReqUriData :: ConnReqUriData -> Maybe CRClientData
crClientData} Maybe (RcvE2ERatchetParamsUri 'X448)
e2eParams =
        ServiceScheme -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode ServiceScheme
crScheme ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
"/" ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
crMode ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
"#/?" ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
queryStr
        where
          queryStr :: ConfirmationId
queryStr =
            QueryStringParams -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode (QueryStringParams -> ConfirmationId)
-> (SimpleQuery -> QueryStringParams)
-> SimpleQuery
-> ConfirmationId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QSPEscaping -> SimpleQuery -> QueryStringParams
QSP QSPEscaping
QEscape (SimpleQuery -> ConfirmationId) -> SimpleQuery -> ConfirmationId
forall a b. (a -> b) -> a -> b
$
              -- semicolon is used to separate SMP queues because comma is used to separate server address hostnames
              [(ConfirmationId
"v", VersionRangeSMPA -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode VersionRangeSMPA
crAgentVRange), (ConfirmationId
"smp", ConfirmationId -> [ConfirmationId] -> ConfirmationId
B.intercalate ConfirmationId
";" ([ConfirmationId] -> ConfirmationId)
-> [ConfirmationId] -> ConfirmationId
forall a b. (a -> b) -> a -> b
$ (SMPQueueUri -> ConfirmationId)
-> [SMPQueueUri] -> [ConfirmationId]
forall a b. (a -> b) -> [a] -> [b]
map SMPQueueUri -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode ([SMPQueueUri] -> [ConfirmationId])
-> [SMPQueueUri] -> [ConfirmationId]
forall a b. (a -> b) -> a -> b
$ NonEmpty SMPQueueUri -> [SMPQueueUri]
forall a. NonEmpty a -> [a]
L.toList NonEmpty SMPQueueUri
crSmpQueues)]
                SimpleQuery -> SimpleQuery -> SimpleQuery
forall a. Semigroup a => a -> a -> a
<> SimpleQuery
-> (RcvE2ERatchetParamsUri 'X448 -> SimpleQuery)
-> Maybe (RcvE2ERatchetParamsUri 'X448)
-> SimpleQuery
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\RcvE2ERatchetParamsUri 'X448
e2e -> [(ConfirmationId
"e2e", RcvE2ERatchetParamsUri 'X448 -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode RcvE2ERatchetParamsUri 'X448
e2e)]) Maybe (RcvE2ERatchetParamsUri 'X448)
e2eParams
                SimpleQuery -> SimpleQuery -> SimpleQuery
forall a. Semigroup a => a -> a -> a
<> SimpleQuery
-> (CRClientData -> SimpleQuery)
-> Maybe CRClientData
-> SimpleQuery
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\CRClientData
cd -> [(ConfirmationId
"data", CRClientData -> ConfirmationId
encodeUtf8 CRClientData
cd)]) Maybe CRClientData
crClientData
  strP :: Parser (ConnectionRequestUri m)
strP = Maybe ServiceScheme -> Parser (ConnectionRequestUri m)
forall (m :: ConnectionMode).
ConnectionModeI m =>
Maybe ServiceScheme -> Parser (ConnectionRequestUri m)
connReqUriP' (ServiceScheme -> Maybe ServiceScheme
forall a. a -> Maybe a
Just ServiceScheme
SSSimplex)

instance ConnectionModeI m => Encoding (ConnectionRequestUri m) where
  smpEncode :: ConnectionRequestUri m -> ConfirmationId
smpEncode = \case
    CRInvitationUri ConnReqUriData
crData RcvE2ERatchetParamsUri 'X448
e2eParams -> (ConnectionMode, ConnReqUriData, RcvE2ERatchetParamsUri 'X448)
-> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (ConnectionMode
CMInvitation, ConnReqUriData
crData, RcvE2ERatchetParamsUri 'X448
e2eParams)
    CRContactUri ConnReqUriData
crData -> (ConnectionMode, ConnReqUriData) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (ConnectionMode
CMContact, ConnReqUriData
crData)
  smpP :: Parser (ConnectionRequestUri m)
smpP = (\(ACR SConnectionMode m
_ ConnectionRequestUri m
cr) -> ConnectionRequestUri m -> Either FilePath (ConnectionRequestUri m)
forall (t :: ConnectionMode -> *) (m :: ConnectionMode)
       (m' :: ConnectionMode).
(ConnectionModeI m, ConnectionModeI m') =>
t m' -> Either FilePath (t m)
checkConnMode ConnectionRequestUri m
cr) (AConnectionRequestUri -> Either FilePath (ConnectionRequestUri m))
-> Parser ConfirmationId AConnectionRequestUri
-> Parser (ConnectionRequestUri m)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either FilePath b) -> m a -> m b
<$?> Parser ConfirmationId AConnectionRequestUri
forall a. Encoding a => Parser a
smpP
  {-# INLINE smpP #-}

instance Encoding AConnectionRequestUri where
  smpEncode :: AConnectionRequestUri -> ConfirmationId
smpEncode (ACR SConnectionMode m
_ ConnectionRequestUri m
cr) = ConnectionRequestUri m -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode ConnectionRequestUri m
cr
  {-# INLINE smpEncode #-}
  smpP :: Parser ConfirmationId AConnectionRequestUri
smpP =
    Parser ConnectionMode
forall a. Encoding a => Parser a
smpP Parser ConnectionMode
-> (ConnectionMode -> Parser ConfirmationId AConnectionRequestUri)
-> Parser ConfirmationId AConnectionRequestUri
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConnectionMode
CMInvitation -> SConnectionMode 'CMInvitation
-> ConnectionRequestUri 'CMInvitation -> AConnectionRequestUri
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m
-> ConnectionRequestUri m -> AConnectionRequestUri
ACR SConnectionMode 'CMInvitation
SCMInvitation (ConnectionRequestUri 'CMInvitation -> AConnectionRequestUri)
-> Parser ConfirmationId (ConnectionRequestUri 'CMInvitation)
-> Parser ConfirmationId AConnectionRequestUri
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConnReqUriData
-> RcvE2ERatchetParamsUri 'X448
-> ConnectionRequestUri 'CMInvitation
CRInvitationUri (ConnReqUriData
 -> RcvE2ERatchetParamsUri 'X448
 -> ConnectionRequestUri 'CMInvitation)
-> Parser ConfirmationId ConnReqUriData
-> Parser
     ConfirmationId
     (RcvE2ERatchetParamsUri 'X448
      -> ConnectionRequestUri 'CMInvitation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId ConnReqUriData
forall a. Encoding a => Parser a
smpP Parser
  ConfirmationId
  (RcvE2ERatchetParamsUri 'X448
   -> ConnectionRequestUri 'CMInvitation)
-> Parser ConfirmationId (RcvE2ERatchetParamsUri 'X448)
-> Parser ConfirmationId (ConnectionRequestUri 'CMInvitation)
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfirmationId (RcvE2ERatchetParamsUri 'X448)
forall a. Encoding a => Parser a
smpP)
      ConnectionMode
CMContact -> SConnectionMode 'CMContact
-> ConnectionRequestUri 'CMContact -> AConnectionRequestUri
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m
-> ConnectionRequestUri m -> AConnectionRequestUri
ACR SConnectionMode 'CMContact
SCMContact (ConnectionRequestUri 'CMContact -> AConnectionRequestUri)
-> (ConnReqUriData -> ConnectionRequestUri 'CMContact)
-> ConnReqUriData
-> AConnectionRequestUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnReqUriData -> ConnectionRequestUri 'CMContact
CRContactUri (ConnReqUriData -> AConnectionRequestUri)
-> Parser ConfirmationId ConnReqUriData
-> Parser ConfirmationId AConnectionRequestUri
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId ConnReqUriData
forall a. Encoding a => Parser a
smpP

instance Encoding ConnReqUriData where
  smpEncode :: ConnReqUriData -> ConfirmationId
smpEncode ConnReqUriData {VersionRangeSMPA
$sel:crAgentVRange:ConnReqUriData :: ConnReqUriData -> VersionRangeSMPA
crAgentVRange :: VersionRangeSMPA
crAgentVRange, NonEmpty SMPQueueUri
$sel:crSmpQueues:ConnReqUriData :: ConnReqUriData -> NonEmpty SMPQueueUri
crSmpQueues :: NonEmpty SMPQueueUri
crSmpQueues, Maybe CRClientData
$sel:crClientData:ConnReqUriData :: ConnReqUriData -> Maybe CRClientData
crClientData :: Maybe CRClientData
crClientData} =
    (VersionRangeSMPA, NonEmpty SMPQueueUri, Maybe Large)
-> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (VersionRangeSMPA
crAgentVRange, NonEmpty SMPQueueUri
crSmpQueues, ConfirmationId -> Large
Large (ConfirmationId -> Large)
-> (CRClientData -> ConfirmationId) -> CRClientData -> Large
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRClientData -> ConfirmationId
encodeUtf8 (CRClientData -> Large) -> Maybe CRClientData -> Maybe Large
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CRClientData
crClientData)
  smpP :: Parser ConfirmationId ConnReqUriData
smpP = do
    (VersionRangeSMPA
crAgentVRange, NonEmpty SMPQueueUri
smpQueues, Maybe Large
clientData) <- Parser (VersionRangeSMPA, NonEmpty SMPQueueUri, Maybe Large)
forall a. Encoding a => Parser a
smpP
    -- This patch to compensate for the fact that queueMode QMContact won't be included in queue encoding,
    -- until min SMP client version is >= 3 (sndAuthKeySMPClientVersion).
    -- This is possible because SMP encoding of ConnReqUriData was not used prior to SMP client version 4.
    let crSmpQueues :: NonEmpty SMPQueueUri
crSmpQueues = (SMPQueueUri -> SMPQueueUri)
-> NonEmpty SMPQueueUri -> NonEmpty SMPQueueUri
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map SMPQueueUri -> SMPQueueUri
patchQueueMode NonEmpty SMPQueueUri
smpQueues
    ConnReqUriData -> Parser ConfirmationId ConnReqUriData
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnReqUriData {$sel:crScheme:ConnReqUriData :: ServiceScheme
crScheme = ServiceScheme
SSSimplex, VersionRangeSMPA
$sel:crAgentVRange:ConnReqUriData :: VersionRangeSMPA
crAgentVRange :: VersionRangeSMPA
crAgentVRange, NonEmpty SMPQueueUri
$sel:crSmpQueues:ConnReqUriData :: NonEmpty SMPQueueUri
crSmpQueues :: NonEmpty SMPQueueUri
crSmpQueues, $sel:crClientData:ConnReqUriData :: Maybe CRClientData
crClientData = ConfirmationId -> CRClientData
safeDecodeUtf8 (ConfirmationId -> CRClientData)
-> (Large -> ConfirmationId) -> Large -> CRClientData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Large -> ConfirmationId
unLarge (Large -> CRClientData) -> Maybe Large -> Maybe CRClientData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Large
clientData}
    where
      patchQueueMode :: SMPQueueUri -> SMPQueueUri
patchQueueMode q :: SMPQueueUri
q@SMPQueueUri {$sel:queueAddress:SMPQueueUri :: SMPQueueUri -> SMPQueueAddress
queueAddress = SMPQueueAddress
a} = case SMPQueueAddress
a of
        SMPQueueAddress {$sel:queueMode:SMPQueueAddress :: SMPQueueAddress -> Maybe QueueMode
queueMode = Maybe QueueMode
Nothing} -> SMPQueueUri
q {queueAddress = a {queueMode = Just QMContact}} :: SMPQueueUri
        SMPQueueAddress
_ -> SMPQueueUri
q

connReqUriP' :: forall m. ConnectionModeI m => Maybe ServiceScheme -> Parser (ConnectionRequestUri m)
connReqUriP' :: forall (m :: ConnectionMode).
ConnectionModeI m =>
Maybe ServiceScheme -> Parser (ConnectionRequestUri m)
connReqUriP' Maybe ServiceScheme
overrideScheme = do
  ACR SConnectionMode m
m ConnectionRequestUri m
cr <- Maybe ServiceScheme -> Parser ConfirmationId AConnectionRequestUri
connReqUriP Maybe ServiceScheme
overrideScheme
  case SConnectionMode m -> SConnectionMode m -> Maybe (m :~: m)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: ConnectionMode) (b :: ConnectionMode).
SConnectionMode a -> SConnectionMode b -> Maybe (a :~: b)
testEquality SConnectionMode m
m (SConnectionMode m -> Maybe (m :~: m))
-> SConnectionMode m -> Maybe (m :~: m)
forall a b. (a -> b) -> a -> b
$ forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m
sConnectionMode @m of
    Just m :~: m
Refl -> ConnectionRequestUri m -> Parser (ConnectionRequestUri m)
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectionRequestUri m
ConnectionRequestUri m
cr
    Maybe (m :~: m)
_ -> FilePath -> Parser (ConnectionRequestUri m)
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad connection request mode"

instance StrEncoding AConnectionRequestUri where
  strEncode :: AConnectionRequestUri -> ConfirmationId
strEncode (ACR SConnectionMode m
_ ConnectionRequestUri m
cr) = ConnectionRequestUri m -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode ConnectionRequestUri m
cr
  strP :: Parser ConfirmationId AConnectionRequestUri
strP = Maybe ServiceScheme -> Parser ConfirmationId AConnectionRequestUri
connReqUriP (ServiceScheme -> Maybe ServiceScheme
forall a. a -> Maybe a
Just ServiceScheme
SSSimplex)

connReqUriP :: Maybe ServiceScheme -> Parser AConnectionRequestUri
connReqUriP :: Maybe ServiceScheme -> Parser ConfirmationId AConnectionRequestUri
connReqUriP Maybe ServiceScheme
overrideScheme = do
  ServiceScheme
crScheme <- (ServiceScheme -> Maybe ServiceScheme -> ServiceScheme
forall a. a -> Maybe a -> a
`fromMaybe` Maybe ServiceScheme
overrideScheme) (ServiceScheme -> ServiceScheme)
-> Parser ConfirmationId ServiceScheme
-> Parser ConfirmationId ServiceScheme
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId ServiceScheme
forall a. StrEncoding a => Parser a
strP -- always parse, but use the passed one if any
  ConnectionMode
crMode <- Char -> Parser Char
A.char Char
'/' Parser Char -> Parser ConnectionMode -> Parser ConnectionMode
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ConnectionMode
crModeP Parser ConnectionMode
-> Parser ConfirmationId (Maybe Char) -> Parser ConnectionMode
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char -> Parser ConfirmationId (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Char
A.char Char
'/') Parser ConnectionMode
-> Parser ConfirmationId ConfirmationId -> Parser ConnectionMode
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ConfirmationId ConfirmationId
"#/?"
  QueryStringParams
query <- Parser QueryStringParams
forall a. StrEncoding a => Parser a
strP
  VersionRangeSMPA
aVRange <- ConfirmationId -> QueryStringParams -> Parser VersionRangeSMPA
forall a.
StrEncoding a =>
ConfirmationId -> QueryStringParams -> Parser a
queryParam ConfirmationId
"v" QueryStringParams
query
  NonEmpty SMPQueueUri
crSmpQueues <- Parser (NonEmpty SMPQueueUri)
-> ConfirmationId
-> QueryStringParams
-> Parser (NonEmpty SMPQueueUri)
forall a.
Parser a -> ConfirmationId -> QueryStringParams -> Parser a
queryParamParser Parser (NonEmpty SMPQueueUri)
queuesP ConfirmationId
"smp" QueryStringParams
query
  let crClientData :: Maybe CRClientData
crClientData = ConfirmationId -> CRClientData
safeDecodeUtf8 (ConfirmationId -> CRClientData)
-> Maybe ConfirmationId -> Maybe CRClientData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfirmationId -> QueryStringParams -> Maybe ConfirmationId
queryParamStr ConfirmationId
"data" QueryStringParams
query
      crData :: ConnReqUriData
crData = ConnReqUriData {ServiceScheme
$sel:crScheme:ConnReqUriData :: ServiceScheme
crScheme :: ServiceScheme
crScheme, $sel:crAgentVRange:ConnReqUriData :: VersionRangeSMPA
crAgentVRange = VersionRangeSMPA
aVRange, NonEmpty SMPQueueUri
$sel:crSmpQueues:ConnReqUriData :: NonEmpty SMPQueueUri
crSmpQueues :: NonEmpty SMPQueueUri
crSmpQueues, Maybe CRClientData
$sel:crClientData:ConnReqUriData :: Maybe CRClientData
crClientData :: Maybe CRClientData
crClientData}
  case ConnectionMode
crMode of
    ConnectionMode
CMInvitation -> do
      RcvE2ERatchetParamsUri 'X448
crE2eParams <- ConfirmationId
-> QueryStringParams
-> Parser ConfirmationId (RcvE2ERatchetParamsUri 'X448)
forall a.
StrEncoding a =>
ConfirmationId -> QueryStringParams -> Parser a
queryParam ConfirmationId
"e2e" QueryStringParams
query
      AConnectionRequestUri
-> Parser ConfirmationId AConnectionRequestUri
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AConnectionRequestUri
 -> Parser ConfirmationId AConnectionRequestUri)
-> (ConnectionRequestUri 'CMInvitation -> AConnectionRequestUri)
-> ConnectionRequestUri 'CMInvitation
-> Parser ConfirmationId AConnectionRequestUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SConnectionMode 'CMInvitation
-> ConnectionRequestUri 'CMInvitation -> AConnectionRequestUri
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m
-> ConnectionRequestUri m -> AConnectionRequestUri
ACR SConnectionMode 'CMInvitation
SCMInvitation (ConnectionRequestUri 'CMInvitation
 -> Parser ConfirmationId AConnectionRequestUri)
-> ConnectionRequestUri 'CMInvitation
-> Parser ConfirmationId AConnectionRequestUri
forall a b. (a -> b) -> a -> b
$ ConnReqUriData
-> RcvE2ERatchetParamsUri 'X448
-> ConnectionRequestUri 'CMInvitation
CRInvitationUri ConnReqUriData
crData RcvE2ERatchetParamsUri 'X448
crE2eParams
    -- contact links are adjusted to the minimum version supported by the agent
    -- to preserve compatibility with the old links published online
    ConnectionMode
CMContact -> AConnectionRequestUri
-> Parser ConfirmationId AConnectionRequestUri
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AConnectionRequestUri
 -> Parser ConfirmationId AConnectionRequestUri)
-> (ConnectionRequestUri 'CMContact -> AConnectionRequestUri)
-> ConnectionRequestUri 'CMContact
-> Parser ConfirmationId AConnectionRequestUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SConnectionMode 'CMContact
-> ConnectionRequestUri 'CMContact -> AConnectionRequestUri
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m
-> ConnectionRequestUri m -> AConnectionRequestUri
ACR SConnectionMode 'CMContact
SCMContact (ConnectionRequestUri 'CMContact
 -> Parser ConfirmationId AConnectionRequestUri)
-> ConnectionRequestUri 'CMContact
-> Parser ConfirmationId AConnectionRequestUri
forall a b. (a -> b) -> a -> b
$ ConnReqUriData -> ConnectionRequestUri 'CMContact
CRContactUri ConnReqUriData
crData {crAgentVRange = adjustAgentVRange aVRange}
  where
    crModeP :: Parser ConnectionMode
crModeP = Parser ConfirmationId ConfirmationId
"invitation" Parser ConfirmationId ConfirmationId
-> ConnectionMode -> Parser ConnectionMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ConnectionMode
CMInvitation Parser ConnectionMode
-> Parser ConnectionMode -> Parser ConnectionMode
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ConfirmationId ConfirmationId
"contact" Parser ConfirmationId ConfirmationId
-> ConnectionMode -> Parser ConnectionMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ConnectionMode
CMContact
    -- semicolon is used to separate SMP queues because comma is used to separate server address hostnames
    queuesP :: Parser (NonEmpty SMPQueueUri)
queuesP = [SMPQueueUri] -> NonEmpty SMPQueueUri
forall a. HasCallStack => [a] -> NonEmpty a
L.fromList ([SMPQueueUri] -> NonEmpty SMPQueueUri)
-> Parser ConfirmationId [SMPQueueUri]
-> Parser (NonEmpty SMPQueueUri)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConfirmationId -> Either FilePath SMPQueueUri
forall a. StrEncoding a => ConfirmationId -> Either FilePath a
strDecode (ConfirmationId -> Either FilePath SMPQueueUri)
-> Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId SMPQueueUri
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either FilePath b) -> m a -> m b
<$?> (Char -> SndQueueSecured) -> Parser ConfirmationId ConfirmationId
A.takeTill (Char -> Char -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== Char
';')) Parser ConfirmationId SMPQueueUri
-> Parser Char -> Parser ConfirmationId [SMPQueueUri]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`A.sepBy1'` Char -> Parser Char
A.char Char
';'
    adjustAgentVRange :: VersionRangeSMPA -> VersionRangeSMPA
adjustAgentVRange VersionRangeSMPA
vr =
      let v :: VersionSMPA
v = VersionSMPA -> VersionSMPA -> VersionSMPA
forall a. Ord a => a -> a -> a
max VersionSMPA
minSupportedSMPAgentVersion (VersionSMPA -> VersionSMPA) -> VersionSMPA -> VersionSMPA
forall a b. (a -> b) -> a -> b
$ VersionRangeSMPA -> VersionSMPA
forall v. VersionRange v -> Version v
minVersion VersionRangeSMPA
vr
       in VersionRangeSMPA -> Maybe VersionRangeSMPA -> VersionRangeSMPA
forall a. a -> Maybe a -> a
fromMaybe VersionRangeSMPA
vr (Maybe VersionRangeSMPA -> VersionRangeSMPA)
-> Maybe VersionRangeSMPA -> VersionRangeSMPA
forall a b. (a -> b) -> a -> b
$ VersionSMPA -> VersionSMPA -> Maybe VersionRangeSMPA
forall v. Version v -> Version v -> Maybe (VersionRange v)
safeVersionRange VersionSMPA
v (VersionSMPA -> VersionSMPA -> VersionSMPA
forall a. Ord a => a -> a -> a
max VersionSMPA
v (VersionSMPA -> VersionSMPA) -> VersionSMPA -> VersionSMPA
forall a b. (a -> b) -> a -> b
$ VersionRangeSMPA -> VersionSMPA
forall v. VersionRange v -> Version v
maxVersion VersionRangeSMPA
vr)

instance ConnectionModeI m => FromJSON (ConnectionRequestUri m) where
  parseJSON :: Value -> Parser (ConnectionRequestUri m)
parseJSON = FilePath -> Value -> Parser (ConnectionRequestUri m)
forall a. StrEncoding a => FilePath -> Value -> Parser a
strParseJSON FilePath
"ConnectionRequestUri"
  {-# INLINE parseJSON #-}

instance ConnectionModeI m => ToJSON (ConnectionRequestUri m) where
  toJSON :: ConnectionRequestUri m -> Value
toJSON = ConnectionRequestUri m -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  {-# INLINE toJSON #-}
  toEncoding :: ConnectionRequestUri m -> Encoding
toEncoding = ConnectionRequestUri m -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding
  {-# INLINE toEncoding #-}

instance FromJSON AConnectionRequestUri where
  parseJSON :: Value -> Parser AConnectionRequestUri
parseJSON = FilePath -> Value -> Parser AConnectionRequestUri
forall a. StrEncoding a => FilePath -> Value -> Parser a
strParseJSON FilePath
"ConnectionRequestUri"
  {-# INLINE parseJSON #-}

instance ToJSON AConnectionRequestUri where
  toJSON :: AConnectionRequestUri -> Value
toJSON = AConnectionRequestUri -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  {-# INLINE toJSON #-}
  toEncoding :: AConnectionRequestUri -> Encoding
toEncoding = AConnectionRequestUri -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding
  {-# INLINE toEncoding #-}

instance ConnectionModeI m => FromJSON (ConnShortLink m) where
  parseJSON :: Value -> Parser (ConnShortLink m)
parseJSON = FilePath -> Value -> Parser (ConnShortLink m)
forall a. StrEncoding a => FilePath -> Value -> Parser a
strParseJSON FilePath
"ConnShortLink"
  {-# INLINE parseJSON #-}

instance ConnectionModeI m => ToJSON (ConnShortLink m) where
  toJSON :: ConnShortLink m -> Value
toJSON = ConnShortLink m -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  {-# INLINE toJSON #-}
  toEncoding :: ConnShortLink m -> Encoding
toEncoding = ConnShortLink m -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding
  {-# INLINE toEncoding #-}

instance FromJSON AConnShortLink where
  parseJSON :: Value -> Parser AConnShortLink
parseJSON = FilePath -> Value -> Parser AConnShortLink
forall a. StrEncoding a => FilePath -> Value -> Parser a
strParseJSON FilePath
"AConnShortLink"
  {-# INLINE parseJSON #-}

instance ToJSON AConnShortLink where
  toJSON :: AConnShortLink -> Value
toJSON = AConnShortLink -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  toEncoding :: AConnShortLink -> Encoding
toEncoding = AConnShortLink -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding

-- debug :: Show a => String -> a -> a
-- debug name value = unsafePerformIO (putStrLn $ name <> ": " <> show value) `seq` value
-- {-# INLINE debug #-}

instance StrEncoding ConnectionMode where
  strEncode :: ConnectionMode -> ConfirmationId
strEncode = \case
    ConnectionMode
CMInvitation -> ConfirmationId
"INV"
    ConnectionMode
CMContact -> ConfirmationId
"CON"
  strP :: Parser ConnectionMode
strP = Parser ConfirmationId ConfirmationId
"INV" Parser ConfirmationId ConfirmationId
-> ConnectionMode -> Parser ConnectionMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ConnectionMode
CMInvitation Parser ConnectionMode
-> Parser ConnectionMode -> Parser ConnectionMode
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ConfirmationId ConfirmationId
"CON" Parser ConfirmationId ConfirmationId
-> ConnectionMode -> Parser ConnectionMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ConnectionMode
CMContact

instance StrEncoding AConnectionMode where
  strEncode :: AConnectionMode -> ConfirmationId
strEncode (ACM SConnectionMode m
cMode) = ConnectionMode -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode (ConnectionMode -> ConfirmationId)
-> ConnectionMode -> ConfirmationId
forall a b. (a -> b) -> a -> b
$ SConnectionMode m -> ConnectionMode
forall (m :: ConnectionMode). SConnectionMode m -> ConnectionMode
connMode SConnectionMode m
cMode
  strP :: Parser AConnectionMode
strP = ConnectionMode -> AConnectionMode
connMode' (ConnectionMode -> AConnectionMode)
-> Parser ConnectionMode -> Parser AConnectionMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConnectionMode
forall a. StrEncoding a => Parser a
strP

instance Encoding ConnectionMode where
  smpEncode :: ConnectionMode -> ConfirmationId
smpEncode = \case
    ConnectionMode
CMInvitation -> ConfirmationId
"I"
    ConnectionMode
CMContact -> ConfirmationId
"C"
  smpP :: Parser ConnectionMode
smpP =
    Parser Char
A.anyChar Parser Char
-> (Char -> Parser ConnectionMode) -> Parser ConnectionMode
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Char
'I' -> ConnectionMode -> Parser ConnectionMode
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectionMode
CMInvitation
      Char
'C' -> ConnectionMode -> Parser ConnectionMode
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectionMode
CMContact
      Char
_ -> FilePath -> Parser ConnectionMode
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad connection mode"

instance ToJSON ConnectionMode where
  toJSON :: ConnectionMode -> Value
toJSON = CRClientData -> Value
J'.String (CRClientData -> Value)
-> (ConnectionMode -> CRClientData) -> ConnectionMode -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRClientData -> CRClientData
T.toLower (CRClientData -> CRClientData)
-> (ConnectionMode -> CRClientData)
-> ConnectionMode
-> CRClientData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> CRClientData
decodeLatin1 (ConfirmationId -> CRClientData)
-> (ConnectionMode -> ConfirmationId)
-> ConnectionMode
-> CRClientData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionMode -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode
  {-# INLINE toJSON #-}
  toEncoding :: ConnectionMode -> Encoding
toEncoding = CRClientData -> Encoding
forall a. CRClientData -> Encoding' a
JE.text (CRClientData -> Encoding)
-> (ConnectionMode -> CRClientData) -> ConnectionMode -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRClientData -> CRClientData
T.toLower (CRClientData -> CRClientData)
-> (ConnectionMode -> CRClientData)
-> ConnectionMode
-> CRClientData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> CRClientData
decodeLatin1 (ConfirmationId -> CRClientData)
-> (ConnectionMode -> ConfirmationId)
-> ConnectionMode
-> CRClientData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionMode -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode
  {-# INLINE toEncoding #-}

instance FromJSON ConnectionMode where
  parseJSON :: Value -> Parser ConnectionMode
parseJSON = FilePath
-> (CRClientData -> Parser ConnectionMode)
-> Value
-> Parser ConnectionMode
forall a.
FilePath -> (CRClientData -> Parser a) -> Value -> Parser a
J'.withText FilePath
"ConnectionMode" ((CRClientData -> Parser ConnectionMode)
 -> Value -> Parser ConnectionMode)
-> (CRClientData -> Parser ConnectionMode)
-> Value
-> Parser ConnectionMode
forall a b. (a -> b) -> a -> b
$ (FilePath -> Parser ConnectionMode)
-> (ConnectionMode -> Parser ConnectionMode)
-> Either FilePath ConnectionMode
-> Parser ConnectionMode
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> Parser ConnectionMode
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail ConnectionMode -> Parser ConnectionMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath ConnectionMode -> Parser ConnectionMode)
-> (CRClientData -> Either FilePath ConnectionMode)
-> CRClientData
-> Parser ConnectionMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ConnectionMode
-> ConfirmationId -> Either FilePath ConnectionMode
forall a. Parser a -> ConfirmationId -> Either FilePath a
parseAll Parser ConnectionMode
forall a. StrEncoding a => Parser a
strP (ConfirmationId -> Either FilePath ConnectionMode)
-> (CRClientData -> ConfirmationId)
-> CRClientData
-> Either FilePath ConnectionMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRClientData -> ConfirmationId
encodeUtf8 (CRClientData -> ConfirmationId)
-> (CRClientData -> CRClientData) -> CRClientData -> ConfirmationId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRClientData -> CRClientData
T.toUpper
  {-# INLINE parseJSON #-}

connModeT :: Text -> Maybe ConnectionMode
connModeT :: CRClientData -> Maybe ConnectionMode
connModeT = \case
  CRClientData
"INV" -> ConnectionMode -> Maybe ConnectionMode
forall a. a -> Maybe a
Just ConnectionMode
CMInvitation
  CRClientData
"CON" -> ConnectionMode -> Maybe ConnectionMode
forall a. a -> Maybe a
Just ConnectionMode
CMContact
  CRClientData
_ -> Maybe ConnectionMode
forall a. Maybe a
Nothing

-- | SMP agent connection ID.
type ConnId = ByteString

type ConfirmationId = ByteString

type InvitationId = ByteString

extraSMPServerHosts :: Map TransportHost TransportHost
extraSMPServerHosts :: Map TransportHost TransportHost
extraSMPServerHosts =
  [(TransportHost, TransportHost)] -> Map TransportHost TransportHost
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (TransportHost
"smp4.simplex.im", TransportHost
"o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion"),
      (TransportHost
"smp5.simplex.im", TransportHost
"jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion"),
      (TransportHost
"smp6.simplex.im", TransportHost
"bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"),
      (TransportHost
"smp8.simplex.im", TransportHost
"beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion"),
      (TransportHost
"smp9.simplex.im", TransportHost
"jssqzccmrcws6bhmn77vgmhfjmhwlyr3u7puw4erkyoosywgl67slqqd.onion"),
      (TransportHost
"smp10.simplex.im", TransportHost
"rb2pbttocvnbrngnwziclp2f4ckjq65kebafws6g4hy22cdaiv5dwjqd.onion")
    ]

updateSMPServerHosts :: SMPServer -> SMPServer
updateSMPServerHosts :: SMPServer -> SMPServer
updateSMPServerHosts srv :: SMPServer
srv@ProtocolServer {NonEmpty TransportHost
host :: NonEmpty TransportHost
$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host} = case NonEmpty TransportHost
host of
  TransportHost
h :| [] -> case TransportHost
-> Map TransportHost TransportHost -> Maybe TransportHost
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TransportHost
h Map TransportHost TransportHost
extraSMPServerHosts of
    Just TransportHost
h' -> SMPServer
srv {host = [h, h']}
    Maybe TransportHost
_ -> SMPServer
srv
  NonEmpty TransportHost
_ -> SMPServer
srv

class SMPQueue q where
  qServer :: q -> SMPServer
  queueId :: q -> SMP.QueueId

qAddress :: SMPQueue q => q -> (SMPServer, SMP.QueueId)
qAddress :: forall q. SMPQueue q => q -> SndQAddr
qAddress q
q = (q -> SMPServer
forall q. SMPQueue q => q -> SMPServer
qServer q
q, q -> LinkId
forall q. SMPQueue q => q -> LinkId
queueId q
q)
{-# INLINE qAddress #-}

sameQueue :: SMPQueue q => (SMPServer, SMP.QueueId) -> q -> Bool
sameQueue :: forall q. SMPQueue q => SndQAddr -> q -> SndQueueSecured
sameQueue SndQAddr
addr q
q = SndQAddr -> SndQAddr -> SndQueueSecured
sameQAddress SndQAddr
addr (q -> SndQAddr
forall q. SMPQueue q => q -> SndQAddr
qAddress q
q)
{-# INLINE sameQueue #-}

data SMPQueueInfo = SMPQueueInfo {SMPQueueInfo -> VersionSMPC
clientVersion :: VersionSMPC, SMPQueueInfo -> SMPQueueAddress
queueAddress :: SMPQueueAddress}
  deriving (SMPQueueInfo -> SMPQueueInfo -> SndQueueSecured
(SMPQueueInfo -> SMPQueueInfo -> SndQueueSecured)
-> (SMPQueueInfo -> SMPQueueInfo -> SndQueueSecured)
-> Eq SMPQueueInfo
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: SMPQueueInfo -> SMPQueueInfo -> SndQueueSecured
== :: SMPQueueInfo -> SMPQueueInfo -> SndQueueSecured
$c/= :: SMPQueueInfo -> SMPQueueInfo -> SndQueueSecured
/= :: SMPQueueInfo -> SMPQueueInfo -> SndQueueSecured
Eq, Int -> SMPQueueInfo -> ShowS
[SMPQueueInfo] -> ShowS
SMPQueueInfo -> FilePath
(Int -> SMPQueueInfo -> ShowS)
-> (SMPQueueInfo -> FilePath)
-> ([SMPQueueInfo] -> ShowS)
-> Show SMPQueueInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SMPQueueInfo -> ShowS
showsPrec :: Int -> SMPQueueInfo -> ShowS
$cshow :: SMPQueueInfo -> FilePath
show :: SMPQueueInfo -> FilePath
$cshowList :: [SMPQueueInfo] -> ShowS
showList :: [SMPQueueInfo] -> ShowS
Show)

instance Encoding SMPQueueInfo where
  smpEncode :: SMPQueueInfo -> ConfirmationId
smpEncode (SMPQueueInfo VersionSMPC
clientVersion SMPQueueAddress {SMPServer
smpServer :: SMPServer
$sel:smpServer:SMPQueueAddress :: SMPQueueAddress -> SMPServer
smpServer, LinkId
senderId :: LinkId
$sel:senderId:SMPQueueAddress :: SMPQueueAddress -> LinkId
senderId, PublicKeyX25519
dhPublicKey :: PublicKeyX25519
$sel:dhPublicKey:SMPQueueAddress :: SMPQueueAddress -> PublicKeyX25519
dhPublicKey, Maybe QueueMode
$sel:queueMode:SMPQueueAddress :: SMPQueueAddress -> Maybe QueueMode
queueMode :: Maybe QueueMode
queueMode})
    | VersionSMPC
clientVersion VersionSMPC -> VersionSMPC -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
>= VersionSMPC
shortLinksSMPClientVersion = ConfirmationId
addrEnc ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
-> (QueueMode -> ConfirmationId)
-> Maybe QueueMode
-> ConfirmationId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConfirmationId
"" QueueMode -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode Maybe QueueMode
queueMode
    | VersionSMPC
clientVersion VersionSMPC -> VersionSMPC -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
>= VersionSMPC
sndAuthKeySMPClientVersion SndQueueSecured -> SndQueueSecured -> SndQueueSecured
&& SndQueueSecured
sndSecure = ConfirmationId
addrEnc ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> SndQueueSecured -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode SndQueueSecured
sndSecure
    | VersionSMPC
clientVersion VersionSMPC -> VersionSMPC -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
> VersionSMPC
initialSMPClientVersion = ConfirmationId
addrEnc
    | SndQueueSecured
otherwise = VersionSMPC -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode VersionSMPC
clientVersion ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> SMPServer -> ConfirmationId
forall (p :: ProtocolType). ProtocolServer p -> ConfirmationId
legacyEncodeServer SMPServer
smpServer ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> (LinkId, PublicKeyX25519) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (LinkId
senderId, PublicKeyX25519
dhPublicKey)
    where
      addrEnc :: ConfirmationId
addrEnc = (VersionSMPC, SMPServer, LinkId, PublicKeyX25519) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (VersionSMPC
clientVersion, SMPServer
smpServer, LinkId
senderId, PublicKeyX25519
dhPublicKey)
      sndSecure :: SndQueueSecured
sndSecure = Maybe QueueMode -> SndQueueSecured
senderCanSecure Maybe QueueMode
queueMode
  smpP :: Parser SMPQueueInfo
smpP = do
    VersionSMPC
clientVersion <- Parser VersionSMPC
forall a. Encoding a => Parser a
smpP
    SMPServer
smpServer <- if VersionSMPC
clientVersion VersionSMPC -> VersionSMPC -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
> VersionSMPC
initialSMPClientVersion then Parser SMPServer
forall a. Encoding a => Parser a
smpP else SMPServer -> SMPServer
updateSMPServerHosts (SMPServer -> SMPServer) -> Parser SMPServer -> Parser SMPServer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SMPServer
forall (p :: ProtocolType).
ProtocolTypeI p =>
Parser (ProtocolServer p)
legacyServerP
    (LinkId
senderId, PublicKeyX25519
dhPublicKey) <- Parser (LinkId, PublicKeyX25519)
forall a. Encoding a => Parser a
smpP
    Maybe QueueMode
queueMode <- Parser (Maybe QueueMode)
queueModeP
    SMPQueueInfo -> Parser SMPQueueInfo
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SMPQueueInfo -> Parser SMPQueueInfo)
-> SMPQueueInfo -> Parser SMPQueueInfo
forall a b. (a -> b) -> a -> b
$ VersionSMPC -> SMPQueueAddress -> SMPQueueInfo
SMPQueueInfo VersionSMPC
clientVersion SMPQueueAddress {SMPServer
$sel:smpServer:SMPQueueAddress :: SMPServer
smpServer :: SMPServer
smpServer, LinkId
$sel:senderId:SMPQueueAddress :: LinkId
senderId :: LinkId
senderId, PublicKeyX25519
$sel:dhPublicKey:SMPQueueAddress :: PublicKeyX25519
dhPublicKey :: PublicKeyX25519
dhPublicKey, Maybe QueueMode
$sel:queueMode:SMPQueueAddress :: Maybe QueueMode
queueMode :: Maybe QueueMode
queueMode}

-- This instance seems contrived and there was a temptation to split a common part of both types.
-- But this is created to allow backward and forward compatibility where SMPQueueUri
-- could have more fields to convert to different versions of SMPQueueInfo in a different way,
-- and this instance would become non-trivial.
instance VersionI SMPClientVersion SMPQueueInfo where
  type VersionRangeT SMPClientVersion SMPQueueInfo = SMPQueueUri
  version :: SMPQueueInfo -> VersionSMPC
version = SMPQueueInfo -> VersionSMPC
clientVersion
  toVersionRangeT :: SMPQueueInfo
-> VersionRange SMPClientVersion
-> VersionRangeT SMPClientVersion SMPQueueInfo
toVersionRangeT (SMPQueueInfo VersionSMPC
_v SMPQueueAddress
addr) VersionRange SMPClientVersion
vr = VersionRange SMPClientVersion -> SMPQueueAddress -> SMPQueueUri
SMPQueueUri VersionRange SMPClientVersion
vr SMPQueueAddress
addr

instance VersionRangeI SMPClientVersion SMPQueueUri where
  type VersionT SMPClientVersion SMPQueueUri = SMPQueueInfo
  versionRange :: SMPQueueUri -> VersionRange SMPClientVersion
versionRange = SMPQueueUri -> VersionRange SMPClientVersion
clientVRange
  toVersionT :: SMPQueueUri -> VersionSMPC -> VersionT SMPClientVersion SMPQueueUri
toVersionT (SMPQueueUri VersionRange SMPClientVersion
_vr SMPQueueAddress
addr) VersionSMPC
v = VersionSMPC -> SMPQueueAddress -> SMPQueueInfo
SMPQueueInfo VersionSMPC
v SMPQueueAddress
addr
  toVersionRange :: SMPQueueUri -> VersionRange SMPClientVersion -> SMPQueueUri
toVersionRange (SMPQueueUri VersionRange SMPClientVersion
_vr SMPQueueAddress
addr) VersionRange SMPClientVersion
vr = VersionRange SMPClientVersion -> SMPQueueAddress -> SMPQueueUri
SMPQueueUri VersionRange SMPClientVersion
vr SMPQueueAddress
addr

-- | SMP queue information sent out-of-band.
--
-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#out-of-band-messages
data SMPQueueUri = SMPQueueUri {SMPQueueUri -> VersionRange SMPClientVersion
clientVRange :: VersionRangeSMPC, SMPQueueUri -> SMPQueueAddress
queueAddress :: SMPQueueAddress}
  deriving (SMPQueueUri -> SMPQueueUri -> SndQueueSecured
(SMPQueueUri -> SMPQueueUri -> SndQueueSecured)
-> (SMPQueueUri -> SMPQueueUri -> SndQueueSecured)
-> Eq SMPQueueUri
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: SMPQueueUri -> SMPQueueUri -> SndQueueSecured
== :: SMPQueueUri -> SMPQueueUri -> SndQueueSecured
$c/= :: SMPQueueUri -> SMPQueueUri -> SndQueueSecured
/= :: SMPQueueUri -> SMPQueueUri -> SndQueueSecured
Eq, Int -> SMPQueueUri -> ShowS
[SMPQueueUri] -> ShowS
SMPQueueUri -> FilePath
(Int -> SMPQueueUri -> ShowS)
-> (SMPQueueUri -> FilePath)
-> ([SMPQueueUri] -> ShowS)
-> Show SMPQueueUri
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SMPQueueUri -> ShowS
showsPrec :: Int -> SMPQueueUri -> ShowS
$cshow :: SMPQueueUri -> FilePath
show :: SMPQueueUri -> FilePath
$cshowList :: [SMPQueueUri] -> ShowS
showList :: [SMPQueueUri] -> ShowS
Show)

data SMPQueueAddress = SMPQueueAddress
  { SMPQueueAddress -> SMPServer
smpServer :: SMPServer,
    SMPQueueAddress -> LinkId
senderId :: SMP.SenderId,
    SMPQueueAddress -> PublicKeyX25519
dhPublicKey :: C.PublicKeyX25519,
    SMPQueueAddress -> Maybe QueueMode
queueMode :: Maybe QueueMode
  }
  deriving (SMPQueueAddress -> SMPQueueAddress -> SndQueueSecured
(SMPQueueAddress -> SMPQueueAddress -> SndQueueSecured)
-> (SMPQueueAddress -> SMPQueueAddress -> SndQueueSecured)
-> Eq SMPQueueAddress
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: SMPQueueAddress -> SMPQueueAddress -> SndQueueSecured
== :: SMPQueueAddress -> SMPQueueAddress -> SndQueueSecured
$c/= :: SMPQueueAddress -> SMPQueueAddress -> SndQueueSecured
/= :: SMPQueueAddress -> SMPQueueAddress -> SndQueueSecured
Eq, Int -> SMPQueueAddress -> ShowS
[SMPQueueAddress] -> ShowS
SMPQueueAddress -> FilePath
(Int -> SMPQueueAddress -> ShowS)
-> (SMPQueueAddress -> FilePath)
-> ([SMPQueueAddress] -> ShowS)
-> Show SMPQueueAddress
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SMPQueueAddress -> ShowS
showsPrec :: Int -> SMPQueueAddress -> ShowS
$cshow :: SMPQueueAddress -> FilePath
show :: SMPQueueAddress -> FilePath
$cshowList :: [SMPQueueAddress] -> ShowS
showList :: [SMPQueueAddress] -> ShowS
Show)

instance SMPQueue SMPQueueUri where
  qServer :: SMPQueueUri -> SMPServer
qServer SMPQueueUri {SMPQueueAddress
$sel:queueAddress:SMPQueueUri :: SMPQueueUri -> SMPQueueAddress
queueAddress :: SMPQueueAddress
queueAddress} = SMPQueueAddress -> SMPServer
forall q. SMPQueue q => q -> SMPServer
qServer SMPQueueAddress
queueAddress
  {-# INLINE qServer #-}
  queueId :: SMPQueueUri -> LinkId
queueId SMPQueueUri {SMPQueueAddress
$sel:queueAddress:SMPQueueUri :: SMPQueueUri -> SMPQueueAddress
queueAddress :: SMPQueueAddress
queueAddress} = SMPQueueAddress -> LinkId
forall q. SMPQueue q => q -> LinkId
queueId SMPQueueAddress
queueAddress
  {-# INLINE queueId #-}

instance SMPQueue SMPQueueInfo where
  qServer :: SMPQueueInfo -> SMPServer
qServer SMPQueueInfo {SMPQueueAddress
$sel:queueAddress:SMPQueueInfo :: SMPQueueInfo -> SMPQueueAddress
queueAddress :: SMPQueueAddress
queueAddress} = SMPQueueAddress -> SMPServer
forall q. SMPQueue q => q -> SMPServer
qServer SMPQueueAddress
queueAddress
  {-# INLINE qServer #-}
  queueId :: SMPQueueInfo -> LinkId
queueId SMPQueueInfo {SMPQueueAddress
$sel:queueAddress:SMPQueueInfo :: SMPQueueInfo -> SMPQueueAddress
queueAddress :: SMPQueueAddress
queueAddress} = SMPQueueAddress -> LinkId
forall q. SMPQueue q => q -> LinkId
queueId SMPQueueAddress
queueAddress
  {-# INLINE queueId #-}

instance SMPQueue SMPQueueAddress where
  qServer :: SMPQueueAddress -> SMPServer
qServer SMPQueueAddress {SMPServer
$sel:smpServer:SMPQueueAddress :: SMPQueueAddress -> SMPServer
smpServer :: SMPServer
smpServer} = SMPServer
smpServer
  {-# INLINE qServer #-}
  queueId :: SMPQueueAddress -> LinkId
queueId SMPQueueAddress {LinkId
$sel:senderId:SMPQueueAddress :: SMPQueueAddress -> LinkId
senderId :: LinkId
senderId} = LinkId
senderId
  {-# INLINE queueId #-}

sameQAddress :: (SMPServer, SMP.QueueId) -> (SMPServer, SMP.QueueId) -> Bool
sameQAddress :: SndQAddr -> SndQAddr -> SndQueueSecured
sameQAddress (SMPServer
srv, LinkId
qId) (SMPServer
srv', LinkId
qId') = SMPServer -> SMPServer -> SndQueueSecured
forall (p :: ProtocolType).
ProtocolServer p -> ProtocolServer p -> SndQueueSecured
sameSrvAddr SMPServer
srv SMPServer
srv' SndQueueSecured -> SndQueueSecured -> SndQueueSecured
&& LinkId
qId LinkId -> LinkId -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== LinkId
qId'
{-# INLINE sameQAddress #-}

instance StrEncoding SMPQueueUri where
  strEncode :: SMPQueueUri -> ConfirmationId
strEncode (SMPQueueUri VersionRange SMPClientVersion
vr SMPQueueAddress {$sel:smpServer:SMPQueueAddress :: SMPQueueAddress -> SMPServer
smpServer = SMPServer
srv, $sel:senderId:SMPQueueAddress :: SMPQueueAddress -> LinkId
senderId = LinkId
qId, PublicKeyX25519
$sel:dhPublicKey:SMPQueueAddress :: SMPQueueAddress -> PublicKeyX25519
dhPublicKey :: PublicKeyX25519
dhPublicKey, Maybe QueueMode
$sel:queueMode:SMPQueueAddress :: SMPQueueAddress -> Maybe QueueMode
queueMode :: Maybe QueueMode
queueMode})
    | VersionRange SMPClientVersion -> VersionSMPC
forall v. VersionRange v -> Version v
minVersion VersionRange SMPClientVersion
vr VersionSMPC -> VersionSMPC -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
>= VersionSMPC
srvHostnamesSMPClientVersion = SMPServer -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode SMPServer
srv ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
"/" ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> LinkId -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode LinkId
qId ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
"#/?" ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> SimpleQuery -> ConfirmationId
query SimpleQuery
queryParams
    | SndQueueSecured
otherwise = SMPServer -> ConfirmationId
forall (p :: ProtocolType).
ProtocolTypeI p =>
ProtocolServer p -> ConfirmationId
legacyStrEncodeServer SMPServer
srv ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
"/" ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> LinkId -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode LinkId
qId ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
"#/?" ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> SimpleQuery -> ConfirmationId
query (SimpleQuery
queryParams SimpleQuery -> SimpleQuery -> SimpleQuery
forall a. Semigroup a => a -> a -> a
<> SimpleQuery
srvParam)
    where
      query :: SimpleQuery -> ConfirmationId
query = QueryStringParams -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode (QueryStringParams -> ConfirmationId)
-> (SimpleQuery -> QueryStringParams)
-> SimpleQuery
-> ConfirmationId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QSPEscaping -> SimpleQuery -> QueryStringParams
QSP QSPEscaping
QEscape
      queryParams :: SimpleQuery
queryParams = [(ConfirmationId
"v", VersionRange SMPClientVersion -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode VersionRange SMPClientVersion
vr), (ConfirmationId
"dh", PublicKeyX25519 -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode PublicKeyX25519
dhPublicKey)] SimpleQuery -> SimpleQuery -> SimpleQuery
forall a. Semigroup a => a -> a -> a
<> SimpleQuery
queueModeParam SimpleQuery -> SimpleQuery -> SimpleQuery
forall a. Semigroup a => a -> a -> a
<> SimpleQuery
sndSecureParam
        where
          queueModeParam :: SimpleQuery
queueModeParam = case Maybe QueueMode
queueMode of
            Just QueueMode
QMMessaging -> [(ConfirmationId
"q", ConfirmationId
"m")]
            Just QueueMode
QMContact -> [(ConfirmationId
"q", ConfirmationId
"c")]
            Maybe QueueMode
Nothing -> []
          sndSecureParam :: SimpleQuery
sndSecureParam = [(ConfirmationId
"k", ConfirmationId
"s") | Maybe QueueMode -> SndQueueSecured
senderCanSecure Maybe QueueMode
queueMode SndQueueSecured -> SndQueueSecured -> SndQueueSecured
&& VersionRange SMPClientVersion -> VersionSMPC
forall v. VersionRange v -> Version v
minVersion VersionRange SMPClientVersion
vr VersionSMPC -> VersionSMPC -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
< VersionSMPC
shortLinksSMPClientVersion]
      srvParam :: SimpleQuery
srvParam = [(ConfirmationId
"srv", TransportHosts_ -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode (TransportHosts_ -> ConfirmationId)
-> TransportHosts_ -> ConfirmationId
forall a b. (a -> b) -> a -> b
$ [TransportHost] -> TransportHosts_
TransportHosts_ [TransportHost]
hs) | SndQueueSecured -> SndQueueSecured
not ([TransportHost] -> SndQueueSecured
forall a. [a] -> SndQueueSecured
forall (t :: * -> *) a. Foldable t => t a -> SndQueueSecured
null [TransportHost]
hs)]
      hs :: [TransportHost]
hs = NonEmpty TransportHost -> [TransportHost]
forall a. NonEmpty a -> [a]
L.tail (NonEmpty TransportHost -> [TransportHost])
-> NonEmpty TransportHost -> [TransportHost]
forall a b. (a -> b) -> a -> b
$ SMPServer -> NonEmpty TransportHost
forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host SMPServer
srv
  strP :: Parser ConfirmationId SMPQueueUri
strP = do
    srv :: SMPServer
srv@ProtocolServer {$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host = TransportHost
h :| [TransportHost]
host} <- Parser SMPServer
forall a. StrEncoding a => Parser a
strP Parser SMPServer -> Parser Char -> Parser SMPServer
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
'/'
    LinkId
senderId <- Parser LinkId
forall a. StrEncoding a => Parser a
strP Parser LinkId
-> Parser ConfirmationId (Maybe Char) -> Parser LinkId
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char -> Parser ConfirmationId (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Char
A.char Char
'/') Parser LinkId -> Parser Char -> Parser LinkId
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
'#'
    (VersionRange SMPClientVersion
vr, [TransportHost]
hs, PublicKeyX25519
dhPublicKey, Maybe QueueMode
queueMode) <- Parser
  ConfirmationId
  (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
   Maybe QueueMode)
versioned Parser
  ConfirmationId
  (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
   Maybe QueueMode)
-> Parser
     ConfirmationId
     (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
      Maybe QueueMode)
-> Parser
     ConfirmationId
     (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
      Maybe QueueMode)
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  ConfirmationId
  (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
   Maybe QueueMode)
forall {a}.
Parser
  ConfirmationId
  (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
   Maybe a)
unversioned
    let srv' :: SMPServer
srv' = SMPServer
srv {host = h :| host <> hs}
        smpServer :: SMPServer
smpServer = if VersionRange SMPClientVersion -> VersionSMPC
forall v. VersionRange v -> Version v
maxVersion VersionRange SMPClientVersion
vr VersionSMPC -> VersionSMPC -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
< VersionSMPC
srvHostnamesSMPClientVersion then SMPServer -> SMPServer
updateSMPServerHosts SMPServer
srv' else SMPServer
srv'
    SMPQueueUri -> Parser ConfirmationId SMPQueueUri
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SMPQueueUri -> Parser ConfirmationId SMPQueueUri)
-> SMPQueueUri -> Parser ConfirmationId SMPQueueUri
forall a b. (a -> b) -> a -> b
$ VersionRange SMPClientVersion -> SMPQueueAddress -> SMPQueueUri
SMPQueueUri VersionRange SMPClientVersion
vr SMPQueueAddress {SMPServer
$sel:smpServer:SMPQueueAddress :: SMPServer
smpServer :: SMPServer
smpServer, LinkId
$sel:senderId:SMPQueueAddress :: LinkId
senderId :: LinkId
senderId, PublicKeyX25519
$sel:dhPublicKey:SMPQueueAddress :: PublicKeyX25519
dhPublicKey :: PublicKeyX25519
dhPublicKey, Maybe QueueMode
$sel:queueMode:SMPQueueAddress :: Maybe QueueMode
queueMode :: Maybe QueueMode
queueMode}
    where
      unversioned :: Parser
  ConfirmationId
  (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
   Maybe a)
unversioned = (VersionSMPC -> VersionRange SMPClientVersion
forall v. Version v -> VersionRange v
versionToRange VersionSMPC
initialSMPClientVersion,[],,Maybe a
forall a. Maybe a
Nothing) (PublicKeyX25519
 -> (VersionRange SMPClientVersion, [TransportHost],
     PublicKeyX25519, Maybe a))
-> Parser ConfirmationId PublicKeyX25519
-> Parser
     ConfirmationId
     (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
      Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId PublicKeyX25519
forall a. StrEncoding a => Parser a
strP Parser
  ConfirmationId
  (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
   Maybe a)
-> Parser ConfirmationId ()
-> Parser
     ConfirmationId
     (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
      Maybe a)
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ConfirmationId ()
forall t. Chunk t => Parser t ()
A.endOfInput
      versioned :: Parser
  ConfirmationId
  (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
   Maybe QueueMode)
versioned = do
        Maybe PublicKeyX25519
dhKey_ <- Parser ConfirmationId PublicKeyX25519
-> Parser ConfirmationId (Maybe PublicKeyX25519)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ConfirmationId PublicKeyX25519
forall a. StrEncoding a => Parser a
strP
        QueryStringParams
query <- Parser Char -> Parser ConfirmationId (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Char
A.char Char
'/') Parser ConfirmationId (Maybe Char) -> Parser Char -> Parser Char
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
A.char Char
'?' Parser Char -> Parser QueryStringParams -> Parser QueryStringParams
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser QueryStringParams
forall a. StrEncoding a => Parser a
strP
        VersionRange SMPClientVersion
vr <- ConfirmationId
-> QueryStringParams -> Parser (VersionRange SMPClientVersion)
forall a.
StrEncoding a =>
ConfirmationId -> QueryStringParams -> Parser a
queryParam ConfirmationId
"v" QueryStringParams
query
        PublicKeyX25519
dhKey <- Parser ConfirmationId PublicKeyX25519
-> (PublicKeyX25519 -> Parser ConfirmationId PublicKeyX25519)
-> Maybe PublicKeyX25519
-> Parser ConfirmationId PublicKeyX25519
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConfirmationId
-> QueryStringParams -> Parser ConfirmationId PublicKeyX25519
forall a.
StrEncoding a =>
ConfirmationId -> QueryStringParams -> Parser a
queryParam ConfirmationId
"dh" QueryStringParams
query) PublicKeyX25519 -> Parser ConfirmationId PublicKeyX25519
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PublicKeyX25519
dhKey_
        Maybe TransportHosts_
hs_ <- ConfirmationId
-> QueryStringParams -> Parser (Maybe TransportHosts_)
forall a.
StrEncoding a =>
ConfirmationId -> QueryStringParams -> Parser (Maybe a)
queryParam_ ConfirmationId
"srv" QueryStringParams
query
        let queueMode :: Maybe QueueMode
queueMode = case ConfirmationId -> QueryStringParams -> Maybe ConfirmationId
queryParamStr ConfirmationId
"q" QueryStringParams
query of
              Just ConfirmationId
"m" -> QueueMode -> Maybe QueueMode
forall a. a -> Maybe a
Just QueueMode
QMMessaging
              Just ConfirmationId
"c" -> QueueMode -> Maybe QueueMode
forall a. a -> Maybe a
Just QueueMode
QMContact
              Maybe ConfirmationId
_ | ConfirmationId -> QueryStringParams -> Maybe ConfirmationId
queryParamStr ConfirmationId
"k" QueryStringParams
query Maybe ConfirmationId -> Maybe ConfirmationId -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== ConfirmationId -> Maybe ConfirmationId
forall a. a -> Maybe a
Just ConfirmationId
"s" -> QueueMode -> Maybe QueueMode
forall a. a -> Maybe a
Just QueueMode
QMMessaging
              Maybe ConfirmationId
_ -> Maybe QueueMode
forall a. Maybe a
Nothing
        (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
 Maybe QueueMode)
-> Parser
     ConfirmationId
     (VersionRange SMPClientVersion, [TransportHost], PublicKeyX25519,
      Maybe QueueMode)
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VersionRange SMPClientVersion
vr, [TransportHost]
-> (TransportHosts_ -> [TransportHost])
-> Maybe TransportHosts_
-> [TransportHost]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] TransportHosts_ -> [TransportHost]
thList_ Maybe TransportHosts_
hs_, PublicKeyX25519
dhKey, Maybe QueueMode
queueMode)

instance Encoding SMPQueueUri where
  smpEncode :: SMPQueueUri -> ConfirmationId
smpEncode (SMPQueueUri clientVRange :: VersionRange SMPClientVersion
clientVRange@(VersionRange VersionSMPC
minV VersionSMPC
maxV) SMPQueueAddress {SMPServer
$sel:smpServer:SMPQueueAddress :: SMPQueueAddress -> SMPServer
smpServer :: SMPServer
smpServer, LinkId
$sel:senderId:SMPQueueAddress :: SMPQueueAddress -> LinkId
senderId :: LinkId
senderId, PublicKeyX25519
$sel:dhPublicKey:SMPQueueAddress :: SMPQueueAddress -> PublicKeyX25519
dhPublicKey :: PublicKeyX25519
dhPublicKey, Maybe QueueMode
$sel:queueMode:SMPQueueAddress :: SMPQueueAddress -> Maybe QueueMode
queueMode :: Maybe QueueMode
queueMode})
    -- The condition is for minVersion as earlier clients won't be able to support it.
    -- The alternative would be to encode both queueMode and sndSecure
    | VersionSMPC
minV VersionSMPC -> VersionSMPC -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
>= VersionSMPC
shortLinksSMPClientVersion = ConfirmationId
addrEnc ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
-> (QueueMode -> ConfirmationId)
-> Maybe QueueMode
-> ConfirmationId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConfirmationId
"" QueueMode -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode Maybe QueueMode
queueMode
    -- Earlier versions won't be able to ignore sndSecure, so we don't include it when it is False
    | VersionSMPC
minV VersionSMPC -> VersionSMPC -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
>= VersionSMPC
sndAuthKeySMPClientVersion SndQueueSecured -> SndQueueSecured -> SndQueueSecured
|| (VersionSMPC
maxV VersionSMPC -> VersionSMPC -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
>= VersionSMPC
sndAuthKeySMPClientVersion SndQueueSecured -> SndQueueSecured -> SndQueueSecured
&& SndQueueSecured
sndSecure) = ConfirmationId
addrEnc ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> SndQueueSecured -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode SndQueueSecured
sndSecure
    | SndQueueSecured
otherwise = ConfirmationId
addrEnc
    where
      addrEnc :: ConfirmationId
addrEnc = (VersionRange SMPClientVersion, SMPServer, LinkId, PublicKeyX25519)
-> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (VersionRange SMPClientVersion
clientVRange, SMPServer
smpServer, LinkId
senderId, PublicKeyX25519
dhPublicKey)
      sndSecure :: SndQueueSecured
sndSecure = Maybe QueueMode -> SndQueueSecured
senderCanSecure Maybe QueueMode
queueMode
  smpP :: Parser ConfirmationId SMPQueueUri
smpP = do
    (VersionRange SMPClientVersion
clientVRange, SMPServer
smpServer, LinkId
senderId, PublicKeyX25519
dhPublicKey) <- Parser
  (VersionRange SMPClientVersion, SMPServer, LinkId, PublicKeyX25519)
forall a. Encoding a => Parser a
smpP
    Maybe QueueMode
queueMode <- Parser (Maybe QueueMode)
queueModeP
    SMPQueueUri -> Parser ConfirmationId SMPQueueUri
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SMPQueueUri -> Parser ConfirmationId SMPQueueUri)
-> SMPQueueUri -> Parser ConfirmationId SMPQueueUri
forall a b. (a -> b) -> a -> b
$ VersionRange SMPClientVersion -> SMPQueueAddress -> SMPQueueUri
SMPQueueUri VersionRange SMPClientVersion
clientVRange SMPQueueAddress {SMPServer
$sel:smpServer:SMPQueueAddress :: SMPServer
smpServer :: SMPServer
smpServer, LinkId
$sel:senderId:SMPQueueAddress :: LinkId
senderId :: LinkId
senderId, PublicKeyX25519
$sel:dhPublicKey:SMPQueueAddress :: PublicKeyX25519
dhPublicKey :: PublicKeyX25519
dhPublicKey, Maybe QueueMode
$sel:queueMode:SMPQueueAddress :: Maybe QueueMode
queueMode :: Maybe QueueMode
queueMode}

queueModeP :: Parser (Maybe QueueMode)
queueModeP :: Parser (Maybe QueueMode)
queueModeP = QueueMode -> Maybe QueueMode
forall a. a -> Maybe a
Just (QueueMode -> Maybe QueueMode)
-> Parser ConfirmationId QueueMode -> Parser (Maybe QueueMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId QueueMode
forall a. Encoding a => Parser a
smpP Parser (Maybe QueueMode)
-> Parser (Maybe QueueMode) -> Parser (Maybe QueueMode)
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ConfirmationId QueueMode -> Parser (Maybe QueueMode)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((\case SndQueueSecured
True -> QueueMode
QMMessaging; SndQueueSecured
_ -> QueueMode
QMContact) (SndQueueSecured -> QueueMode)
-> Parser ConfirmationId SndQueueSecured
-> Parser ConfirmationId QueueMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId SndQueueSecured
forall a. Encoding a => Parser a
smpP)

data ConnectionRequestUri (m :: ConnectionMode) where
  CRInvitationUri :: ConnReqUriData -> RcvE2ERatchetParamsUri 'C.X448 -> ConnectionRequestUri CMInvitation
  -- contact connection request does NOT contain E2E encryption parameters for double ratchet -
  -- they are passed in AgentInvitation message
  CRContactUri :: ConnReqUriData -> ConnectionRequestUri CMContact

simplexConnReqUri :: ConnectionRequestUri m -> ConnectionRequestUri m
simplexConnReqUri :: forall (m :: ConnectionMode).
ConnectionRequestUri m -> ConnectionRequestUri m
simplexConnReqUri = \case
  CRInvitationUri ConnReqUriData
crData RcvE2ERatchetParamsUri 'X448
e2eParams -> ConnReqUriData
-> RcvE2ERatchetParamsUri 'X448
-> ConnectionRequestUri 'CMInvitation
CRInvitationUri ConnReqUriData
crData {crScheme = SSSimplex} RcvE2ERatchetParamsUri 'X448
e2eParams
  CRContactUri ConnReqUriData
crData -> ConnReqUriData -> ConnectionRequestUri 'CMContact
CRContactUri ConnReqUriData
crData {crScheme = SSSimplex}

deriving instance Eq (ConnectionRequestUri m)

deriving instance Show (ConnectionRequestUri m)

data AConnectionRequestUri = forall m. ConnectionModeI m => ACR (SConnectionMode m) (ConnectionRequestUri m)

instance Eq AConnectionRequestUri where
  ACR SConnectionMode m
m ConnectionRequestUri m
cr == :: AConnectionRequestUri -> AConnectionRequestUri -> SndQueueSecured
== ACR SConnectionMode m
m' ConnectionRequestUri m
cr' = case SConnectionMode m -> SConnectionMode m -> Maybe (m :~: m)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: ConnectionMode) (b :: ConnectionMode).
SConnectionMode a -> SConnectionMode b -> Maybe (a :~: b)
testEquality SConnectionMode m
m SConnectionMode m
m' of
    Just m :~: m
Refl -> ConnectionRequestUri m
cr ConnectionRequestUri m -> ConnectionRequestUri m -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== ConnectionRequestUri m
ConnectionRequestUri m
cr'
    Maybe (m :~: m)
_ -> SndQueueSecured
False

deriving instance Show AConnectionRequestUri

data ShortLinkCreds = ShortLinkCreds
  { ShortLinkCreds -> LinkId
shortLinkId :: SMP.LinkId,
    ShortLinkCreds -> LinkKey
shortLinkKey :: LinkKey,
    ShortLinkCreds -> PrivateKeyEd25519
linkPrivSigKey :: C.PrivateKeyEd25519,
    ShortLinkCreds -> Maybe PublicKeyEd25519
linkRootSigKey :: Maybe C.PublicKeyEd25519, -- in case the current user is not the original owner, and the root key is different from linkPrivSigKey
    ShortLinkCreds -> EncFixedDataBytes
linkEncFixedData :: SMP.EncFixedDataBytes
  }
  deriving (Int -> ShortLinkCreds -> ShowS
[ShortLinkCreds] -> ShowS
ShortLinkCreds -> FilePath
(Int -> ShortLinkCreds -> ShowS)
-> (ShortLinkCreds -> FilePath)
-> ([ShortLinkCreds] -> ShowS)
-> Show ShortLinkCreds
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShortLinkCreds -> ShowS
showsPrec :: Int -> ShortLinkCreds -> ShowS
$cshow :: ShortLinkCreds -> FilePath
show :: ShortLinkCreds -> FilePath
$cshowList :: [ShortLinkCreds] -> ShowS
showList :: [ShortLinkCreds] -> ShowS
Show)

data ShortLinkScheme = SLSSimplex | SLSServer deriving (ShortLinkScheme -> ShortLinkScheme -> SndQueueSecured
(ShortLinkScheme -> ShortLinkScheme -> SndQueueSecured)
-> (ShortLinkScheme -> ShortLinkScheme -> SndQueueSecured)
-> Eq ShortLinkScheme
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: ShortLinkScheme -> ShortLinkScheme -> SndQueueSecured
== :: ShortLinkScheme -> ShortLinkScheme -> SndQueueSecured
$c/= :: ShortLinkScheme -> ShortLinkScheme -> SndQueueSecured
/= :: ShortLinkScheme -> ShortLinkScheme -> SndQueueSecured
Eq, Int -> ShortLinkScheme -> ShowS
[ShortLinkScheme] -> ShowS
ShortLinkScheme -> FilePath
(Int -> ShortLinkScheme -> ShowS)
-> (ShortLinkScheme -> FilePath)
-> ([ShortLinkScheme] -> ShowS)
-> Show ShortLinkScheme
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShortLinkScheme -> ShowS
showsPrec :: Int -> ShortLinkScheme -> ShowS
$cshow :: ShortLinkScheme -> FilePath
show :: ShortLinkScheme -> FilePath
$cshowList :: [ShortLinkScheme] -> ShowS
showList :: [ShortLinkScheme] -> ShowS
Show)

data ConnShortLink (m :: ConnectionMode) where
  CSLInvitation :: ShortLinkScheme -> SMPServer -> SMP.LinkId -> LinkKey -> ConnShortLink 'CMInvitation
  CSLContact :: ShortLinkScheme -> ContactConnType -> SMPServer -> LinkKey -> ConnShortLink 'CMContact

deriving instance Eq (ConnShortLink m)

deriving instance Show (ConnShortLink m)

simplexShortLink :: ConnShortLink m -> ConnShortLink m
simplexShortLink :: forall (m :: ConnectionMode). ConnShortLink m -> ConnShortLink m
simplexShortLink = \case
  CSLInvitation ShortLinkScheme
_ SMPServer
srv LinkId
lnkId LinkKey
k -> ShortLinkScheme
-> SMPServer -> LinkId -> LinkKey -> ConnShortLink 'CMInvitation
CSLInvitation ShortLinkScheme
SLSSimplex SMPServer
srv LinkId
lnkId LinkKey
k
  CSLContact ShortLinkScheme
_ ContactConnType
ct SMPServer
srv LinkKey
k -> ShortLinkScheme
-> ContactConnType
-> SMPServer
-> LinkKey
-> ConnShortLink 'CMContact
CSLContact ShortLinkScheme
SLSSimplex ContactConnType
ct SMPServer
srv LinkKey
k

newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data)
  deriving (LinkKey -> LinkKey -> SndQueueSecured
(LinkKey -> LinkKey -> SndQueueSecured)
-> (LinkKey -> LinkKey -> SndQueueSecured) -> Eq LinkKey
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: LinkKey -> LinkKey -> SndQueueSecured
== :: LinkKey -> LinkKey -> SndQueueSecured
$c/= :: LinkKey -> LinkKey -> SndQueueSecured
/= :: LinkKey -> LinkKey -> SndQueueSecured
Eq, Int -> LinkKey -> ShowS
[LinkKey] -> ShowS
LinkKey -> FilePath
(Int -> LinkKey -> ShowS)
-> (LinkKey -> FilePath) -> ([LinkKey] -> ShowS) -> Show LinkKey
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkKey -> ShowS
showsPrec :: Int -> LinkKey -> ShowS
$cshow :: LinkKey -> FilePath
show :: LinkKey -> FilePath
$cshowList :: [LinkKey] -> ShowS
showList :: [LinkKey] -> ShowS
Show)
  deriving newtype (FieldParser LinkKey
FieldParser LinkKey -> FromField LinkKey
forall a. FieldParser a -> FromField a
$cfromField :: FieldParser LinkKey
fromField :: FieldParser LinkKey
FromField, Parser LinkKey
ConfirmationId -> Either FilePath LinkKey
LinkKey -> ConfirmationId
(LinkKey -> ConfirmationId)
-> (ConfirmationId -> Either FilePath LinkKey)
-> Parser LinkKey
-> StrEncoding LinkKey
forall a.
(a -> ConfirmationId)
-> (ConfirmationId -> Either FilePath a)
-> Parser a
-> StrEncoding a
$cstrEncode :: LinkKey -> ConfirmationId
strEncode :: LinkKey -> ConfirmationId
$cstrDecode :: ConfirmationId -> Either FilePath LinkKey
strDecode :: ConfirmationId -> Either FilePath LinkKey
$cstrP :: Parser LinkKey
strP :: Parser LinkKey
StrEncoding)

instance ToField LinkKey where toField :: LinkKey -> SQLData
toField (LinkKey ConfirmationId
s) = Binary ConfirmationId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ConfirmationId -> SQLData)
-> Binary ConfirmationId -> SQLData
forall a b. (a -> b) -> a -> b
$ ConfirmationId -> Binary ConfirmationId
forall a. a -> Binary a
Binary ConfirmationId
s

-- | Parameters for creating a connection with a prepared link.
data PreparedLinkParams = PreparedLinkParams
  { -- | Correlation ID / determines sender ID
    PreparedLinkParams -> CbNonce
plpNonce :: C.CbNonce,
    -- | Queue E2EE DH key pair
    PreparedLinkParams -> KeyPairX25519
plpQueueE2EKeys :: C.KeyPairX25519,
    -- | For encrypting link data
    PreparedLinkParams -> LinkKey
plpLinkKey :: LinkKey,
    -- | Root signing key (for signing link data)
    PreparedLinkParams -> PrivateKeyEd25519
plpRootPrivKey :: C.PrivateKeyEd25519,
    -- | smpEncode of FixedLinkData (includes linkEntityId)
    PreparedLinkParams -> ConfirmationId
plpSignedFixedData :: ByteString,
    -- | Server with basic auth (not stored in link)
    PreparedLinkParams -> SMPServerWithAuth
plpSrvWithAuth :: SMPServerWithAuth
  }
  deriving (Int -> PreparedLinkParams -> ShowS
[PreparedLinkParams] -> ShowS
PreparedLinkParams -> FilePath
(Int -> PreparedLinkParams -> ShowS)
-> (PreparedLinkParams -> FilePath)
-> ([PreparedLinkParams] -> ShowS)
-> Show PreparedLinkParams
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PreparedLinkParams -> ShowS
showsPrec :: Int -> PreparedLinkParams -> ShowS
$cshow :: PreparedLinkParams -> FilePath
show :: PreparedLinkParams -> FilePath
$cshowList :: [PreparedLinkParams] -> ShowS
showList :: [PreparedLinkParams] -> ShowS
Show)

instance ConnectionModeI c => ToField (ConnectionLink c) where toField :: ConnectionLink c -> SQLData
toField = Binary ConfirmationId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ConfirmationId -> SQLData)
-> (ConnectionLink c -> Binary ConfirmationId)
-> ConnectionLink c
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> Binary ConfirmationId
forall a. a -> Binary a
Binary (ConfirmationId -> Binary ConfirmationId)
-> (ConnectionLink c -> ConfirmationId)
-> ConnectionLink c
-> Binary ConfirmationId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionLink c -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode

instance (Typeable c, ConnectionModeI c) => FromField (ConnectionLink c) where fromField :: FieldParser (ConnectionLink c)
fromField = (ConfirmationId -> Either FilePath (ConnectionLink c))
-> FieldParser (ConnectionLink c)
forall k.
Typeable k =>
(ConfirmationId -> Either FilePath k) -> FieldParser k
blobFieldDecoder ConfirmationId -> Either FilePath (ConnectionLink c)
forall a. StrEncoding a => ConfirmationId -> Either FilePath a
strDecode

instance ConnectionModeI c => ToField (ConnShortLink c) where toField :: ConnShortLink c -> SQLData
toField = Binary ConfirmationId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ConfirmationId -> SQLData)
-> (ConnShortLink c -> Binary ConfirmationId)
-> ConnShortLink c
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> Binary ConfirmationId
forall a. a -> Binary a
Binary (ConfirmationId -> Binary ConfirmationId)
-> (ConnShortLink c -> ConfirmationId)
-> ConnShortLink c
-> Binary ConfirmationId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnShortLink c -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode

instance (Typeable c, ConnectionModeI c) => FromField (ConnShortLink c) where fromField :: FieldParser (ConnShortLink c)
fromField = (ConfirmationId -> Either FilePath (ConnShortLink c))
-> FieldParser (ConnShortLink c)
forall k.
Typeable k =>
(ConfirmationId -> Either FilePath k) -> FieldParser k
blobFieldDecoder ConfirmationId -> Either FilePath (ConnShortLink c)
forall a. StrEncoding a => ConfirmationId -> Either FilePath a
strDecode

data ContactConnType = CCTContact | CCTChannel | CCTGroup | CCTRelay deriving (ContactConnType -> ContactConnType -> SndQueueSecured
(ContactConnType -> ContactConnType -> SndQueueSecured)
-> (ContactConnType -> ContactConnType -> SndQueueSecured)
-> Eq ContactConnType
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: ContactConnType -> ContactConnType -> SndQueueSecured
== :: ContactConnType -> ContactConnType -> SndQueueSecured
$c/= :: ContactConnType -> ContactConnType -> SndQueueSecured
/= :: ContactConnType -> ContactConnType -> SndQueueSecured
Eq, Int -> ContactConnType -> ShowS
[ContactConnType] -> ShowS
ContactConnType -> FilePath
(Int -> ContactConnType -> ShowS)
-> (ContactConnType -> FilePath)
-> ([ContactConnType] -> ShowS)
-> Show ContactConnType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContactConnType -> ShowS
showsPrec :: Int -> ContactConnType -> ShowS
$cshow :: ContactConnType -> FilePath
show :: ContactConnType -> FilePath
$cshowList :: [ContactConnType] -> ShowS
showList :: [ContactConnType] -> ShowS
Show)

data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m)

instance Eq AConnShortLink where
  ACSL SConnectionMode m
m ConnShortLink m
sl == :: AConnShortLink -> AConnShortLink -> SndQueueSecured
== ACSL SConnectionMode m
m' ConnShortLink m
sl' = case SConnectionMode m -> SConnectionMode m -> Maybe (m :~: m)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: ConnectionMode) (b :: ConnectionMode).
SConnectionMode a -> SConnectionMode b -> Maybe (a :~: b)
testEquality SConnectionMode m
m SConnectionMode m
m' of
    Just m :~: m
Refl -> ConnShortLink m
sl ConnShortLink m -> ConnShortLink m -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== ConnShortLink m
ConnShortLink m
sl'
    Maybe (m :~: m)
Nothing -> SndQueueSecured
False

deriving instance Show AConnShortLink

instance ToField AConnShortLink where toField :: AConnShortLink -> SQLData
toField = Binary ConfirmationId -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ConfirmationId -> SQLData)
-> (AConnShortLink -> Binary ConfirmationId)
-> AConnShortLink
-> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> Binary ConfirmationId
forall a. a -> Binary a
Binary (ConfirmationId -> Binary ConfirmationId)
-> (AConnShortLink -> ConfirmationId)
-> AConnShortLink
-> Binary ConfirmationId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AConnShortLink -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode

instance FromField AConnShortLink where fromField :: FieldParser AConnShortLink
fromField = (ConfirmationId -> Either FilePath AConnShortLink)
-> FieldParser AConnShortLink
forall k.
Typeable k =>
(ConfirmationId -> Either FilePath k) -> FieldParser k
blobFieldDecoder ConfirmationId -> Either FilePath AConnShortLink
forall a. StrEncoding a => ConfirmationId -> Either FilePath a
strDecode

data ConnectionLink m = CLFull (ConnectionRequestUri m) | CLShort (ConnShortLink m)
  deriving (ConnectionLink m -> ConnectionLink m -> SndQueueSecured
(ConnectionLink m -> ConnectionLink m -> SndQueueSecured)
-> (ConnectionLink m -> ConnectionLink m -> SndQueueSecured)
-> Eq (ConnectionLink m)
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
forall (m :: ConnectionMode).
ConnectionLink m -> ConnectionLink m -> SndQueueSecured
$c== :: forall (m :: ConnectionMode).
ConnectionLink m -> ConnectionLink m -> SndQueueSecured
== :: ConnectionLink m -> ConnectionLink m -> SndQueueSecured
$c/= :: forall (m :: ConnectionMode).
ConnectionLink m -> ConnectionLink m -> SndQueueSecured
/= :: ConnectionLink m -> ConnectionLink m -> SndQueueSecured
Eq, Int -> ConnectionLink m -> ShowS
[ConnectionLink m] -> ShowS
ConnectionLink m -> FilePath
(Int -> ConnectionLink m -> ShowS)
-> (ConnectionLink m -> FilePath)
-> ([ConnectionLink m] -> ShowS)
-> Show (ConnectionLink m)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall (m :: ConnectionMode). Int -> ConnectionLink m -> ShowS
forall (m :: ConnectionMode). [ConnectionLink m] -> ShowS
forall (m :: ConnectionMode). ConnectionLink m -> FilePath
$cshowsPrec :: forall (m :: ConnectionMode). Int -> ConnectionLink m -> ShowS
showsPrec :: Int -> ConnectionLink m -> ShowS
$cshow :: forall (m :: ConnectionMode). ConnectionLink m -> FilePath
show :: ConnectionLink m -> FilePath
$cshowList :: forall (m :: ConnectionMode). [ConnectionLink m] -> ShowS
showList :: [ConnectionLink m] -> ShowS
Show)

data CreatedConnLink m = CCLink {forall (m :: ConnectionMode).
CreatedConnLink m -> ConnectionRequestUri m
connFullLink :: ConnectionRequestUri m, forall (m :: ConnectionMode).
CreatedConnLink m -> Maybe (ConnShortLink m)
connShortLink :: Maybe (ConnShortLink m)}
  deriving (CreatedConnLink m -> CreatedConnLink m -> SndQueueSecured
(CreatedConnLink m -> CreatedConnLink m -> SndQueueSecured)
-> (CreatedConnLink m -> CreatedConnLink m -> SndQueueSecured)
-> Eq (CreatedConnLink m)
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
forall (m :: ConnectionMode).
CreatedConnLink m -> CreatedConnLink m -> SndQueueSecured
$c== :: forall (m :: ConnectionMode).
CreatedConnLink m -> CreatedConnLink m -> SndQueueSecured
== :: CreatedConnLink m -> CreatedConnLink m -> SndQueueSecured
$c/= :: forall (m :: ConnectionMode).
CreatedConnLink m -> CreatedConnLink m -> SndQueueSecured
/= :: CreatedConnLink m -> CreatedConnLink m -> SndQueueSecured
Eq, Int -> CreatedConnLink m -> ShowS
[CreatedConnLink m] -> ShowS
CreatedConnLink m -> FilePath
(Int -> CreatedConnLink m -> ShowS)
-> (CreatedConnLink m -> FilePath)
-> ([CreatedConnLink m] -> ShowS)
-> Show (CreatedConnLink m)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall (m :: ConnectionMode). Int -> CreatedConnLink m -> ShowS
forall (m :: ConnectionMode). [CreatedConnLink m] -> ShowS
forall (m :: ConnectionMode). CreatedConnLink m -> FilePath
$cshowsPrec :: forall (m :: ConnectionMode). Int -> CreatedConnLink m -> ShowS
showsPrec :: Int -> CreatedConnLink m -> ShowS
$cshow :: forall (m :: ConnectionMode). CreatedConnLink m -> FilePath
show :: CreatedConnLink m -> FilePath
$cshowList :: forall (m :: ConnectionMode). [CreatedConnLink m] -> ShowS
showList :: [CreatedConnLink m] -> ShowS
Show)

data ACreatedConnLink = forall m. ConnectionModeI m => ACCL (SConnectionMode m) (CreatedConnLink m)

instance Eq ACreatedConnLink where
  ACCL SConnectionMode m
m CreatedConnLink m
l == :: ACreatedConnLink -> ACreatedConnLink -> SndQueueSecured
== ACCL SConnectionMode m
m' CreatedConnLink m
l' = case SConnectionMode m -> SConnectionMode m -> Maybe (m :~: m)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: ConnectionMode) (b :: ConnectionMode).
SConnectionMode a -> SConnectionMode b -> Maybe (a :~: b)
testEquality SConnectionMode m
m SConnectionMode m
m' of
    Just m :~: m
Refl -> CreatedConnLink m
l CreatedConnLink m -> CreatedConnLink m -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== CreatedConnLink m
CreatedConnLink m
l'
    Maybe (m :~: m)
_ -> SndQueueSecured
False

deriving instance Show ACreatedConnLink

data AConnectionLink = forall m. ConnectionModeI m => ACL (SConnectionMode m) (ConnectionLink m)

instance Eq AConnectionLink where
  ACL SConnectionMode m
m ConnectionLink m
cl == :: AConnectionLink -> AConnectionLink -> SndQueueSecured
== ACL SConnectionMode m
m' ConnectionLink m
cl' = case SConnectionMode m -> SConnectionMode m -> Maybe (m :~: m)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: ConnectionMode) (b :: ConnectionMode).
SConnectionMode a -> SConnectionMode b -> Maybe (a :~: b)
testEquality SConnectionMode m
m SConnectionMode m
m' of
    Just m :~: m
Refl -> ConnectionLink m
cl ConnectionLink m -> ConnectionLink m -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== ConnectionLink m
ConnectionLink m
cl'
    Maybe (m :~: m)
_ -> SndQueueSecured
False

deriving instance Show AConnectionLink

instance ConnectionModeI m => StrEncoding (ConnectionLink m) where
  strEncode :: ConnectionLink m -> ConfirmationId
strEncode = \case
    CLFull ConnectionRequestUri m
cr -> ConnectionRequestUri m -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode ConnectionRequestUri m
cr
    CLShort ConnShortLink m
sl -> ConnShortLink m -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode ConnShortLink m
sl
  strP :: Parser (ConnectionLink m)
strP = (\(ACL SConnectionMode m
_ ConnectionLink m
cl) -> ConnectionLink m -> Either FilePath (ConnectionLink m)
forall (t :: ConnectionMode -> *) (m :: ConnectionMode)
       (m' :: ConnectionMode).
(ConnectionModeI m, ConnectionModeI m') =>
t m' -> Either FilePath (t m)
checkConnMode ConnectionLink m
cl) (AConnectionLink -> Either FilePath (ConnectionLink m))
-> Parser ConfirmationId AConnectionLink
-> Parser (ConnectionLink m)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either FilePath b) -> m a -> m b
<$?> Parser ConfirmationId AConnectionLink
forall a. StrEncoding a => Parser a
strP
  {-# INLINE strP #-}

instance StrEncoding AConnectionLink where
  strEncode :: AConnectionLink -> ConfirmationId
strEncode (ACL SConnectionMode m
_ ConnectionLink m
cl) = ConnectionLink m -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode ConnectionLink m
cl
  {-# INLINE strEncode #-}
  strP :: Parser ConfirmationId AConnectionLink
strP =
    (\(ACR SConnectionMode m
m ConnectionRequestUri m
cr) -> SConnectionMode m -> ConnectionLink m -> AConnectionLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> ConnectionLink m -> AConnectionLink
ACL SConnectionMode m
m (ConnectionRequestUri m -> ConnectionLink m
forall (m :: ConnectionMode).
ConnectionRequestUri m -> ConnectionLink m
CLFull ConnectionRequestUri m
cr)) (AConnectionRequestUri -> AConnectionLink)
-> Parser ConfirmationId AConnectionRequestUri
-> Parser ConfirmationId AConnectionLink
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId AConnectionRequestUri
forall a. StrEncoding a => Parser a
strP
      Parser ConfirmationId AConnectionLink
-> Parser ConfirmationId AConnectionLink
-> Parser ConfirmationId AConnectionLink
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\(ACSL SConnectionMode m
m ConnShortLink m
sl) -> SConnectionMode m -> ConnectionLink m -> AConnectionLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> ConnectionLink m -> AConnectionLink
ACL SConnectionMode m
m (ConnShortLink m -> ConnectionLink m
forall (m :: ConnectionMode). ConnShortLink m -> ConnectionLink m
CLShort ConnShortLink m
sl)) (AConnShortLink -> AConnectionLink)
-> Parser ConfirmationId AConnShortLink
-> Parser ConfirmationId AConnectionLink
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId AConnShortLink
forall a. StrEncoding a => Parser a
strP

instance ConnectionModeI m => ToJSON (ConnectionLink m) where
  toEncoding :: ConnectionLink m -> Encoding
toEncoding = ConnectionLink m -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding
  toJSON :: ConnectionLink m -> Value
toJSON = ConnectionLink m -> Value
forall a. StrEncoding a => a -> Value
strToJSON

instance ConnectionModeI m => FromJSON (ConnectionLink m) where
  parseJSON :: Value -> Parser (ConnectionLink m)
parseJSON = FilePath -> Value -> Parser (ConnectionLink m)
forall a. StrEncoding a => FilePath -> Value -> Parser a
strParseJSON FilePath
"ConnectionLink"

instance ToJSON AConnectionLink where
  toEncoding :: AConnectionLink -> Encoding
toEncoding = AConnectionLink -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding
  toJSON :: AConnectionLink -> Value
toJSON = AConnectionLink -> Value
forall a. StrEncoding a => a -> Value
strToJSON

instance FromJSON AConnectionLink where
  parseJSON :: Value -> Parser AConnectionLink
parseJSON = FilePath -> Value -> Parser AConnectionLink
forall a. StrEncoding a => FilePath -> Value -> Parser a
strParseJSON FilePath
"AConnectionLink"

instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
  strEncode :: ConnShortLink m -> ConfirmationId
strEncode = \case
    CSLInvitation ShortLinkScheme
sch SMPServer
srv (SMP.EntityId ConfirmationId
lnkId) (LinkKey ConfirmationId
k) -> ShortLinkScheme
-> SMPServer
-> Char
-> ConfirmationId
-> ConfirmationId
-> ConfirmationId
slEncode ShortLinkScheme
sch SMPServer
srv Char
'i' ConfirmationId
lnkId ConfirmationId
k
    CSLContact ShortLinkScheme
sch ContactConnType
ct SMPServer
srv (LinkKey ConfirmationId
k) -> ShortLinkScheme
-> SMPServer
-> Char
-> ConfirmationId
-> ConfirmationId
-> ConfirmationId
slEncode ShortLinkScheme
sch SMPServer
srv (Char -> Char
toLower (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ ContactConnType -> Char
ctTypeChar ContactConnType
ct) ConfirmationId
"" ConfirmationId
k
    where
      slEncode :: ShortLinkScheme
-> SMPServer
-> Char
-> ConfirmationId
-> ConfirmationId
-> ConfirmationId
slEncode ShortLinkScheme
sch (SMPServer (TransportHost
h :| [TransportHost]
hs) FilePath
port (C.KeyHash ConfirmationId
kh)) Char
linkType ConfirmationId
lnkId ConfirmationId
k =
        [ConfirmationId] -> ConfirmationId
B.concat [ConfirmationId
Item [ConfirmationId]
authority, ConfirmationId
Item [ConfirmationId]
"/", Char -> ConfirmationId
B.singleton Char
linkType, ConfirmationId
Item [ConfirmationId]
"#", ConfirmationId
Item [ConfirmationId]
lnkIdStr, ConfirmationId -> ConfirmationId
B64.encodeUnpadded ConfirmationId
k, ConfirmationId
Item [ConfirmationId]
queryStr]
        where
          (ConfirmationId
authority, [TransportHost]
paramHosts) = case ShortLinkScheme
sch of
            ShortLinkScheme
SLSSimplex -> (ConfirmationId
"simplex:", TransportHost
h TransportHost -> [TransportHost] -> [TransportHost]
forall a. a -> [a] -> [a]
: [TransportHost]
hs)
            ShortLinkScheme
SLSServer -> (ConfirmationId
"https://" ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> TransportHost -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode TransportHost
h, [TransportHost]
hs)
          lnkIdStr :: ConfirmationId
lnkIdStr = if ConfirmationId -> SndQueueSecured
B.null ConfirmationId
lnkId then ConfirmationId
"" else ConfirmationId -> ConfirmationId
B64.encodeUnpadded ConfirmationId
lnkId ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
"/"
          queryStr :: ConfirmationId
queryStr = if ConfirmationId -> SndQueueSecured
B.null ConfirmationId
query then ConfirmationId
"" else ConfirmationId
"?" ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
query
          query :: ConfirmationId
query =
            QueryStringParams -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode (QueryStringParams -> ConfirmationId)
-> (SimpleQuery -> QueryStringParams)
-> SimpleQuery
-> ConfirmationId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QSPEscaping -> SimpleQuery -> QueryStringParams
QSP QSPEscaping
QEscape (SimpleQuery -> ConfirmationId) -> SimpleQuery -> ConfirmationId
forall a b. (a -> b) -> a -> b
$
              [(ConfirmationId
"h", TransportHosts_ -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode ([TransportHost] -> TransportHosts_
TransportHosts_ [TransportHost]
paramHosts)) | SndQueueSecured -> SndQueueSecured
not ([TransportHost] -> SndQueueSecured
forall a. [a] -> SndQueueSecured
forall (t :: * -> *) a. Foldable t => t a -> SndQueueSecured
null [TransportHost]
paramHosts)]
                SimpleQuery -> SimpleQuery -> SimpleQuery
forall a. Semigroup a => a -> a -> a
<> [(ConfirmationId
"p", FilePath -> ConfirmationId
B.pack FilePath
port) | SndQueueSecured -> SndQueueSecured
not (FilePath -> SndQueueSecured
forall a. [a] -> SndQueueSecured
forall (t :: * -> *) a. Foldable t => t a -> SndQueueSecured
null FilePath
port)]
                SimpleQuery -> SimpleQuery -> SimpleQuery
forall a. Semigroup a => a -> a -> a
<> [(ConfirmationId
"c", ConfirmationId -> ConfirmationId
B64.encodeUnpadded ConfirmationId
kh) | SndQueueSecured -> SndQueueSecured
not (ConfirmationId -> SndQueueSecured
B.null ConfirmationId
kh)]
  strP :: Parser (ConnShortLink m)
strP = (\(ACSL SConnectionMode m
_ ConnShortLink m
l) -> ConnShortLink m -> Either FilePath (ConnShortLink m)
forall (t :: ConnectionMode -> *) (m :: ConnectionMode)
       (m' :: ConnectionMode).
(ConnectionModeI m, ConnectionModeI m') =>
t m' -> Either FilePath (t m)
checkConnMode ConnShortLink m
l) (AConnShortLink -> Either FilePath (ConnShortLink m))
-> Parser ConfirmationId AConnShortLink -> Parser (ConnShortLink m)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either FilePath b) -> m a -> m b
<$?> Parser ConfirmationId AConnShortLink
forall a. StrEncoding a => Parser a
strP
  {-# INLINE strP #-}

instance StrEncoding AConnShortLink where
  strEncode :: AConnShortLink -> ConfirmationId
strEncode (ACSL SConnectionMode m
_ ConnShortLink m
l) = ConnShortLink m -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode ConnShortLink m
l
  {-# INLINE strEncode #-}
  strP :: Parser ConfirmationId AConnShortLink
strP = do
    (ShortLinkScheme
sch, Maybe TransportHost
h_) <- Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
authorityP Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
-> Parser Char
-> Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
'/'
    Maybe ContactConnType
ct_ <- Parser ConfirmationId (Maybe ContactConnType)
contactTypeP Parser ConfirmationId (Maybe ContactConnType)
-> Parser ConfirmationId (Maybe Char)
-> Parser ConfirmationId (Maybe ContactConnType)
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char -> Parser ConfirmationId (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Char
A.char Char
'/') Parser ConfirmationId (Maybe ContactConnType)
-> Parser Char -> Parser ConfirmationId (Maybe ContactConnType)
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
'#'
    case Maybe ContactConnType
ct_ of
      Maybe ContactConnType
Nothing -> do
        ConfirmationId
lnkId <- Parser ConfirmationId ConfirmationId
forall a. StrEncoding a => Parser a
strP Parser ConfirmationId ConfirmationId
-> Parser Char -> Parser ConfirmationId ConfirmationId
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
'/'
        ConfirmationId
k <- Parser ConfirmationId ConfirmationId
forall a. StrEncoding a => Parser a
strP
        SMPServer
srv <- Maybe TransportHost -> Parser SMPServer
serverQueryP Maybe TransportHost
h_
        AConnShortLink -> Parser ConfirmationId AConnShortLink
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AConnShortLink -> Parser ConfirmationId AConnShortLink)
-> AConnShortLink -> Parser ConfirmationId AConnShortLink
forall a b. (a -> b) -> a -> b
$ SConnectionMode 'CMInvitation
-> ConnShortLink 'CMInvitation -> AConnShortLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> ConnShortLink m -> AConnShortLink
ACSL SConnectionMode 'CMInvitation
SCMInvitation (ConnShortLink 'CMInvitation -> AConnShortLink)
-> ConnShortLink 'CMInvitation -> AConnShortLink
forall a b. (a -> b) -> a -> b
$ ShortLinkScheme
-> SMPServer -> LinkId -> LinkKey -> ConnShortLink 'CMInvitation
CSLInvitation ShortLinkScheme
sch SMPServer
srv (ConfirmationId -> LinkId
SMP.EntityId ConfirmationId
lnkId) (ConfirmationId -> LinkKey
LinkKey ConfirmationId
k)
      Just ContactConnType
ct -> do
        ConfirmationId
k <- Parser ConfirmationId ConfirmationId
forall a. StrEncoding a => Parser a
strP
        SMPServer
srv <- Maybe TransportHost -> Parser SMPServer
serverQueryP Maybe TransportHost
h_
        AConnShortLink -> Parser ConfirmationId AConnShortLink
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AConnShortLink -> Parser ConfirmationId AConnShortLink)
-> AConnShortLink -> Parser ConfirmationId AConnShortLink
forall a b. (a -> b) -> a -> b
$ SConnectionMode 'CMContact
-> ConnShortLink 'CMContact -> AConnShortLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> ConnShortLink m -> AConnShortLink
ACSL SConnectionMode 'CMContact
SCMContact (ConnShortLink 'CMContact -> AConnShortLink)
-> ConnShortLink 'CMContact -> AConnShortLink
forall a b. (a -> b) -> a -> b
$ ShortLinkScheme
-> ContactConnType
-> SMPServer
-> LinkKey
-> ConnShortLink 'CMContact
CSLContact ShortLinkScheme
sch ContactConnType
ct SMPServer
srv (ConfirmationId -> LinkKey
LinkKey ConfirmationId
k)
    where
      authorityP :: Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
authorityP =
        Parser ConfirmationId ConfirmationId
"simplex:" Parser ConfirmationId ConfirmationId
-> (ShortLinkScheme, Maybe TransportHost)
-> Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (ShortLinkScheme
SLSSimplex, Maybe TransportHost
forall a. Maybe a
Nothing)
          Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
-> Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
-> Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ConfirmationId ConfirmationId
"https://" Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
-> Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((ShortLinkScheme
SLSServer,) (Maybe TransportHost -> (ShortLinkScheme, Maybe TransportHost))
-> (TransportHost -> Maybe TransportHost)
-> TransportHost
-> (ShortLinkScheme, Maybe TransportHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransportHost -> Maybe TransportHost
forall a. a -> Maybe a
Just (TransportHost -> (ShortLinkScheme, Maybe TransportHost))
-> Parser ConfirmationId TransportHost
-> Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId TransportHost
forall a. StrEncoding a => Parser a
strP)
          Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
-> Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
-> Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath
-> Parser ConfirmationId (ShortLinkScheme, Maybe TransportHost)
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad short link scheme"
      contactTypeP :: Parser ConfirmationId (Maybe ContactConnType)
contactTypeP = do
        ContactConnType -> Maybe ContactConnType
forall a. a -> Maybe a
Just (ContactConnType -> Maybe ContactConnType)
-> Parser ConfirmationId ContactConnType
-> Parser ConfirmationId (Maybe ContactConnType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
A.anyChar Parser Char
-> (Char -> Parser ConfirmationId ContactConnType)
-> Parser ConfirmationId ContactConnType
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Parser ConfirmationId ContactConnType
ctTypeP (Char -> Parser ConfirmationId ContactConnType)
-> (Char -> Char) -> Char -> Parser ConfirmationId ContactConnType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toUpper)
          Parser ConfirmationId (Maybe ContactConnType)
-> Parser ConfirmationId (Maybe ContactConnType)
-> Parser ConfirmationId (Maybe ContactConnType)
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
A.char Char
'i' Parser Char
-> Maybe ContactConnType
-> Parser ConfirmationId (Maybe ContactConnType)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe ContactConnType
forall a. Maybe a
Nothing
          Parser ConfirmationId (Maybe ContactConnType)
-> Parser ConfirmationId (Maybe ContactConnType)
-> Parser ConfirmationId (Maybe ContactConnType)
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> Parser ConfirmationId (Maybe ContactConnType)
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"unknown short link type"
      serverQueryP :: Maybe TransportHost -> Parser SMPServer
serverQueryP Maybe TransportHost
h_ =
        Parser QueryStringParams
-> Parser ConfirmationId (Maybe QueryStringParams)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Char
A.char Char
'?' Parser Char -> Parser QueryStringParams -> Parser QueryStringParams
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser QueryStringParams
forall a. StrEncoding a => Parser a
strP) Parser ConfirmationId (Maybe QueryStringParams)
-> (Maybe QueryStringParams -> Parser SMPServer)
-> Parser SMPServer
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe QueryStringParams
Nothing -> Parser SMPServer
-> (TransportHost -> Parser SMPServer)
-> Maybe TransportHost
-> Parser SMPServer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser SMPServer
forall {a}. Parser ConfirmationId a
noServer (SMPServer -> Parser SMPServer
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SMPServer -> Parser SMPServer)
-> (TransportHost -> SMPServer)
-> TransportHost
-> Parser SMPServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransportHost -> SMPServer
SMPServerOnlyHost) Maybe TransportHost
h_
          Just QueryStringParams
query -> do
            NonEmpty TransportHost
hs <- Parser ConfirmationId (NonEmpty TransportHost)
-> (NonEmpty TransportHost
    -> Parser ConfirmationId (NonEmpty TransportHost))
-> Maybe (NonEmpty TransportHost)
-> Parser ConfirmationId (NonEmpty TransportHost)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser ConfirmationId (NonEmpty TransportHost)
forall {a}. Parser ConfirmationId a
noServer NonEmpty TransportHost
-> Parser ConfirmationId (NonEmpty TransportHost)
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (NonEmpty TransportHost)
 -> Parser ConfirmationId (NonEmpty TransportHost))
-> (Maybe TransportHosts_ -> Maybe (NonEmpty TransportHost))
-> Maybe TransportHosts_
-> Parser ConfirmationId (NonEmpty TransportHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TransportHost] -> Maybe (NonEmpty TransportHost)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty ([TransportHost] -> Maybe (NonEmpty TransportHost))
-> (Maybe TransportHosts_ -> [TransportHost])
-> Maybe TransportHosts_
-> Maybe (NonEmpty TransportHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TransportHost] -> [TransportHost])
-> (TransportHost -> [TransportHost] -> [TransportHost])
-> Maybe TransportHost
-> [TransportHost]
-> [TransportHost]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [TransportHost] -> [TransportHost]
forall a. a -> a
id (:) Maybe TransportHost
h_ ([TransportHost] -> [TransportHost])
-> (Maybe TransportHosts_ -> [TransportHost])
-> Maybe TransportHosts_
-> [TransportHost]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TransportHost]
-> (TransportHosts_ -> [TransportHost])
-> Maybe TransportHosts_
-> [TransportHost]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] TransportHosts_ -> [TransportHost]
thList_ (Maybe TransportHosts_
 -> Parser ConfirmationId (NonEmpty TransportHost))
-> Parser (Maybe TransportHosts_)
-> Parser ConfirmationId (NonEmpty TransportHost)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ConfirmationId
-> QueryStringParams -> Parser (Maybe TransportHosts_)
forall a.
StrEncoding a =>
ConfirmationId -> QueryStringParams -> Parser (Maybe a)
queryParam_ ConfirmationId
"h" QueryStringParams
query
            FilePath
p <- FilePath -> (Word16 -> FilePath) -> Maybe Word16 -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" Word16 -> FilePath
forall a. Show a => a -> FilePath
show (Maybe Word16 -> FilePath)
-> Parser ConfirmationId (Maybe Word16)
-> Parser ConfirmationId FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
StrEncoding a =>
ConfirmationId -> QueryStringParams -> Parser (Maybe a)
queryParam_ @Word16 ConfirmationId
"p" QueryStringParams
query
            KeyHash
kh <- KeyHash -> Maybe KeyHash -> KeyHash
forall a. a -> Maybe a -> a
fromMaybe (ConfirmationId -> KeyHash
C.KeyHash ConfirmationId
"") (Maybe KeyHash -> KeyHash)
-> Parser ConfirmationId (Maybe KeyHash)
-> Parser ConfirmationId KeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfirmationId
-> QueryStringParams -> Parser ConfirmationId (Maybe KeyHash)
forall a.
StrEncoding a =>
ConfirmationId -> QueryStringParams -> Parser (Maybe a)
queryParam_ ConfirmationId
"c" QueryStringParams
query
            SMPServer -> Parser SMPServer
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SMPServer -> Parser SMPServer) -> SMPServer -> Parser SMPServer
forall a b. (a -> b) -> a -> b
$ NonEmpty TransportHost -> FilePath -> KeyHash -> SMPServer
SMPServer NonEmpty TransportHost
hs FilePath
p KeyHash
kh
      noServer :: Parser ConfirmationId a
noServer = FilePath -> Parser ConfirmationId a
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"short link without server"

instance ConnectionModeI m => Encoding (ConnShortLink m) where
  smpEncode :: ConnShortLink m -> ConfirmationId
smpEncode = \case
    CSLInvitation ShortLinkScheme
_ SMPServer
srv LinkId
lnkId (LinkKey ConfirmationId
k) -> (ConnectionMode, SMPServer, LinkId, ConfirmationId)
-> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (ConnectionMode
CMInvitation, SMPServer
srv, LinkId
lnkId, ConfirmationId
k)
    CSLContact ShortLinkScheme
_ ContactConnType
ct SMPServer
srv (LinkKey ConfirmationId
k) -> (ConnectionMode, Char, SMPServer, ConfirmationId) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (ConnectionMode
CMContact, ContactConnType -> Char
ctTypeChar ContactConnType
ct, SMPServer
srv, ConfirmationId
k)
  smpP :: Parser (ConnShortLink m)
smpP = (\(ACSL SConnectionMode m
_ ConnShortLink m
l) -> ConnShortLink m -> Either FilePath (ConnShortLink m)
forall (t :: ConnectionMode -> *) (m :: ConnectionMode)
       (m' :: ConnectionMode).
(ConnectionModeI m, ConnectionModeI m') =>
t m' -> Either FilePath (t m)
checkConnMode ConnShortLink m
l) (AConnShortLink -> Either FilePath (ConnShortLink m))
-> Parser ConfirmationId AConnShortLink -> Parser (ConnShortLink m)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either FilePath b) -> m a -> m b
<$?> Parser ConfirmationId AConnShortLink
forall a. Encoding a => Parser a
smpP
  {-# INLINE smpP #-}

instance Encoding AConnShortLink where
  smpEncode :: AConnShortLink -> ConfirmationId
smpEncode (ACSL SConnectionMode m
_ ConnShortLink m
l) = ConnShortLink m -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode ConnShortLink m
l
  {-# INLINE smpEncode #-}
  smpP :: Parser ConfirmationId AConnShortLink
smpP =
    Parser ConnectionMode
forall a. Encoding a => Parser a
smpP Parser ConnectionMode
-> (ConnectionMode -> Parser ConfirmationId AConnShortLink)
-> Parser ConfirmationId AConnShortLink
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConnectionMode
CMInvitation -> do
        (SMPServer
srv, LinkId
lnkId, ConfirmationId
k) <- Parser (SMPServer, LinkId, ConfirmationId)
forall a. Encoding a => Parser a
smpP
        AConnShortLink -> Parser ConfirmationId AConnShortLink
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AConnShortLink -> Parser ConfirmationId AConnShortLink)
-> AConnShortLink -> Parser ConfirmationId AConnShortLink
forall a b. (a -> b) -> a -> b
$ SConnectionMode 'CMInvitation
-> ConnShortLink 'CMInvitation -> AConnShortLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> ConnShortLink m -> AConnShortLink
ACSL SConnectionMode 'CMInvitation
SCMInvitation (ConnShortLink 'CMInvitation -> AConnShortLink)
-> ConnShortLink 'CMInvitation -> AConnShortLink
forall a b. (a -> b) -> a -> b
$ ShortLinkScheme
-> SMPServer -> LinkId -> LinkKey -> ConnShortLink 'CMInvitation
CSLInvitation ShortLinkScheme
SLSServer SMPServer
srv LinkId
lnkId (ConfirmationId -> LinkKey
LinkKey ConfirmationId
k)
      ConnectionMode
CMContact -> do
        ContactConnType
ct <- Char -> Parser ConfirmationId ContactConnType
ctTypeP (Char -> Parser ConfirmationId ContactConnType)
-> Parser Char -> Parser ConfirmationId ContactConnType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Char
A.anyChar
        (SMPServer
srv, ConfirmationId
k) <- Parser (SMPServer, ConfirmationId)
forall a. Encoding a => Parser a
smpP
        AConnShortLink -> Parser ConfirmationId AConnShortLink
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AConnShortLink -> Parser ConfirmationId AConnShortLink)
-> AConnShortLink -> Parser ConfirmationId AConnShortLink
forall a b. (a -> b) -> a -> b
$ SConnectionMode 'CMContact
-> ConnShortLink 'CMContact -> AConnShortLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> ConnShortLink m -> AConnShortLink
ACSL SConnectionMode 'CMContact
SCMContact (ConnShortLink 'CMContact -> AConnShortLink)
-> ConnShortLink 'CMContact -> AConnShortLink
forall a b. (a -> b) -> a -> b
$ ShortLinkScheme
-> ContactConnType
-> SMPServer
-> LinkKey
-> ConnShortLink 'CMContact
CSLContact ShortLinkScheme
SLSServer ContactConnType
ct SMPServer
srv (ConfirmationId -> LinkKey
LinkKey ConfirmationId
k)

ctTypeP :: Char -> Parser ContactConnType
ctTypeP :: Char -> Parser ConfirmationId ContactConnType
ctTypeP = \case
  Char
'A' -> ContactConnType -> Parser ConfirmationId ContactConnType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContactConnType
CCTContact
  Char
'C' -> ContactConnType -> Parser ConfirmationId ContactConnType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContactConnType
CCTChannel
  Char
'G' -> ContactConnType -> Parser ConfirmationId ContactConnType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContactConnType
CCTGroup
  Char
'R' -> ContactConnType -> Parser ConfirmationId ContactConnType
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContactConnType
CCTRelay
  Char
_ -> FilePath -> Parser ConfirmationId ContactConnType
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"unknown contact address type"
{-# INLINE ctTypeP #-}

ctTypeChar :: ContactConnType -> Char
ctTypeChar :: ContactConnType -> Char
ctTypeChar = \case
  ContactConnType
CCTContact -> Char
'A'
  ContactConnType
CCTChannel -> Char
'C'
  ContactConnType
CCTGroup -> Char
'G'
  ContactConnType
CCTRelay -> Char
'R'
{-# INLINE ctTypeChar #-}

-- the servers passed to this function should be all preset servers, not servers configured by the user.
shortenShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
shortenShortLink :: forall (m :: ConnectionMode).
NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
shortenShortLink NonEmpty SMPServer
presetSrvs = \case
  CSLInvitation ShortLinkScheme
sch SMPServer
srv LinkId
lnkId LinkKey
linkKey -> ShortLinkScheme
-> SMPServer -> LinkId -> LinkKey -> ConnShortLink 'CMInvitation
CSLInvitation ShortLinkScheme
sch (SMPServer -> SMPServer
shortServer SMPServer
srv) LinkId
lnkId LinkKey
linkKey
  CSLContact ShortLinkScheme
sch ContactConnType
ct SMPServer
srv LinkKey
linkKey -> ShortLinkScheme
-> ContactConnType
-> SMPServer
-> LinkKey
-> ConnShortLink 'CMContact
CSLContact ShortLinkScheme
sch ContactConnType
ct (SMPServer -> SMPServer
shortServer SMPServer
srv) LinkKey
linkKey
  where
    shortServer :: SMPServer -> SMPServer
shortServer srv :: SMPServer
srv@(SMPServer (TransportHost
h :| [TransportHost]
_) FilePath
_ KeyHash
_) =
      if SMPServer -> NonEmpty SMPServer -> SndQueueSecured
forall (t :: * -> *).
Foldable t =>
SMPServer -> t SMPServer -> SndQueueSecured
isPresetServer SMPServer
srv NonEmpty SMPServer
presetSrvs then TransportHost -> SMPServer
SMPServerOnlyHost TransportHost
h else SMPServer
srv

isPresetServer :: Foldable t => SMPServer -> t SMPServer -> Bool
isPresetServer :: forall (t :: * -> *).
Foldable t =>
SMPServer -> t SMPServer -> SndQueueSecured
isPresetServer srv :: SMPServer
srv@(SMPServer NonEmpty TransportHost
hs FilePath
p KeyHash
kh) t SMPServer
presetSrvs = case SMPServer -> t SMPServer -> Maybe SMPServer
forall (t :: * -> *).
Foldable t =>
SMPServer -> t SMPServer -> Maybe SMPServer
findPresetServer SMPServer
srv t SMPServer
presetSrvs of
  Just (SMPServer NonEmpty TransportHost
hs' FilePath
p' KeyHash
kh') ->
    (TransportHost -> SndQueueSecured)
-> NonEmpty TransportHost -> SndQueueSecured
forall (t :: * -> *) a.
Foldable t =>
(a -> SndQueueSecured) -> t a -> SndQueueSecured
all (TransportHost -> NonEmpty TransportHost -> SndQueueSecured
forall a. Eq a => a -> NonEmpty a -> SndQueueSecured
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> SndQueueSecured
`elem` NonEmpty TransportHost
hs') NonEmpty TransportHost
hs
      SndQueueSecured -> SndQueueSecured -> SndQueueSecured
&& (FilePath
p FilePath -> FilePath -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== FilePath
p' SndQueueSecured -> SndQueueSecured -> SndQueueSecured
|| (FilePath -> SndQueueSecured
forall a. [a] -> SndQueueSecured
forall (t :: * -> *) a. Foldable t => t a -> SndQueueSecured
null FilePath
p' SndQueueSecured -> SndQueueSecured -> SndQueueSecured
&& (FilePath
p FilePath -> FilePath -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== FilePath
"443" SndQueueSecured -> SndQueueSecured -> SndQueueSecured
|| FilePath
p FilePath -> FilePath -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== FilePath
"5223")))
      SndQueueSecured -> SndQueueSecured -> SndQueueSecured
&& KeyHash
kh KeyHash -> KeyHash -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== KeyHash
kh'
  Maybe SMPServer
Nothing -> SndQueueSecured
False

-- explicit bidirectional is used for ghc 8.10.7 compatibility, [h]/[] patterns are not reversible.
pattern SMPServerOnlyHost :: TransportHost -> SMPServer
pattern $mSMPServerOnlyHost :: forall {r}. SMPServer -> (TransportHost -> r) -> ((# #) -> r) -> r
$bSMPServerOnlyHost :: TransportHost -> SMPServer
SMPServerOnlyHost h <- SMPServer [h] "" (C.KeyHash "")
  where
    SMPServerOnlyHost TransportHost
h = NonEmpty TransportHost -> FilePath -> KeyHash -> SMPServer
SMPServer [Item (NonEmpty TransportHost)
TransportHost
h] FilePath
"" (ConfirmationId -> KeyHash
C.KeyHash ConfirmationId
"")

-- the servers passed to this function should be all preset servers, not servers configured by the user.
restoreShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
restoreShortLink :: forall (m :: ConnectionMode).
NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
restoreShortLink NonEmpty SMPServer
presetSrvs = \case
  CSLInvitation ShortLinkScheme
sch SMPServer
srv LinkId
lnkId LinkKey
linkKey -> ShortLinkScheme
-> SMPServer -> LinkId -> LinkKey -> ConnShortLink 'CMInvitation
CSLInvitation ShortLinkScheme
sch (SMPServer -> SMPServer
fullServer SMPServer
srv) LinkId
lnkId LinkKey
linkKey
  CSLContact ShortLinkScheme
sch ContactConnType
ct SMPServer
srv LinkKey
linkKey -> ShortLinkScheme
-> ContactConnType
-> SMPServer
-> LinkKey
-> ConnShortLink 'CMContact
CSLContact ShortLinkScheme
sch ContactConnType
ct (SMPServer -> SMPServer
fullServer SMPServer
srv) LinkKey
linkKey
  where
    fullServer :: SMPServer -> SMPServer
fullServer = \case
      s :: SMPServer
s@(SMPServerOnlyHost TransportHost
_) -> SMPServer -> Maybe SMPServer -> SMPServer
forall a. a -> Maybe a -> a
fromMaybe SMPServer
s (Maybe SMPServer -> SMPServer) -> Maybe SMPServer -> SMPServer
forall a b. (a -> b) -> a -> b
$ SMPServer -> NonEmpty SMPServer -> Maybe SMPServer
forall (t :: * -> *).
Foldable t =>
SMPServer -> t SMPServer -> Maybe SMPServer
findPresetServer SMPServer
s NonEmpty SMPServer
presetSrvs
      SMPServer
s -> SMPServer
s

findPresetServer :: Foldable t => SMPServer -> t SMPServer -> Maybe SMPServer
findPresetServer :: forall (t :: * -> *).
Foldable t =>
SMPServer -> t SMPServer -> Maybe SMPServer
findPresetServer ProtocolServer {$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host = TransportHost
h :| [TransportHost]
_} = (SMPServer -> SndQueueSecured) -> t SMPServer -> Maybe SMPServer
forall (t :: * -> *) a.
Foldable t =>
(a -> SndQueueSecured) -> t a -> Maybe a
find (\ProtocolServer {$sel:host:ProtocolServer :: forall (p :: ProtocolType).
ProtocolServer p -> NonEmpty TransportHost
host = TransportHost
h' :| [TransportHost]
_} -> TransportHost
h TransportHost -> TransportHost -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== TransportHost
h')
{-# INLINE findPresetServer #-}

sameConnReqContact :: ConnectionRequestUri 'CMContact -> ConnectionRequestUri 'CMContact -> Bool
sameConnReqContact :: ConnectionRequestUri 'CMContact
-> ConnectionRequestUri 'CMContact -> SndQueueSecured
sameConnReqContact (CRContactUri ConnReqUriData {$sel:crSmpQueues:ConnReqUriData :: ConnReqUriData -> NonEmpty SMPQueueUri
crSmpQueues = NonEmpty SMPQueueUri
qs}) (CRContactUri ConnReqUriData {$sel:crSmpQueues:ConnReqUriData :: ConnReqUriData -> NonEmpty SMPQueueUri
crSmpQueues = NonEmpty SMPQueueUri
qs'}) =
  NonEmpty SMPQueueUri -> Int
forall a. NonEmpty a -> Int
L.length NonEmpty SMPQueueUri
qs Int -> Int -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== NonEmpty SMPQueueUri -> Int
forall a. NonEmpty a -> Int
L.length NonEmpty SMPQueueUri
qs' SndQueueSecured -> SndQueueSecured -> SndQueueSecured
&& ((SMPQueueUri, SMPQueueUri) -> SndQueueSecured)
-> NonEmpty (SMPQueueUri, SMPQueueUri) -> SndQueueSecured
forall (t :: * -> *) a.
Foldable t =>
(a -> SndQueueSecured) -> t a -> SndQueueSecured
all (SMPQueueUri, SMPQueueUri) -> SndQueueSecured
forall {q} {q}.
(SMPQueue q, SMPQueue q) =>
(q, q) -> SndQueueSecured
same (NonEmpty SMPQueueUri
-> NonEmpty SMPQueueUri -> NonEmpty (SMPQueueUri, SMPQueueUri)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
L.zip NonEmpty SMPQueueUri
qs NonEmpty SMPQueueUri
qs')
  where
    same :: (q, q) -> SndQueueSecured
same (q
q, q
q') = SndQAddr -> SndQAddr -> SndQueueSecured
sameQAddress (q -> SndQAddr
forall q. SMPQueue q => q -> SndQAddr
qAddress q
q) (q -> SndQAddr
forall q. SMPQueue q => q -> SndQAddr
qAddress q
q')

sameShortLinkContact :: ConnShortLink 'CMContact -> ConnShortLink 'CMContact -> Bool
sameShortLinkContact :: ConnShortLink 'CMContact
-> ConnShortLink 'CMContact -> SndQueueSecured
sameShortLinkContact (CSLContact ShortLinkScheme
_ ContactConnType
ct SMPServer
srv LinkKey
k) (CSLContact ShortLinkScheme
_ ContactConnType
ct' SMPServer
srv' LinkKey
k') =
  ContactConnType
ct ContactConnType -> ContactConnType -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== ContactConnType
ct' SndQueueSecured -> SndQueueSecured -> SndQueueSecured
&& SMPServer -> SMPServer -> SndQueueSecured
forall (p :: ProtocolType).
ProtocolServer p -> ProtocolServer p -> SndQueueSecured
sameSrvAddr SMPServer
srv SMPServer
srv' SndQueueSecured -> SndQueueSecured -> SndQueueSecured
&& LinkKey
k LinkKey -> LinkKey -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== LinkKey
k'

checkConnMode :: forall t m m'. (ConnectionModeI m, ConnectionModeI m') => t m' -> Either String (t m)
checkConnMode :: forall (t :: ConnectionMode -> *) (m :: ConnectionMode)
       (m' :: ConnectionMode).
(ConnectionModeI m, ConnectionModeI m') =>
t m' -> Either FilePath (t m)
checkConnMode t m'
c = case SConnectionMode m -> SConnectionMode m' -> Maybe (m :~: m')
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: ConnectionMode) (b :: ConnectionMode).
SConnectionMode a -> SConnectionMode b -> Maybe (a :~: b)
testEquality (forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m
sConnectionMode @m) (forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m
sConnectionMode @m') of
  Just m :~: m'
Refl -> t m -> Either FilePath (t m)
forall a b. b -> Either a b
Right t m
t m'
c
  Maybe (m :~: m')
Nothing -> FilePath -> Either FilePath (t m)
forall a b. a -> Either a b
Left FilePath
"bad connection mode"
{-# INLINE checkConnMode #-}

data ConnReqUriData = ConnReqUriData
  { ConnReqUriData -> ServiceScheme
crScheme :: ServiceScheme,
    ConnReqUriData -> VersionRangeSMPA
crAgentVRange :: VersionRangeSMPA,
    ConnReqUriData -> NonEmpty SMPQueueUri
crSmpQueues :: NonEmpty SMPQueueUri,
    ConnReqUriData -> Maybe CRClientData
crClientData :: Maybe CRClientData
  }
  deriving (ConnReqUriData -> ConnReqUriData -> SndQueueSecured
(ConnReqUriData -> ConnReqUriData -> SndQueueSecured)
-> (ConnReqUriData -> ConnReqUriData -> SndQueueSecured)
-> Eq ConnReqUriData
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: ConnReqUriData -> ConnReqUriData -> SndQueueSecured
== :: ConnReqUriData -> ConnReqUriData -> SndQueueSecured
$c/= :: ConnReqUriData -> ConnReqUriData -> SndQueueSecured
/= :: ConnReqUriData -> ConnReqUriData -> SndQueueSecured
Eq, Int -> ConnReqUriData -> ShowS
[ConnReqUriData] -> ShowS
ConnReqUriData -> FilePath
(Int -> ConnReqUriData -> ShowS)
-> (ConnReqUriData -> FilePath)
-> ([ConnReqUriData] -> ShowS)
-> Show ConnReqUriData
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnReqUriData -> ShowS
showsPrec :: Int -> ConnReqUriData -> ShowS
$cshow :: ConnReqUriData -> FilePath
show :: ConnReqUriData -> FilePath
$cshowList :: [ConnReqUriData] -> ShowS
showList :: [ConnReqUriData] -> ShowS
Show)

type CRClientData = Text

data FixedLinkData c = FixedLinkData
  { forall (c :: ConnectionMode). FixedLinkData c -> VersionRangeSMPA
agentVRange :: VersionRangeSMPA,
    forall (c :: ConnectionMode). FixedLinkData c -> PublicKeyEd25519
rootKey :: C.PublicKeyEd25519,
    forall (c :: ConnectionMode).
FixedLinkData c -> ConnectionRequestUri c
linkConnReq :: ConnectionRequestUri c,
    forall (c :: ConnectionMode).
FixedLinkData c -> Maybe ConfirmationId
linkEntityId :: Maybe ByteString
  }
  deriving (FixedLinkData c -> FixedLinkData c -> SndQueueSecured
(FixedLinkData c -> FixedLinkData c -> SndQueueSecured)
-> (FixedLinkData c -> FixedLinkData c -> SndQueueSecured)
-> Eq (FixedLinkData c)
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
forall (c :: ConnectionMode).
FixedLinkData c -> FixedLinkData c -> SndQueueSecured
$c== :: forall (c :: ConnectionMode).
FixedLinkData c -> FixedLinkData c -> SndQueueSecured
== :: FixedLinkData c -> FixedLinkData c -> SndQueueSecured
$c/= :: forall (c :: ConnectionMode).
FixedLinkData c -> FixedLinkData c -> SndQueueSecured
/= :: FixedLinkData c -> FixedLinkData c -> SndQueueSecured
Eq, Int -> FixedLinkData c -> ShowS
[FixedLinkData c] -> ShowS
FixedLinkData c -> FilePath
(Int -> FixedLinkData c -> ShowS)
-> (FixedLinkData c -> FilePath)
-> ([FixedLinkData c] -> ShowS)
-> Show (FixedLinkData c)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall (c :: ConnectionMode). Int -> FixedLinkData c -> ShowS
forall (c :: ConnectionMode). [FixedLinkData c] -> ShowS
forall (c :: ConnectionMode). FixedLinkData c -> FilePath
$cshowsPrec :: forall (c :: ConnectionMode). Int -> FixedLinkData c -> ShowS
showsPrec :: Int -> FixedLinkData c -> ShowS
$cshow :: forall (c :: ConnectionMode). FixedLinkData c -> FilePath
show :: FixedLinkData c -> FilePath
$cshowList :: forall (c :: ConnectionMode). [FixedLinkData c] -> ShowS
showList :: [FixedLinkData c] -> ShowS
Show)

data ConnLinkData c where
  InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation
  ContactLinkData :: VersionRangeSMPA -> UserContactData -> ConnLinkData 'CMContact

deriving instance Eq (ConnLinkData c)

deriving instance Show (ConnLinkData c)

data UserContactData = UserContactData
  { -- direct connection via connReq in fixed data is allowed.
    UserContactData -> SndQueueSecured
direct :: Bool,
    -- additional owner keys to sign changes of mutable data.
    UserContactData -> [OwnerAuth]
owners :: [OwnerAuth],
    -- alternative addresses of chat relays that receive requests for this contact address.
    UserContactData -> [ConnShortLink 'CMContact]
relays :: [ConnShortLink 'CMContact],
    UserContactData -> UserLinkData
userData :: UserLinkData
  }
  deriving (UserContactData -> UserContactData -> SndQueueSecured
(UserContactData -> UserContactData -> SndQueueSecured)
-> (UserContactData -> UserContactData -> SndQueueSecured)
-> Eq UserContactData
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: UserContactData -> UserContactData -> SndQueueSecured
== :: UserContactData -> UserContactData -> SndQueueSecured
$c/= :: UserContactData -> UserContactData -> SndQueueSecured
/= :: UserContactData -> UserContactData -> SndQueueSecured
Eq, Int -> UserContactData -> ShowS
[UserContactData] -> ShowS
UserContactData -> FilePath
(Int -> UserContactData -> ShowS)
-> (UserContactData -> FilePath)
-> ([UserContactData] -> ShowS)
-> Show UserContactData
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserContactData -> ShowS
showsPrec :: Int -> UserContactData -> ShowS
$cshow :: UserContactData -> FilePath
show :: UserContactData -> FilePath
$cshowList :: [UserContactData] -> ShowS
showList :: [UserContactData] -> ShowS
Show)

newtype UserLinkData = UserLinkData ByteString
  deriving (UserLinkData -> UserLinkData -> SndQueueSecured
(UserLinkData -> UserLinkData -> SndQueueSecured)
-> (UserLinkData -> UserLinkData -> SndQueueSecured)
-> Eq UserLinkData
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: UserLinkData -> UserLinkData -> SndQueueSecured
== :: UserLinkData -> UserLinkData -> SndQueueSecured
$c/= :: UserLinkData -> UserLinkData -> SndQueueSecured
/= :: UserLinkData -> UserLinkData -> SndQueueSecured
Eq, Int -> UserLinkData -> ShowS
[UserLinkData] -> ShowS
UserLinkData -> FilePath
(Int -> UserLinkData -> ShowS)
-> (UserLinkData -> FilePath)
-> ([UserLinkData] -> ShowS)
-> Show UserLinkData
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserLinkData -> ShowS
showsPrec :: Int -> UserLinkData -> ShowS
$cshow :: UserLinkData -> FilePath
show :: UserLinkData -> FilePath
$cshowList :: [UserLinkData] -> ShowS
showList :: [UserLinkData] -> ShowS
Show)

data AConnLinkData = forall m. ConnectionModeI m => ACLD (SConnectionMode m) (ConnLinkData m)

data UserConnLinkData c where
  UserInvLinkData :: UserLinkData -> UserConnLinkData 'CMInvitation
  UserContactLinkData :: UserContactData -> UserConnLinkData 'CMContact

deriving instance Eq (UserConnLinkData m)

deriving instance Show (UserConnLinkData m)

data AUserConnLinkData = forall m. ConnectionModeI m => AULD (SConnectionMode m) (UserConnLinkData m)

linkUserData :: ConnLinkData c -> UserLinkData
linkUserData :: forall (c :: ConnectionMode). ConnLinkData c -> UserLinkData
linkUserData = \case
  InvitationLinkData VersionRangeSMPA
_ UserLinkData
d -> UserLinkData
d
  ContactLinkData VersionRangeSMPA
_ UserContactData {UserLinkData
$sel:userData:UserContactData :: UserContactData -> UserLinkData
userData :: UserLinkData
userData} -> UserLinkData
userData
{-# INLINE linkUserData #-}

linkUserData' :: ConnLinkData c -> ByteString
linkUserData' :: forall (c :: ConnectionMode). ConnLinkData c -> ConfirmationId
linkUserData' ConnLinkData c
d = let UserLinkData ConfirmationId
s = ConnLinkData c -> UserLinkData
forall (c :: ConnectionMode). ConnLinkData c -> UserLinkData
linkUserData ConnLinkData c
d in ConfirmationId
s
{-# INLINE linkUserData' #-}

type OwnerId = ByteString

data OwnerAuth = OwnerAuth
  { OwnerAuth -> ConfirmationId
ownerId :: OwnerId, -- unique in the list, application specific - e.g., MemberId
    OwnerAuth -> PublicKeyEd25519
ownerKey :: C.PublicKeyEd25519,
    -- owner authorization by root or any previous owner, sig(ownerId || ownerKey, prevOwnerKey),
    OwnerAuth -> Signature 'Ed25519
authOwnerSig :: C.Signature 'C.Ed25519
  }
  deriving (OwnerAuth -> OwnerAuth -> SndQueueSecured
(OwnerAuth -> OwnerAuth -> SndQueueSecured)
-> (OwnerAuth -> OwnerAuth -> SndQueueSecured) -> Eq OwnerAuth
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: OwnerAuth -> OwnerAuth -> SndQueueSecured
== :: OwnerAuth -> OwnerAuth -> SndQueueSecured
$c/= :: OwnerAuth -> OwnerAuth -> SndQueueSecured
/= :: OwnerAuth -> OwnerAuth -> SndQueueSecured
Eq, Int -> OwnerAuth -> ShowS
[OwnerAuth] -> ShowS
OwnerAuth -> FilePath
(Int -> OwnerAuth -> ShowS)
-> (OwnerAuth -> FilePath)
-> ([OwnerAuth] -> ShowS)
-> Show OwnerAuth
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OwnerAuth -> ShowS
showsPrec :: Int -> OwnerAuth -> ShowS
$cshow :: OwnerAuth -> FilePath
show :: OwnerAuth -> FilePath
$cshowList :: [OwnerAuth] -> ShowS
showList :: [OwnerAuth] -> ShowS
Show)

instance Encoding OwnerAuth where
  smpEncode :: OwnerAuth -> ConfirmationId
smpEncode OwnerAuth {ConfirmationId
$sel:ownerId:OwnerAuth :: OwnerAuth -> ConfirmationId
ownerId :: ConfirmationId
ownerId, PublicKeyEd25519
$sel:ownerKey:OwnerAuth :: OwnerAuth -> PublicKeyEd25519
ownerKey :: PublicKeyEd25519
ownerKey, Signature 'Ed25519
$sel:authOwnerSig:OwnerAuth :: OwnerAuth -> Signature 'Ed25519
authOwnerSig :: Signature 'Ed25519
authOwnerSig} =
    -- It is additionally encoded as ByteString to have known length and allow OwnerAuth extension
    ConfirmationId -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (ConfirmationId -> ConfirmationId)
-> ConfirmationId -> ConfirmationId
forall a b. (a -> b) -> a -> b
$ (ConfirmationId, PublicKeyEd25519, ConfirmationId)
-> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (ConfirmationId
ownerId, PublicKeyEd25519
ownerKey, Signature 'Ed25519 -> ConfirmationId
forall s. CryptoSignature s => s -> ConfirmationId
C.signatureBytes Signature 'Ed25519
authOwnerSig)
  smpP :: Parser OwnerAuth
smpP = do
    -- parseOnly ignores any unused extension
    (ConfirmationId
ownerId, PublicKeyEd25519
ownerKey, Signature 'Ed25519
authOwnerSig) <- Parser (ConfirmationId, PublicKeyEd25519, Signature 'Ed25519)
-> ConfirmationId
-> Either
     FilePath (ConfirmationId, PublicKeyEd25519, Signature 'Ed25519)
forall a. Parser a -> ConfirmationId -> Either FilePath a
A.parseOnly Parser (ConfirmationId, PublicKeyEd25519, Signature 'Ed25519)
forall a. Encoding a => Parser a
smpP (ConfirmationId
 -> Either
      FilePath (ConfirmationId, PublicKeyEd25519, Signature 'Ed25519))
-> Parser ConfirmationId ConfirmationId
-> Parser (ConfirmationId, PublicKeyEd25519, Signature 'Ed25519)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either FilePath b) -> m a -> m b
<$?> Parser ConfirmationId ConfirmationId
forall a. Encoding a => Parser a
smpP
    OwnerAuth -> Parser OwnerAuth
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OwnerAuth {ConfirmationId
$sel:ownerId:OwnerAuth :: ConfirmationId
ownerId :: ConfirmationId
ownerId, PublicKeyEd25519
$sel:ownerKey:OwnerAuth :: PublicKeyEd25519
ownerKey :: PublicKeyEd25519
ownerKey, Signature 'Ed25519
$sel:authOwnerSig:OwnerAuth :: Signature 'Ed25519
authOwnerSig :: Signature 'Ed25519
authOwnerSig}

validateOwners :: Maybe ShortLinkCreds -> UserContactData -> Either String ()
validateOwners :: Maybe ShortLinkCreds -> UserContactData -> Either FilePath ()
validateOwners Maybe ShortLinkCreds
shortLink_ UserContactData {[OwnerAuth]
$sel:owners:UserContactData :: UserContactData -> [OwnerAuth]
owners :: [OwnerAuth]
owners} = case Maybe ShortLinkCreds
shortLink_ of
  Maybe ShortLinkCreds
Nothing
    | [OwnerAuth] -> SndQueueSecured
forall a. [a] -> SndQueueSecured
forall (t :: * -> *) a. Foldable t => t a -> SndQueueSecured
null [OwnerAuth]
owners -> () -> Either FilePath ()
forall a b. b -> Either a b
Right ()
    | SndQueueSecured
otherwise -> FilePath -> Either FilePath ()
forall a b. a -> Either a b
Left FilePath
"no link credentials with additional owners"
  Just ShortLinkCreds {PrivateKeyEd25519
$sel:linkPrivSigKey:ShortLinkCreds :: ShortLinkCreds -> PrivateKeyEd25519
linkPrivSigKey :: PrivateKeyEd25519
linkPrivSigKey, Maybe PublicKeyEd25519
$sel:linkRootSigKey:ShortLinkCreds :: ShortLinkCreds -> Maybe PublicKeyEd25519
linkRootSigKey :: Maybe PublicKeyEd25519
linkRootSigKey}
    | SndQueueSecured
hasOwner -> PublicKeyEd25519 -> [OwnerAuth] -> Either FilePath ()
validateLinkOwners (PublicKeyEd25519 -> Maybe PublicKeyEd25519 -> PublicKeyEd25519
forall a. a -> Maybe a -> a
fromMaybe PublicKeyEd25519
k Maybe PublicKeyEd25519
linkRootSigKey) [OwnerAuth]
owners
    | SndQueueSecured
otherwise -> FilePath -> Either FilePath ()
forall a b. a -> Either a b
Left FilePath
"no current owner in link data"
    where
      hasOwner :: SndQueueSecured
hasOwner = Maybe PublicKeyEd25519 -> SndQueueSecured
forall a. Maybe a -> SndQueueSecured
isNothing Maybe PublicKeyEd25519
linkRootSigKey SndQueueSecured -> SndQueueSecured -> SndQueueSecured
|| (OwnerAuth -> SndQueueSecured) -> [OwnerAuth] -> SndQueueSecured
forall (t :: * -> *) a.
Foldable t =>
(a -> SndQueueSecured) -> t a -> SndQueueSecured
any ((PublicKeyEd25519
k PublicKeyEd25519 -> PublicKeyEd25519 -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
==) (PublicKeyEd25519 -> SndQueueSecured)
-> (OwnerAuth -> PublicKeyEd25519) -> OwnerAuth -> SndQueueSecured
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwnerAuth -> PublicKeyEd25519
ownerKey) [OwnerAuth]
owners
      k :: PublicKeyEd25519
k = PrivateKeyEd25519 -> PublicKeyEd25519
forall (a :: Algorithm). PrivateKey a -> PublicKey a
C.publicKey PrivateKeyEd25519
linkPrivSigKey

validateLinkOwners :: C.PublicKeyEd25519 -> [OwnerAuth] -> Either String ()
validateLinkOwners :: PublicKeyEd25519 -> [OwnerAuth] -> Either FilePath ()
validateLinkOwners PublicKeyEd25519
rootKey = [OwnerAuth] -> [OwnerAuth] -> Either FilePath ()
go []
  where
    go :: [OwnerAuth] -> [OwnerAuth] -> Either FilePath ()
go [OwnerAuth]
_ [] = () -> Either FilePath ()
forall a b. b -> Either a b
Right ()
    go [OwnerAuth]
prev (OwnerAuth
o : [OwnerAuth]
os) = OwnerAuth -> Either FilePath ()
validOwner OwnerAuth
o Either FilePath () -> Either FilePath () -> Either FilePath ()
forall a b.
Either FilePath a -> Either FilePath b -> Either FilePath b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [OwnerAuth] -> [OwnerAuth] -> Either FilePath ()
go (OwnerAuth
o OwnerAuth -> [OwnerAuth] -> [OwnerAuth]
forall a. a -> [a] -> [a]
: [OwnerAuth]
prev) [OwnerAuth]
os
      where
        validOwner :: OwnerAuth -> Either FilePath ()
validOwner OwnerAuth {$sel:ownerId:OwnerAuth :: OwnerAuth -> ConfirmationId
ownerId = ConfirmationId
oId, $sel:ownerKey:OwnerAuth :: OwnerAuth -> PublicKeyEd25519
ownerKey = PublicKeyEd25519
k, $sel:authOwnerSig:OwnerAuth :: OwnerAuth -> Signature 'Ed25519
authOwnerSig = Signature 'Ed25519
sig}
          | PublicKeyEd25519
k PublicKeyEd25519 -> PublicKeyEd25519 -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== PublicKeyEd25519
rootKey = FilePath -> Either FilePath ()
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ()) -> FilePath -> Either FilePath ()
forall a b. (a -> b) -> a -> b
$ FilePath
"owner key for ID " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
idStr FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" matches root key"
          | (OwnerAuth -> SndQueueSecured) -> [OwnerAuth] -> SndQueueSecured
forall (t :: * -> *) a.
Foldable t =>
(a -> SndQueueSecured) -> t a -> SndQueueSecured
any OwnerAuth -> SndQueueSecured
duplicate [OwnerAuth]
prev = FilePath -> Either FilePath ()
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ()) -> FilePath -> Either FilePath ()
forall a b. (a -> b) -> a -> b
$ FilePath
"duplicate owner key or ID " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
idStr
          | PublicKeyEd25519 -> SndQueueSecured
signedBy PublicKeyEd25519
rootKey SndQueueSecured -> SndQueueSecured -> SndQueueSecured
|| (OwnerAuth -> SndQueueSecured) -> [OwnerAuth] -> SndQueueSecured
forall (t :: * -> *) a.
Foldable t =>
(a -> SndQueueSecured) -> t a -> SndQueueSecured
any (PublicKeyEd25519 -> SndQueueSecured
signedBy (PublicKeyEd25519 -> SndQueueSecured)
-> (OwnerAuth -> PublicKeyEd25519) -> OwnerAuth -> SndQueueSecured
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwnerAuth -> PublicKeyEd25519
ownerKey) [OwnerAuth]
prev = () -> Either FilePath ()
forall a b. b -> Either a b
Right ()
          | SndQueueSecured
otherwise = FilePath -> Either FilePath ()
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ()) -> FilePath -> Either FilePath ()
forall a b. (a -> b) -> a -> b
$ FilePath
"invalid authorization of owner ID " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
idStr
          where
            duplicate :: OwnerAuth -> SndQueueSecured
duplicate OwnerAuth {ConfirmationId
$sel:ownerId:OwnerAuth :: OwnerAuth -> ConfirmationId
ownerId :: ConfirmationId
ownerId, PublicKeyEd25519
$sel:ownerKey:OwnerAuth :: OwnerAuth -> PublicKeyEd25519
ownerKey :: PublicKeyEd25519
ownerKey} = ConfirmationId
oId ConfirmationId -> ConfirmationId -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== ConfirmationId
ownerId SndQueueSecured -> SndQueueSecured -> SndQueueSecured
|| PublicKeyEd25519
k PublicKeyEd25519 -> PublicKeyEd25519 -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== PublicKeyEd25519
ownerKey
            idStr :: FilePath
idStr = ConfirmationId -> FilePath
B.unpack (ConfirmationId -> FilePath) -> ConfirmationId -> FilePath
forall a b. (a -> b) -> a -> b
$ ConfirmationId -> ConfirmationId
B64.encodeUnpadded ConfirmationId
oId
            signedBy :: PublicKeyEd25519 -> SndQueueSecured
signedBy PublicKeyEd25519
k' = PublicKeyEd25519
-> Signature 'Ed25519 -> ConfirmationId -> SndQueueSecured
forall (a :: Algorithm).
SignatureAlgorithm a =>
PublicKey a -> Signature a -> ConfirmationId -> SndQueueSecured
C.verify' PublicKeyEd25519
k' Signature 'Ed25519
sig (ConfirmationId
oId ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> PublicKeyEd25519 -> ConfirmationId
forall k. CryptoPublicKey k => k -> ConfirmationId
C.encodePubKey PublicKeyEd25519
k)

instance ConnectionModeI c => Encoding (FixedLinkData c) where
  smpEncode :: FixedLinkData c -> ConfirmationId
smpEncode FixedLinkData {VersionRangeSMPA
$sel:agentVRange:FixedLinkData :: forall (c :: ConnectionMode). FixedLinkData c -> VersionRangeSMPA
agentVRange :: VersionRangeSMPA
agentVRange, PublicKeyEd25519
$sel:rootKey:FixedLinkData :: forall (c :: ConnectionMode). FixedLinkData c -> PublicKeyEd25519
rootKey :: PublicKeyEd25519
rootKey, ConnectionRequestUri c
$sel:linkConnReq:FixedLinkData :: forall (c :: ConnectionMode).
FixedLinkData c -> ConnectionRequestUri c
linkConnReq :: ConnectionRequestUri c
linkConnReq, Maybe ConfirmationId
$sel:linkEntityId:FixedLinkData :: forall (c :: ConnectionMode).
FixedLinkData c -> Maybe ConfirmationId
linkEntityId :: Maybe ConfirmationId
linkEntityId} =
    (VersionRangeSMPA, PublicKeyEd25519, ConnectionRequestUri c)
-> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (VersionRangeSMPA
agentVRange, PublicKeyEd25519
rootKey, ConnectionRequestUri c
linkConnReq) ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
-> (ConfirmationId -> ConfirmationId)
-> Maybe ConfirmationId
-> ConfirmationId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConfirmationId
"" ConfirmationId -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode Maybe ConfirmationId
linkEntityId
  smpP :: Parser (FixedLinkData c)
smpP = do
    (VersionRangeSMPA
agentVRange, PublicKeyEd25519
rootKey, ConnectionRequestUri c
linkConnReq) <- Parser (VersionRangeSMPA, PublicKeyEd25519, ConnectionRequestUri c)
forall a. Encoding a => Parser a
smpP
    Maybe ConfirmationId
linkEntityId <- Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId (Maybe ConfirmationId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ConfirmationId ConfirmationId
forall a. Encoding a => Parser a
smpP Parser ConfirmationId (Maybe ConfirmationId)
-> Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId (Maybe ConfirmationId)
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ConfirmationId ConfirmationId
A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
    FixedLinkData c -> Parser (FixedLinkData c)
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FixedLinkData {VersionRangeSMPA
$sel:agentVRange:FixedLinkData :: VersionRangeSMPA
agentVRange :: VersionRangeSMPA
agentVRange, PublicKeyEd25519
$sel:rootKey:FixedLinkData :: PublicKeyEd25519
rootKey :: PublicKeyEd25519
rootKey, ConnectionRequestUri c
$sel:linkConnReq:FixedLinkData :: ConnectionRequestUri c
linkConnReq :: ConnectionRequestUri c
linkConnReq, Maybe ConfirmationId
$sel:linkEntityId:FixedLinkData :: Maybe ConfirmationId
linkEntityId :: Maybe ConfirmationId
linkEntityId}

instance ConnectionModeI c => Encoding (ConnLinkData c) where
  smpEncode :: ConnLinkData c -> ConfirmationId
smpEncode = \case
    InvitationLinkData VersionRangeSMPA
vr UserLinkData
userData -> (ConnectionMode, VersionRangeSMPA, UserLinkData) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (ConnectionMode
CMInvitation, VersionRangeSMPA
vr, UserLinkData
userData)
    ContactLinkData VersionRangeSMPA
vr UserContactData
cd -> (ConnectionMode, VersionRangeSMPA, UserContactData)
-> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (ConnectionMode
CMContact, VersionRangeSMPA
vr, UserContactData
cd)
  smpP :: Parser (ConnLinkData c)
smpP = (\(ACLD SConnectionMode m
_ ConnLinkData m
d) -> ConnLinkData m -> Either FilePath (ConnLinkData c)
forall (t :: ConnectionMode -> *) (m :: ConnectionMode)
       (m' :: ConnectionMode).
(ConnectionModeI m, ConnectionModeI m') =>
t m' -> Either FilePath (t m)
checkConnMode ConnLinkData m
d) (AConnLinkData -> Either FilePath (ConnLinkData c))
-> Parser ConfirmationId AConnLinkData -> Parser (ConnLinkData c)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either FilePath b) -> m a -> m b
<$?> Parser ConfirmationId AConnLinkData
forall a. Encoding a => Parser a
smpP
  {-# INLINE smpP #-}

instance Encoding AConnLinkData where
  smpEncode :: AConnLinkData -> ConfirmationId
smpEncode (ACLD SConnectionMode m
_ ConnLinkData m
d) = ConnLinkData m -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode ConnLinkData m
d
  {-# INLINE smpEncode #-}
  smpP :: Parser ConfirmationId AConnLinkData
smpP =
    Parser ConnectionMode
forall a. Encoding a => Parser a
smpP Parser ConnectionMode
-> (ConnectionMode -> Parser ConfirmationId AConnLinkData)
-> Parser ConfirmationId AConnLinkData
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConnectionMode
CMInvitation -> do
        (VersionRangeSMPA
vr, UserLinkData
userData) <- Parser (VersionRangeSMPA, UserLinkData)
forall a. Encoding a => Parser a
smpP Parser (VersionRangeSMPA, UserLinkData)
-> Parser ConfirmationId ConfirmationId
-> Parser (VersionRangeSMPA, UserLinkData)
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ConfirmationId ConfirmationId
A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
        AConnLinkData -> Parser ConfirmationId AConnLinkData
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AConnLinkData -> Parser ConfirmationId AConnLinkData)
-> AConnLinkData -> Parser ConfirmationId AConnLinkData
forall a b. (a -> b) -> a -> b
$ SConnectionMode 'CMInvitation
-> ConnLinkData 'CMInvitation -> AConnLinkData
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> ConnLinkData m -> AConnLinkData
ACLD SConnectionMode 'CMInvitation
SCMInvitation (ConnLinkData 'CMInvitation -> AConnLinkData)
-> ConnLinkData 'CMInvitation -> AConnLinkData
forall a b. (a -> b) -> a -> b
$ VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation
InvitationLinkData VersionRangeSMPA
vr UserLinkData
userData
      ConnectionMode
CMContact -> do
        (VersionRangeSMPA
vr, UserContactData
cd) <- Parser (VersionRangeSMPA, UserContactData)
forall a. Encoding a => Parser a
smpP
        AConnLinkData -> Parser ConfirmationId AConnLinkData
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AConnLinkData -> Parser ConfirmationId AConnLinkData)
-> AConnLinkData -> Parser ConfirmationId AConnLinkData
forall a b. (a -> b) -> a -> b
$ SConnectionMode 'CMContact
-> ConnLinkData 'CMContact -> AConnLinkData
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> ConnLinkData m -> AConnLinkData
ACLD SConnectionMode 'CMContact
SCMContact (ConnLinkData 'CMContact -> AConnLinkData)
-> ConnLinkData 'CMContact -> AConnLinkData
forall a b. (a -> b) -> a -> b
$ VersionRangeSMPA -> UserContactData -> ConnLinkData 'CMContact
ContactLinkData VersionRangeSMPA
vr UserContactData
cd

instance ConnectionModeI c => Encoding (UserConnLinkData c) where
  smpEncode :: UserConnLinkData c -> ConfirmationId
smpEncode = \case
    UserInvLinkData UserLinkData
userData -> (ConnectionMode, UserLinkData) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (ConnectionMode
CMInvitation, UserLinkData
userData)
    UserContactLinkData UserContactData
cd -> (ConnectionMode, UserContactData) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (ConnectionMode
CMContact, UserContactData
cd)
  smpP :: Parser (UserConnLinkData c)
smpP = (\(AULD SConnectionMode m
_ UserConnLinkData m
d) -> UserConnLinkData m -> Either FilePath (UserConnLinkData c)
forall (t :: ConnectionMode -> *) (m :: ConnectionMode)
       (m' :: ConnectionMode).
(ConnectionModeI m, ConnectionModeI m') =>
t m' -> Either FilePath (t m)
checkConnMode UserConnLinkData m
d) (AUserConnLinkData -> Either FilePath (UserConnLinkData c))
-> Parser ConfirmationId AUserConnLinkData
-> Parser (UserConnLinkData c)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either FilePath b) -> m a -> m b
<$?> Parser ConfirmationId AUserConnLinkData
forall a. Encoding a => Parser a
smpP
  {-# INLINE smpP #-}

instance Encoding AUserConnLinkData where
  smpEncode :: AUserConnLinkData -> ConfirmationId
smpEncode (AULD SConnectionMode m
_ UserConnLinkData m
d) = UserConnLinkData m -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode UserConnLinkData m
d
  {-# INLINE smpEncode #-}
  smpP :: Parser ConfirmationId AUserConnLinkData
smpP =
    Parser ConnectionMode
forall a. Encoding a => Parser a
smpP Parser ConnectionMode
-> (ConnectionMode -> Parser ConfirmationId AUserConnLinkData)
-> Parser ConfirmationId AUserConnLinkData
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConnectionMode
CMInvitation -> do
        UserLinkData
userData <- Parser UserLinkData
forall a. Encoding a => Parser a
smpP Parser UserLinkData
-> Parser ConfirmationId ConfirmationId -> Parser UserLinkData
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ConfirmationId ConfirmationId
A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
        AUserConnLinkData -> Parser ConfirmationId AUserConnLinkData
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AUserConnLinkData -> Parser ConfirmationId AUserConnLinkData)
-> AUserConnLinkData -> Parser ConfirmationId AUserConnLinkData
forall a b. (a -> b) -> a -> b
$ SConnectionMode 'CMInvitation
-> UserConnLinkData 'CMInvitation -> AUserConnLinkData
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> UserConnLinkData m -> AUserConnLinkData
AULD SConnectionMode 'CMInvitation
SCMInvitation (UserConnLinkData 'CMInvitation -> AUserConnLinkData)
-> UserConnLinkData 'CMInvitation -> AUserConnLinkData
forall a b. (a -> b) -> a -> b
$ UserLinkData -> UserConnLinkData 'CMInvitation
UserInvLinkData UserLinkData
userData
      ConnectionMode
CMContact ->
        SConnectionMode 'CMContact
-> UserConnLinkData 'CMContact -> AUserConnLinkData
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> UserConnLinkData m -> AUserConnLinkData
AULD SConnectionMode 'CMContact
SCMContact (UserConnLinkData 'CMContact -> AUserConnLinkData)
-> (UserContactData -> UserConnLinkData 'CMContact)
-> UserContactData
-> AUserConnLinkData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserContactData -> UserConnLinkData 'CMContact
UserContactLinkData (UserContactData -> AUserConnLinkData)
-> Parser ConfirmationId UserContactData
-> Parser ConfirmationId AUserConnLinkData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId UserContactData
forall a. Encoding a => Parser a
smpP

instance ConnectionModeI c => StrEncoding (UserConnLinkData c) where
  strEncode :: UserConnLinkData c -> ConfirmationId
strEncode = UserConnLinkData c -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode
  {-# INLINE strEncode #-}
  strP :: Parser (UserConnLinkData c)
strP = Parser (UserConnLinkData c)
forall a. Encoding a => Parser a
smpP
  {-# INLINE strP #-}

instance Encoding UserContactData where
  smpEncode :: UserContactData -> ConfirmationId
smpEncode UserContactData {SndQueueSecured
$sel:direct:UserContactData :: UserContactData -> SndQueueSecured
direct :: SndQueueSecured
direct, [OwnerAuth]
$sel:owners:UserContactData :: UserContactData -> [OwnerAuth]
owners :: [OwnerAuth]
owners, [ConnShortLink 'CMContact]
$sel:relays:UserContactData :: UserContactData -> [ConnShortLink 'CMContact]
relays :: [ConnShortLink 'CMContact]
relays, UserLinkData
$sel:userData:UserContactData :: UserContactData -> UserLinkData
userData :: UserLinkData
userData} =
    [ConfirmationId] -> ConfirmationId
B.concat [SndQueueSecured -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode SndQueueSecured
direct, [OwnerAuth] -> ConfirmationId
forall a. Encoding a => [a] -> ConfirmationId
smpEncodeList [OwnerAuth]
owners, [ConnShortLink 'CMContact] -> ConfirmationId
forall a. Encoding a => [a] -> ConfirmationId
smpEncodeList [ConnShortLink 'CMContact]
relays, UserLinkData -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode UserLinkData
userData]
  smpP :: Parser ConfirmationId UserContactData
smpP = do
    SndQueueSecured
direct <- Parser ConfirmationId SndQueueSecured
forall a. Encoding a => Parser a
smpP
    [OwnerAuth]
owners <- Parser [OwnerAuth]
forall a. Encoding a => Parser [a]
smpListP
    [ConnShortLink 'CMContact]
relays <- Parser [ConnShortLink 'CMContact]
forall a. Encoding a => Parser [a]
smpListP
    UserLinkData
userData <- Parser UserLinkData
forall a. Encoding a => Parser a
smpP Parser UserLinkData
-> Parser ConfirmationId ConfirmationId -> Parser UserLinkData
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ConfirmationId ConfirmationId
A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
    UserContactData -> Parser ConfirmationId UserContactData
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserContactData {SndQueueSecured
$sel:direct:UserContactData :: SndQueueSecured
direct :: SndQueueSecured
direct, [OwnerAuth]
$sel:owners:UserContactData :: [OwnerAuth]
owners :: [OwnerAuth]
owners, [ConnShortLink 'CMContact]
$sel:relays:UserContactData :: [ConnShortLink 'CMContact]
relays :: [ConnShortLink 'CMContact]
relays, UserLinkData
$sel:userData:UserContactData :: UserLinkData
userData :: UserLinkData
userData}

instance Encoding UserLinkData where
  smpEncode :: UserLinkData -> ConfirmationId
smpEncode (UserLinkData ConfirmationId
s) = if ConfirmationId -> Int
B.length ConfirmationId
s Int -> Int -> SndQueueSecured
forall a. Ord a => a -> a -> SndQueueSecured
<= Int
254 then ConfirmationId -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode ConfirmationId
s else (Char, Large) -> ConfirmationId
forall a. Encoding a => a -> ConfirmationId
smpEncode (Char
'\255', ConfirmationId -> Large
Large ConfirmationId
s)
  {-# INLINE smpEncode #-}
  smpP :: Parser UserLinkData
smpP = ConfirmationId -> UserLinkData
UserLinkData (ConfirmationId -> UserLinkData)
-> Parser ConfirmationId ConfirmationId -> Parser UserLinkData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Parser Char
A.char Char
'\255' Parser Char
-> Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId ConfirmationId
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Large -> ConfirmationId
unLarge (Large -> ConfirmationId)
-> Parser ConfirmationId Large
-> Parser ConfirmationId ConfirmationId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId Large
forall a. Encoding a => Parser a
smpP)) Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId ConfirmationId
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ConfirmationId ConfirmationId
forall a. Encoding a => Parser a
smpP)
  {-# INLINE smpP #-}

data StoredClientService (s :: DBStored) = ClientService
  { forall (s :: DBStored). StoredClientService s -> DBEntityId' s
dbServiceId :: DBEntityId' s,
    forall (s :: DBStored). StoredClientService s -> LinkId
serviceId :: SMP.ServiceId
  }
  deriving (StoredClientService s -> StoredClientService s -> SndQueueSecured
(StoredClientService s -> StoredClientService s -> SndQueueSecured)
-> (StoredClientService s
    -> StoredClientService s -> SndQueueSecured)
-> Eq (StoredClientService s)
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
forall (s :: DBStored).
StoredClientService s -> StoredClientService s -> SndQueueSecured
$c== :: forall (s :: DBStored).
StoredClientService s -> StoredClientService s -> SndQueueSecured
== :: StoredClientService s -> StoredClientService s -> SndQueueSecured
$c/= :: forall (s :: DBStored).
StoredClientService s -> StoredClientService s -> SndQueueSecured
/= :: StoredClientService s -> StoredClientService s -> SndQueueSecured
Eq, Int -> StoredClientService s -> ShowS
[StoredClientService s] -> ShowS
StoredClientService s -> FilePath
(Int -> StoredClientService s -> ShowS)
-> (StoredClientService s -> FilePath)
-> ([StoredClientService s] -> ShowS)
-> Show (StoredClientService s)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall (s :: DBStored). Int -> StoredClientService s -> ShowS
forall (s :: DBStored). [StoredClientService s] -> ShowS
forall (s :: DBStored). StoredClientService s -> FilePath
$cshowsPrec :: forall (s :: DBStored). Int -> StoredClientService s -> ShowS
showsPrec :: Int -> StoredClientService s -> ShowS
$cshow :: forall (s :: DBStored). StoredClientService s -> FilePath
show :: StoredClientService s -> FilePath
$cshowList :: forall (s :: DBStored). [StoredClientService s] -> ShowS
showList :: [StoredClientService s] -> ShowS
Show)

type ClientService = StoredClientService 'DBStored

type ClientServiceId = DBEntityId

-- | SMP queue status.
data QueueStatus
  = -- | queue is created
    New
  | -- | queue is confirmed by the sender
    Confirmed
  | -- | queue is secured with sender key (only used by the queue recipient)
    Secured
  | -- | queue is active
    Active
  | -- | queue is disabled (only used by the queue recipient)
    Disabled
  deriving (QueueStatus -> QueueStatus -> SndQueueSecured
(QueueStatus -> QueueStatus -> SndQueueSecured)
-> (QueueStatus -> QueueStatus -> SndQueueSecured)
-> Eq QueueStatus
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: QueueStatus -> QueueStatus -> SndQueueSecured
== :: QueueStatus -> QueueStatus -> SndQueueSecured
$c/= :: QueueStatus -> QueueStatus -> SndQueueSecured
/= :: QueueStatus -> QueueStatus -> SndQueueSecured
Eq, Int -> QueueStatus -> ShowS
[QueueStatus] -> ShowS
QueueStatus -> FilePath
(Int -> QueueStatus -> ShowS)
-> (QueueStatus -> FilePath)
-> ([QueueStatus] -> ShowS)
-> Show QueueStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueueStatus -> ShowS
showsPrec :: Int -> QueueStatus -> ShowS
$cshow :: QueueStatus -> FilePath
show :: QueueStatus -> FilePath
$cshowList :: [QueueStatus] -> ShowS
showList :: [QueueStatus] -> ShowS
Show, ReadPrec [QueueStatus]
ReadPrec QueueStatus
Int -> ReadS QueueStatus
ReadS [QueueStatus]
(Int -> ReadS QueueStatus)
-> ReadS [QueueStatus]
-> ReadPrec QueueStatus
-> ReadPrec [QueueStatus]
-> Read QueueStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS QueueStatus
readsPrec :: Int -> ReadS QueueStatus
$creadList :: ReadS [QueueStatus]
readList :: ReadS [QueueStatus]
$creadPrec :: ReadPrec QueueStatus
readPrec :: ReadPrec QueueStatus
$creadListPrec :: ReadPrec [QueueStatus]
readListPrec :: ReadPrec [QueueStatus]
Read)

serializeQueueStatus :: QueueStatus -> Text
serializeQueueStatus :: QueueStatus -> CRClientData
serializeQueueStatus = \case
  QueueStatus
New -> CRClientData
"new"
  QueueStatus
Confirmed -> CRClientData
"confirmed"
  QueueStatus
Secured -> CRClientData
"secured"
  QueueStatus
Active -> CRClientData
"active"
  QueueStatus
Disabled -> CRClientData
"disabled"

queueStatusT :: Text -> Maybe QueueStatus
queueStatusT :: CRClientData -> Maybe QueueStatus
queueStatusT = \case
  CRClientData
"new" -> QueueStatus -> Maybe QueueStatus
forall a. a -> Maybe a
Just QueueStatus
New
  CRClientData
"confirmed" -> QueueStatus -> Maybe QueueStatus
forall a. a -> Maybe a
Just QueueStatus
Confirmed
  CRClientData
"secured" -> QueueStatus -> Maybe QueueStatus
forall a. a -> Maybe a
Just QueueStatus
Secured
  CRClientData
"active" -> QueueStatus -> Maybe QueueStatus
forall a. a -> Maybe a
Just QueueStatus
Active
  CRClientData
"disabled" -> QueueStatus -> Maybe QueueStatus
forall a. a -> Maybe a
Just QueueStatus
Disabled
  CRClientData
_ -> Maybe QueueStatus
forall a. Maybe a
Nothing

type AgentMsgId = Int64

-- | Result of received message integrity validation.
data MsgIntegrity = MsgOk | MsgError {MsgIntegrity -> MsgErrorType
errorInfo :: MsgErrorType}
  deriving (MsgIntegrity -> MsgIntegrity -> SndQueueSecured
(MsgIntegrity -> MsgIntegrity -> SndQueueSecured)
-> (MsgIntegrity -> MsgIntegrity -> SndQueueSecured)
-> Eq MsgIntegrity
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: MsgIntegrity -> MsgIntegrity -> SndQueueSecured
== :: MsgIntegrity -> MsgIntegrity -> SndQueueSecured
$c/= :: MsgIntegrity -> MsgIntegrity -> SndQueueSecured
/= :: MsgIntegrity -> MsgIntegrity -> SndQueueSecured
Eq, Int -> MsgIntegrity -> ShowS
[MsgIntegrity] -> ShowS
MsgIntegrity -> FilePath
(Int -> MsgIntegrity -> ShowS)
-> (MsgIntegrity -> FilePath)
-> ([MsgIntegrity] -> ShowS)
-> Show MsgIntegrity
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgIntegrity -> ShowS
showsPrec :: Int -> MsgIntegrity -> ShowS
$cshow :: MsgIntegrity -> FilePath
show :: MsgIntegrity -> FilePath
$cshowList :: [MsgIntegrity] -> ShowS
showList :: [MsgIntegrity] -> ShowS
Show)

instance StrEncoding MsgIntegrity where
  strP :: Parser MsgIntegrity
strP = Parser ConfirmationId ConfirmationId
"OK" Parser ConfirmationId ConfirmationId
-> MsgIntegrity -> Parser MsgIntegrity
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MsgIntegrity
MsgOk Parser MsgIntegrity -> Parser MsgIntegrity -> Parser MsgIntegrity
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ConfirmationId ConfirmationId
"ERR " Parser ConfirmationId ConfirmationId
-> Parser MsgIntegrity -> Parser MsgIntegrity
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (MsgErrorType -> MsgIntegrity
MsgError (MsgErrorType -> MsgIntegrity)
-> Parser ConfirmationId MsgErrorType -> Parser MsgIntegrity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId MsgErrorType
forall a. StrEncoding a => Parser a
strP)
  strEncode :: MsgIntegrity -> ConfirmationId
strEncode = \case
    MsgIntegrity
MsgOk -> ConfirmationId
"OK"
    MsgError MsgErrorType
e -> ConfirmationId
"ERR " ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> MsgErrorType -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode MsgErrorType
e

-- | Error of message integrity validation.
data MsgErrorType
  = MsgSkipped {MsgErrorType -> AgentMsgId
fromMsgId :: AgentMsgId, MsgErrorType -> AgentMsgId
toMsgId :: AgentMsgId}
  | MsgBadId {MsgErrorType -> AgentMsgId
msgId :: AgentMsgId}
  | MsgBadHash
  | MsgDuplicate
  deriving (MsgErrorType -> MsgErrorType -> SndQueueSecured
(MsgErrorType -> MsgErrorType -> SndQueueSecured)
-> (MsgErrorType -> MsgErrorType -> SndQueueSecured)
-> Eq MsgErrorType
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: MsgErrorType -> MsgErrorType -> SndQueueSecured
== :: MsgErrorType -> MsgErrorType -> SndQueueSecured
$c/= :: MsgErrorType -> MsgErrorType -> SndQueueSecured
/= :: MsgErrorType -> MsgErrorType -> SndQueueSecured
Eq, Int -> MsgErrorType -> ShowS
[MsgErrorType] -> ShowS
MsgErrorType -> FilePath
(Int -> MsgErrorType -> ShowS)
-> (MsgErrorType -> FilePath)
-> ([MsgErrorType] -> ShowS)
-> Show MsgErrorType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgErrorType -> ShowS
showsPrec :: Int -> MsgErrorType -> ShowS
$cshow :: MsgErrorType -> FilePath
show :: MsgErrorType -> FilePath
$cshowList :: [MsgErrorType] -> ShowS
showList :: [MsgErrorType] -> ShowS
Show)

instance StrEncoding MsgErrorType where
  strP :: Parser ConfirmationId MsgErrorType
strP =
    Parser ConfirmationId ConfirmationId
"ID " Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId MsgErrorType
-> Parser ConfirmationId MsgErrorType
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AgentMsgId -> MsgErrorType
MsgBadId (AgentMsgId -> MsgErrorType)
-> Parser ConfirmationId AgentMsgId
-> Parser ConfirmationId MsgErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId AgentMsgId
forall a. Integral a => Parser a
A.decimal)
      Parser ConfirmationId MsgErrorType
-> Parser ConfirmationId MsgErrorType
-> Parser ConfirmationId MsgErrorType
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ConfirmationId ConfirmationId
"NO_ID " Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId MsgErrorType
-> Parser ConfirmationId MsgErrorType
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AgentMsgId -> AgentMsgId -> MsgErrorType
MsgSkipped (AgentMsgId -> AgentMsgId -> MsgErrorType)
-> Parser ConfirmationId AgentMsgId
-> Parser ConfirmationId (AgentMsgId -> MsgErrorType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId AgentMsgId
forall a. Integral a => Parser a
A.decimal Parser ConfirmationId (AgentMsgId -> MsgErrorType)
-> Parser Char
-> Parser ConfirmationId (AgentMsgId -> MsgErrorType)
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
A.space Parser ConfirmationId (AgentMsgId -> MsgErrorType)
-> Parser ConfirmationId AgentMsgId
-> Parser ConfirmationId MsgErrorType
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfirmationId AgentMsgId
forall a. Integral a => Parser a
A.decimal)
      Parser ConfirmationId MsgErrorType
-> Parser ConfirmationId MsgErrorType
-> Parser ConfirmationId MsgErrorType
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ConfirmationId ConfirmationId
"HASH" Parser ConfirmationId ConfirmationId
-> MsgErrorType -> Parser ConfirmationId MsgErrorType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MsgErrorType
MsgBadHash
      Parser ConfirmationId MsgErrorType
-> Parser ConfirmationId MsgErrorType
-> Parser ConfirmationId MsgErrorType
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ConfirmationId ConfirmationId
"DUPLICATE" Parser ConfirmationId ConfirmationId
-> MsgErrorType -> Parser ConfirmationId MsgErrorType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MsgErrorType
MsgDuplicate
  strEncode :: MsgErrorType -> ConfirmationId
strEncode = \case
    MsgSkipped AgentMsgId
fromMsgId AgentMsgId
toMsgId ->
      [ConfirmationId] -> ConfirmationId
B.unwords [ConfirmationId
Item [ConfirmationId]
"NO_ID", AgentMsgId -> ConfirmationId
forall a. Show a => a -> ConfirmationId
bshow AgentMsgId
fromMsgId, AgentMsgId -> ConfirmationId
forall a. Show a => a -> ConfirmationId
bshow AgentMsgId
toMsgId]
    MsgBadId AgentMsgId
aMsgId -> ConfirmationId
"ID " ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> AgentMsgId -> ConfirmationId
forall a. Show a => a -> ConfirmationId
bshow AgentMsgId
aMsgId
    MsgErrorType
MsgBadHash -> ConfirmationId
"HASH"
    MsgErrorType
MsgDuplicate -> ConfirmationId
"DUPLICATE"

-- | Error type used in errors sent to agent clients.
data AgentErrorType
  = -- | command or response error
    CMD {AgentErrorType -> CommandErrorType
cmdErr :: CommandErrorType, AgentErrorType -> FilePath
errContext :: String}
  | -- | connection errors
    CONN {AgentErrorType -> ConnectionErrorType
connErr :: ConnectionErrorType, errContext :: String}
  | -- | user not found in database
    NO_USER
  | -- | SMP protocol errors forwarded to agent clients
    SMP {AgentErrorType -> FilePath
serverAddress :: String, AgentErrorType -> ErrorType
smpErr :: ErrorType}
  | -- | NTF protocol errors forwarded to agent clients
    NTF {serverAddress :: String, AgentErrorType -> ErrorType
ntfErr :: ErrorType}
  | -- | XFTP protocol errors forwarded to agent clients
    XFTP {serverAddress :: String, AgentErrorType -> XFTPErrorType
xftpErr :: XFTPErrorType}
  | -- | XFTP agent errors
    FILE {AgentErrorType -> FileErrorType
fileErr :: FileErrorType}
  | -- | SMP proxy errors
    PROXY {AgentErrorType -> FilePath
proxyServer :: String, AgentErrorType -> FilePath
relayServer :: String, AgentErrorType -> ProxyClientError
proxyErr :: ProxyClientError}
  | -- | XRCP protocol errors forwarded to agent clients
    RCP {AgentErrorType -> RCErrorType
rcpErr :: RCErrorType}
  | -- | SMP server errors
    BROKER {AgentErrorType -> FilePath
brokerAddress :: String, AgentErrorType -> BrokerErrorType
brokerErr :: BrokerErrorType}
  | -- | errors of other agents
    AGENT {AgentErrorType -> SMPAgentError
agentErr :: SMPAgentError}
  | -- | client notice
    NOTICE {AgentErrorType -> CRClientData
server :: Text, AgentErrorType -> SndQueueSecured
preset :: Bool, AgentErrorType -> Maybe UTCTime
expiresAt :: Maybe UTCTime}
  | -- | agent implementation or dependency errors
    INTERNAL {AgentErrorType -> FilePath
internalErr :: String}
  | -- | critical agent errors that should be shown to the user, optionally with restart button
    CRITICAL {AgentErrorType -> SndQueueSecured
offerRestart :: Bool, AgentErrorType -> FilePath
criticalErr :: String}
  | -- | agent inactive
    INACTIVE
  deriving (AgentErrorType -> AgentErrorType -> SndQueueSecured
(AgentErrorType -> AgentErrorType -> SndQueueSecured)
-> (AgentErrorType -> AgentErrorType -> SndQueueSecured)
-> Eq AgentErrorType
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: AgentErrorType -> AgentErrorType -> SndQueueSecured
== :: AgentErrorType -> AgentErrorType -> SndQueueSecured
$c/= :: AgentErrorType -> AgentErrorType -> SndQueueSecured
/= :: AgentErrorType -> AgentErrorType -> SndQueueSecured
Eq, Int -> AgentErrorType -> ShowS
[AgentErrorType] -> ShowS
AgentErrorType -> FilePath
(Int -> AgentErrorType -> ShowS)
-> (AgentErrorType -> FilePath)
-> ([AgentErrorType] -> ShowS)
-> Show AgentErrorType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgentErrorType -> ShowS
showsPrec :: Int -> AgentErrorType -> ShowS
$cshow :: AgentErrorType -> FilePath
show :: AgentErrorType -> FilePath
$cshowList :: [AgentErrorType] -> ShowS
showList :: [AgentErrorType] -> ShowS
Show, Show AgentErrorType
Typeable AgentErrorType
(Typeable AgentErrorType, Show AgentErrorType) =>
(AgentErrorType -> SomeException)
-> (SomeException -> Maybe AgentErrorType)
-> (AgentErrorType -> FilePath)
-> Exception AgentErrorType
SomeException -> Maybe AgentErrorType
AgentErrorType -> FilePath
AgentErrorType -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> FilePath) -> Exception e
$ctoException :: AgentErrorType -> SomeException
toException :: AgentErrorType -> SomeException
$cfromException :: SomeException -> Maybe AgentErrorType
fromException :: SomeException -> Maybe AgentErrorType
$cdisplayException :: AgentErrorType -> FilePath
displayException :: AgentErrorType -> FilePath
Exception)

instance AnyError AgentErrorType where
  fromSomeException :: SomeException -> AgentErrorType
fromSomeException SomeException
e = case SomeException -> Maybe BlockedIndefinitelyOnSTM
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
    Just BlockedIndefinitelyOnSTM
BlockedIndefinitelyOnSTM -> SndQueueSecured -> FilePath -> AgentErrorType
CRITICAL SndQueueSecured
True FilePath
"Thread blocked indefinitely in STM transaction"
    Maybe BlockedIndefinitelyOnSTM
_ -> case SomeException -> Maybe BlockedIndefinitelyOnMVar
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
      Just BlockedIndefinitelyOnMVar
BlockedIndefinitelyOnMVar -> SndQueueSecured -> FilePath -> AgentErrorType
CRITICAL SndQueueSecured
True FilePath
"Thread blocked indefinitely on MVar"
      Maybe BlockedIndefinitelyOnMVar
_ -> FilePath -> AgentErrorType
INTERNAL (FilePath -> AgentErrorType) -> FilePath -> AgentErrorType
forall a b. (a -> b) -> a -> b
$ SomeException -> FilePath
forall a. Show a => a -> FilePath
show SomeException
e
  {-# INLINE fromSomeException #-}

-- | SMP agent protocol command or response error.
data CommandErrorType
  = -- | command is prohibited in this context
    PROHIBITED
  | -- | command syntax is invalid
    SYNTAX
  | -- | entity ID is required with this command
    NO_CONN
  | -- | message size is not correct (no terminating space)
    SIZE
  | -- | message does not fit in SMP block
    LARGE
  deriving (CommandErrorType -> CommandErrorType -> SndQueueSecured
(CommandErrorType -> CommandErrorType -> SndQueueSecured)
-> (CommandErrorType -> CommandErrorType -> SndQueueSecured)
-> Eq CommandErrorType
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: CommandErrorType -> CommandErrorType -> SndQueueSecured
== :: CommandErrorType -> CommandErrorType -> SndQueueSecured
$c/= :: CommandErrorType -> CommandErrorType -> SndQueueSecured
/= :: CommandErrorType -> CommandErrorType -> SndQueueSecured
Eq, ReadPrec [CommandErrorType]
ReadPrec CommandErrorType
Int -> ReadS CommandErrorType
ReadS [CommandErrorType]
(Int -> ReadS CommandErrorType)
-> ReadS [CommandErrorType]
-> ReadPrec CommandErrorType
-> ReadPrec [CommandErrorType]
-> Read CommandErrorType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CommandErrorType
readsPrec :: Int -> ReadS CommandErrorType
$creadList :: ReadS [CommandErrorType]
readList :: ReadS [CommandErrorType]
$creadPrec :: ReadPrec CommandErrorType
readPrec :: ReadPrec CommandErrorType
$creadListPrec :: ReadPrec [CommandErrorType]
readListPrec :: ReadPrec [CommandErrorType]
Read, Int -> CommandErrorType -> ShowS
[CommandErrorType] -> ShowS
CommandErrorType -> FilePath
(Int -> CommandErrorType -> ShowS)
-> (CommandErrorType -> FilePath)
-> ([CommandErrorType] -> ShowS)
-> Show CommandErrorType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandErrorType -> ShowS
showsPrec :: Int -> CommandErrorType -> ShowS
$cshow :: CommandErrorType -> FilePath
show :: CommandErrorType -> FilePath
$cshowList :: [CommandErrorType] -> ShowS
showList :: [CommandErrorType] -> ShowS
Show, Show CommandErrorType
Typeable CommandErrorType
(Typeable CommandErrorType, Show CommandErrorType) =>
(CommandErrorType -> SomeException)
-> (SomeException -> Maybe CommandErrorType)
-> (CommandErrorType -> FilePath)
-> Exception CommandErrorType
SomeException -> Maybe CommandErrorType
CommandErrorType -> FilePath
CommandErrorType -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> FilePath) -> Exception e
$ctoException :: CommandErrorType -> SomeException
toException :: CommandErrorType -> SomeException
$cfromException :: SomeException -> Maybe CommandErrorType
fromException :: SomeException -> Maybe CommandErrorType
$cdisplayException :: CommandErrorType -> FilePath
displayException :: CommandErrorType -> FilePath
Exception)

-- | Connection error.
data ConnectionErrorType
  = -- | connection is not in the database
    NOT_FOUND
  | -- | connection already exists
    DUPLICATE
  | -- | connection is simplex, but operation requires another queue
    SIMPLEX
  | -- | connection not accepted on join HELLO after timeout
    NOT_ACCEPTED
  | -- | connection not available on reply confirmation/HELLO after timeout
    NOT_AVAILABLE
  deriving (ConnectionErrorType -> ConnectionErrorType -> SndQueueSecured
(ConnectionErrorType -> ConnectionErrorType -> SndQueueSecured)
-> (ConnectionErrorType -> ConnectionErrorType -> SndQueueSecured)
-> Eq ConnectionErrorType
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: ConnectionErrorType -> ConnectionErrorType -> SndQueueSecured
== :: ConnectionErrorType -> ConnectionErrorType -> SndQueueSecured
$c/= :: ConnectionErrorType -> ConnectionErrorType -> SndQueueSecured
/= :: ConnectionErrorType -> ConnectionErrorType -> SndQueueSecured
Eq, ReadPrec [ConnectionErrorType]
ReadPrec ConnectionErrorType
Int -> ReadS ConnectionErrorType
ReadS [ConnectionErrorType]
(Int -> ReadS ConnectionErrorType)
-> ReadS [ConnectionErrorType]
-> ReadPrec ConnectionErrorType
-> ReadPrec [ConnectionErrorType]
-> Read ConnectionErrorType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ConnectionErrorType
readsPrec :: Int -> ReadS ConnectionErrorType
$creadList :: ReadS [ConnectionErrorType]
readList :: ReadS [ConnectionErrorType]
$creadPrec :: ReadPrec ConnectionErrorType
readPrec :: ReadPrec ConnectionErrorType
$creadListPrec :: ReadPrec [ConnectionErrorType]
readListPrec :: ReadPrec [ConnectionErrorType]
Read, Int -> ConnectionErrorType -> ShowS
[ConnectionErrorType] -> ShowS
ConnectionErrorType -> FilePath
(Int -> ConnectionErrorType -> ShowS)
-> (ConnectionErrorType -> FilePath)
-> ([ConnectionErrorType] -> ShowS)
-> Show ConnectionErrorType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionErrorType -> ShowS
showsPrec :: Int -> ConnectionErrorType -> ShowS
$cshow :: ConnectionErrorType -> FilePath
show :: ConnectionErrorType -> FilePath
$cshowList :: [ConnectionErrorType] -> ShowS
showList :: [ConnectionErrorType] -> ShowS
Show, Show ConnectionErrorType
Typeable ConnectionErrorType
(Typeable ConnectionErrorType, Show ConnectionErrorType) =>
(ConnectionErrorType -> SomeException)
-> (SomeException -> Maybe ConnectionErrorType)
-> (ConnectionErrorType -> FilePath)
-> Exception ConnectionErrorType
SomeException -> Maybe ConnectionErrorType
ConnectionErrorType -> FilePath
ConnectionErrorType -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> FilePath) -> Exception e
$ctoException :: ConnectionErrorType -> SomeException
toException :: ConnectionErrorType -> SomeException
$cfromException :: SomeException -> Maybe ConnectionErrorType
fromException :: SomeException -> Maybe ConnectionErrorType
$cdisplayException :: ConnectionErrorType -> FilePath
displayException :: ConnectionErrorType -> FilePath
Exception)

-- | Errors of another SMP agent.
data SMPAgentError
  = -- | client or agent message that failed to parse
    A_MESSAGE
  | -- | prohibited SMP/agent message
    A_PROHIBITED {SMPAgentError -> FilePath
prohibitedErr :: String}
  | -- | incompatible version of SMP client, agent or encryption protocols
    A_VERSION
  | -- | failed signature, hash or senderId verification of retrieved link data
    A_LINK {SMPAgentError -> FilePath
linkErr :: String}
  | -- | cannot decrypt message
    A_CRYPTO {SMPAgentError -> AgentCryptoError
cryptoErr :: AgentCryptoError}
  | -- | duplicate message - this error is detected by ratchet decryption - this message will be ignored and not shown.
    -- it may also indicate a loss of ratchet synchronization (when only one message is sent via copied ratchet).
    -- when message is dropped after too many reception attempts, DroppedMsg is included.
    A_DUPLICATE {SMPAgentError -> Maybe DroppedMsg
droppedMsg_ :: Maybe DroppedMsg}
  | -- | error in the message to add/delete/etc queue in connection
    A_QUEUE {SMPAgentError -> FilePath
queueErr :: String}
  deriving (SMPAgentError -> SMPAgentError -> SndQueueSecured
(SMPAgentError -> SMPAgentError -> SndQueueSecured)
-> (SMPAgentError -> SMPAgentError -> SndQueueSecured)
-> Eq SMPAgentError
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: SMPAgentError -> SMPAgentError -> SndQueueSecured
== :: SMPAgentError -> SMPAgentError -> SndQueueSecured
$c/= :: SMPAgentError -> SMPAgentError -> SndQueueSecured
/= :: SMPAgentError -> SMPAgentError -> SndQueueSecured
Eq, Int -> SMPAgentError -> ShowS
[SMPAgentError] -> ShowS
SMPAgentError -> FilePath
(Int -> SMPAgentError -> ShowS)
-> (SMPAgentError -> FilePath)
-> ([SMPAgentError] -> ShowS)
-> Show SMPAgentError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SMPAgentError -> ShowS
showsPrec :: Int -> SMPAgentError -> ShowS
$cshow :: SMPAgentError -> FilePath
show :: SMPAgentError -> FilePath
$cshowList :: [SMPAgentError] -> ShowS
showList :: [SMPAgentError] -> ShowS
Show, Show SMPAgentError
Typeable SMPAgentError
(Typeable SMPAgentError, Show SMPAgentError) =>
(SMPAgentError -> SomeException)
-> (SomeException -> Maybe SMPAgentError)
-> (SMPAgentError -> FilePath)
-> Exception SMPAgentError
SomeException -> Maybe SMPAgentError
SMPAgentError -> FilePath
SMPAgentError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> FilePath) -> Exception e
$ctoException :: SMPAgentError -> SomeException
toException :: SMPAgentError -> SomeException
$cfromException :: SomeException -> Maybe SMPAgentError
fromException :: SomeException -> Maybe SMPAgentError
$cdisplayException :: SMPAgentError -> FilePath
displayException :: SMPAgentError -> FilePath
Exception)

data AgentCryptoError
  = -- | AES decryption error
    DECRYPT_AES
  | -- CryptoBox decryption error
    DECRYPT_CB
  | -- | can't decrypt ratchet header, possibly ratchet out of sync due to device change
    RATCHET_HEADER
  | -- | earlier message number (or, possibly, skipped message that failed to decrypt?)
    RATCHET_EARLIER Word32
  | -- | too many skipped messages
    RATCHET_SKIPPED Word32
  | -- | ratchet synchronization error
    RATCHET_SYNC
  deriving (AgentCryptoError -> AgentCryptoError -> SndQueueSecured
(AgentCryptoError -> AgentCryptoError -> SndQueueSecured)
-> (AgentCryptoError -> AgentCryptoError -> SndQueueSecured)
-> Eq AgentCryptoError
forall a.
(a -> a -> SndQueueSecured) -> (a -> a -> SndQueueSecured) -> Eq a
$c== :: AgentCryptoError -> AgentCryptoError -> SndQueueSecured
== :: AgentCryptoError -> AgentCryptoError -> SndQueueSecured
$c/= :: AgentCryptoError -> AgentCryptoError -> SndQueueSecured
/= :: AgentCryptoError -> AgentCryptoError -> SndQueueSecured
Eq, ReadPrec [AgentCryptoError]
ReadPrec AgentCryptoError
Int -> ReadS AgentCryptoError
ReadS [AgentCryptoError]
(Int -> ReadS AgentCryptoError)
-> ReadS [AgentCryptoError]
-> ReadPrec AgentCryptoError
-> ReadPrec [AgentCryptoError]
-> Read AgentCryptoError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AgentCryptoError
readsPrec :: Int -> ReadS AgentCryptoError
$creadList :: ReadS [AgentCryptoError]
readList :: ReadS [AgentCryptoError]
$creadPrec :: ReadPrec AgentCryptoError
readPrec :: ReadPrec AgentCryptoError
$creadListPrec :: ReadPrec [AgentCryptoError]
readListPrec :: ReadPrec [AgentCryptoError]
Read, Int -> AgentCryptoError -> ShowS
[AgentCryptoError] -> ShowS
AgentCryptoError -> FilePath
(Int -> AgentCryptoError -> ShowS)
-> (AgentCryptoError -> FilePath)
-> ([AgentCryptoError] -> ShowS)
-> Show AgentCryptoError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgentCryptoError -> ShowS
showsPrec :: Int -> AgentCryptoError -> ShowS
$cshow :: AgentCryptoError -> FilePath
show :: AgentCryptoError -> FilePath
$cshowList :: [AgentCryptoError] -> ShowS
showList :: [AgentCryptoError] -> ShowS
Show, Show AgentCryptoError
Typeable AgentCryptoError
(Typeable AgentCryptoError, Show AgentCryptoError) =>
(AgentCryptoError -> SomeException)
-> (SomeException -> Maybe AgentCryptoError)
-> (AgentCryptoError -> FilePath)
-> Exception AgentCryptoError
SomeException -> Maybe AgentCryptoError
AgentCryptoError -> FilePath
AgentCryptoError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> FilePath) -> Exception e
$ctoException :: AgentCryptoError -> SomeException
toException :: AgentCryptoError -> SomeException
$cfromException :: SomeException -> Maybe AgentCryptoError
fromException :: SomeException -> Maybe AgentCryptoError
$cdisplayException :: AgentCryptoError -> FilePath
displayException :: AgentCryptoError -> FilePath
Exception)

cryptoErrToSyncState :: AgentCryptoError -> RatchetSyncState
cryptoErrToSyncState :: AgentCryptoError -> RatchetSyncState
cryptoErrToSyncState = \case
  AgentCryptoError
DECRYPT_AES -> RatchetSyncState
RSAllowed
  AgentCryptoError
DECRYPT_CB -> RatchetSyncState
RSAllowed
  AgentCryptoError
RATCHET_HEADER -> RatchetSyncState
RSRequired
  RATCHET_EARLIER Word32
_ -> RatchetSyncState
RSAllowed
  RATCHET_SKIPPED Word32
_ -> RatchetSyncState
RSRequired
  AgentCryptoError
RATCHET_SYNC -> RatchetSyncState
RSRequired

-- | SMP agent command and response parser for commands stored in db (fully parses binary bodies)
dbCommandP :: Parser ACommand
dbCommandP :: Parser ACommand
dbCommandP = Parser ConfirmationId ConfirmationId -> Parser ACommand
commandP (Parser ConfirmationId ConfirmationId -> Parser ACommand)
-> Parser ConfirmationId ConfirmationId -> Parser ACommand
forall a b. (a -> b) -> a -> b
$ Int -> Parser ConfirmationId ConfirmationId
A.take (Int -> Parser ConfirmationId ConfirmationId)
-> Parser ConfirmationId Int
-> Parser ConfirmationId ConfirmationId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Parser ConfirmationId Int
forall a. Integral a => Parser a
A.decimal Parser ConfirmationId Int
-> Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId Int
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ConfirmationId ConfirmationId
"\n")

instance StrEncoding ACommandTag where
  strP :: Parser ACommandTag
strP =
    (Char -> SndQueueSecured) -> Parser ConfirmationId ConfirmationId
A.takeTill (Char -> Char -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== Char
' ') Parser ConfirmationId ConfirmationId
-> (ConfirmationId -> Parser ACommandTag) -> Parser ACommandTag
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConfirmationId
"NEW" -> ACommandTag -> Parser ACommandTag
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ACommandTag
NEW_
      ConfirmationId
"LSET" -> ACommandTag -> Parser ACommandTag
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ACommandTag
LSET_
      ConfirmationId
"LGET" -> ACommandTag -> Parser ACommandTag
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ACommandTag
LGET_
      ConfirmationId
"JOIN" -> ACommandTag -> Parser ACommandTag
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ACommandTag
JOIN_
      ConfirmationId
"LET" -> ACommandTag -> Parser ACommandTag
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ACommandTag
LET_
      ConfirmationId
"ACK" -> ACommandTag -> Parser ACommandTag
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ACommandTag
ACK_
      ConfirmationId
"SWCH" -> ACommandTag -> Parser ACommandTag
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ACommandTag
SWCH_
      ConfirmationId
"DEL" -> ACommandTag -> Parser ACommandTag
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ACommandTag
DEL_
      ConfirmationId
_ -> FilePath -> Parser ACommandTag
forall a. FilePath -> Parser ConfirmationId a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"bad ACommandTag"
  strEncode :: ACommandTag -> ConfirmationId
strEncode = \case
    ACommandTag
NEW_ -> ConfirmationId
"NEW"
    ACommandTag
LSET_ -> ConfirmationId
"LSET"
    ACommandTag
LGET_ -> ConfirmationId
"LGET"
    ACommandTag
JOIN_ -> ConfirmationId
"JOIN"
    ACommandTag
LET_ -> ConfirmationId
"LET"
    ACommandTag
ACK_ -> ConfirmationId
"ACK"
    ACommandTag
SWCH_ -> ConfirmationId
"SWCH"
    ACommandTag
DEL_ -> ConfirmationId
"DEL"

commandP :: Parser ByteString -> Parser ACommand
commandP :: Parser ConfirmationId ConfirmationId -> Parser ACommand
commandP Parser ConfirmationId ConfirmationId
binaryP =
  Parser ACommandTag
forall a. StrEncoding a => Parser a
strP
    Parser ACommandTag
-> (ACommandTag -> Parser ACommand) -> Parser ACommand
forall a b.
Parser ConfirmationId a
-> (a -> Parser ConfirmationId b) -> Parser ConfirmationId b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ACommandTag
NEW_ -> Parser ACommand -> Parser ACommand
forall a. Parser a -> Parser a
s (SndQueueSecured
-> AConnectionMode -> InitialKeys -> SubscriptionMode -> ACommand
NEW (SndQueueSecured
 -> AConnectionMode -> InitialKeys -> SubscriptionMode -> ACommand)
-> Parser ConfirmationId SndQueueSecured
-> Parser
     ConfirmationId
     (AConnectionMode -> InitialKeys -> SubscriptionMode -> ACommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId SndQueueSecured
forall a. StrEncoding a => Parser a
strP_ Parser
  ConfirmationId
  (AConnectionMode -> InitialKeys -> SubscriptionMode -> ACommand)
-> Parser AConnectionMode
-> Parser
     ConfirmationId (InitialKeys -> SubscriptionMode -> ACommand)
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AConnectionMode
forall a. StrEncoding a => Parser a
strP_ Parser ConfirmationId (InitialKeys -> SubscriptionMode -> ACommand)
-> Parser ConfirmationId InitialKeys
-> Parser ConfirmationId (SubscriptionMode -> ACommand)
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfirmationId InitialKeys
pqIKP Parser ConfirmationId (SubscriptionMode -> ACommand)
-> Parser ConfirmationId SubscriptionMode -> Parser ACommand
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ConfirmationId SubscriptionMode
forall a. StrEncoding a => Parser a
strP Parser ConfirmationId SubscriptionMode
-> Parser ConfirmationId SubscriptionMode
-> Parser ConfirmationId SubscriptionMode
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SubscriptionMode -> Parser ConfirmationId SubscriptionMode
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubscriptionMode
SMP.SMSubscribe))
      ACommandTag
LSET_ -> Parser ACommand -> Parser ACommand
forall a. Parser a -> Parser a
s (UserConnLinkData 'CMContact -> Maybe CRClientData -> ACommand
LSET (UserConnLinkData 'CMContact -> Maybe CRClientData -> ACommand)
-> Parser ConfirmationId (UserConnLinkData 'CMContact)
-> Parser ConfirmationId (Maybe CRClientData -> ACommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId (UserConnLinkData 'CMContact)
forall a. StrEncoding a => Parser a
strP Parser ConfirmationId (Maybe CRClientData -> ACommand)
-> Parser ConfirmationId (Maybe CRClientData) -> Parser ACommand
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfirmationId CRClientData
-> Parser ConfirmationId (Maybe CRClientData)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Char
A.space Parser Char
-> Parser ConfirmationId CRClientData
-> Parser ConfirmationId CRClientData
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ConfirmationId CRClientData
forall a. StrEncoding a => Parser a
strP))
      ACommandTag
LGET_ -> Parser ACommand -> Parser ACommand
forall a. Parser a -> Parser a
s (ConnShortLink 'CMContact -> ACommand
LGET (ConnShortLink 'CMContact -> ACommand)
-> Parser ConfirmationId (ConnShortLink 'CMContact)
-> Parser ACommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId (ConnShortLink 'CMContact)
forall a. StrEncoding a => Parser a
strP)
      ACommandTag
JOIN_ -> Parser ACommand -> Parser ACommand
forall a. Parser a -> Parser a
s (SndQueueSecured
-> AConnectionRequestUri
-> PQSupport
-> SubscriptionMode
-> ConfirmationId
-> ACommand
JOIN (SndQueueSecured
 -> AConnectionRequestUri
 -> PQSupport
 -> SubscriptionMode
 -> ConfirmationId
 -> ACommand)
-> Parser ConfirmationId SndQueueSecured
-> Parser
     ConfirmationId
     (AConnectionRequestUri
      -> PQSupport -> SubscriptionMode -> ConfirmationId -> ACommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId SndQueueSecured
forall a. StrEncoding a => Parser a
strP_ Parser
  ConfirmationId
  (AConnectionRequestUri
   -> PQSupport -> SubscriptionMode -> ConfirmationId -> ACommand)
-> Parser ConfirmationId AConnectionRequestUri
-> Parser
     ConfirmationId
     (PQSupport -> SubscriptionMode -> ConfirmationId -> ACommand)
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfirmationId AConnectionRequestUri
forall a. StrEncoding a => Parser a
strP_ Parser
  ConfirmationId
  (PQSupport -> SubscriptionMode -> ConfirmationId -> ACommand)
-> Parser ConfirmationId PQSupport
-> Parser
     ConfirmationId (SubscriptionMode -> ConfirmationId -> ACommand)
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfirmationId PQSupport
pqSupP Parser
  ConfirmationId (SubscriptionMode -> ConfirmationId -> ACommand)
-> Parser ConfirmationId SubscriptionMode
-> Parser ConfirmationId (ConfirmationId -> ACommand)
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ConfirmationId SubscriptionMode
forall a. StrEncoding a => Parser a
strP_ Parser ConfirmationId SubscriptionMode
-> Parser ConfirmationId SubscriptionMode
-> Parser ConfirmationId SubscriptionMode
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SubscriptionMode -> Parser ConfirmationId SubscriptionMode
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubscriptionMode
SMP.SMSubscribe) Parser ConfirmationId (ConfirmationId -> ACommand)
-> Parser ConfirmationId ConfirmationId -> Parser ACommand
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfirmationId ConfirmationId
binaryP)
      ACommandTag
LET_ -> Parser ACommand -> Parser ACommand
forall a. Parser a -> Parser a
s (ConfirmationId -> ConfirmationId -> ACommand
LET (ConfirmationId -> ConfirmationId -> ACommand)
-> Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId (ConfirmationId -> ACommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> SndQueueSecured) -> Parser ConfirmationId ConfirmationId
A.takeTill (Char -> Char -> SndQueueSecured
forall a. Eq a => a -> a -> SndQueueSecured
== Char
' ') Parser ConfirmationId (ConfirmationId -> ACommand)
-> Parser Char
-> Parser ConfirmationId (ConfirmationId -> ACommand)
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
A.space Parser ConfirmationId (ConfirmationId -> ACommand)
-> Parser ConfirmationId ConfirmationId -> Parser ACommand
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfirmationId ConfirmationId
binaryP)
      ACommandTag
ACK_ -> Parser ACommand -> Parser ACommand
forall a. Parser a -> Parser a
s (AgentMsgId -> Maybe ConfirmationId -> ACommand
ACK (AgentMsgId -> Maybe ConfirmationId -> ACommand)
-> Parser ConfirmationId AgentMsgId
-> Parser ConfirmationId (Maybe ConfirmationId -> ACommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ConfirmationId AgentMsgId
forall a. Integral a => Parser a
A.decimal Parser ConfirmationId (Maybe ConfirmationId -> ACommand)
-> Parser ConfirmationId (Maybe ConfirmationId) -> Parser ACommand
forall a b.
Parser ConfirmationId (a -> b)
-> Parser ConfirmationId a -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId (Maybe ConfirmationId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Char
A.space Parser Char
-> Parser ConfirmationId ConfirmationId
-> Parser ConfirmationId ConfirmationId
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ConfirmationId ConfirmationId
binaryP))
      ACommandTag
SWCH_ -> ACommand -> Parser ACommand
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ACommand
SWCH
      ACommandTag
DEL_ -> ACommand -> Parser ACommand
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ACommand
DEL
  where
    s :: Parser a -> Parser a
    s :: forall a. Parser a -> Parser a
s Parser a
p = Parser Char
A.space Parser Char -> Parser a -> Parser a
forall a b.
Parser ConfirmationId a
-> Parser ConfirmationId b -> Parser ConfirmationId b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p
    pqIKP :: Parser InitialKeys
    pqIKP :: Parser ConfirmationId InitialKeys
pqIKP = Parser ConfirmationId InitialKeys
forall a. StrEncoding a => Parser a
strP_ Parser ConfirmationId InitialKeys
-> Parser ConfirmationId InitialKeys
-> Parser ConfirmationId InitialKeys
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InitialKeys -> Parser ConfirmationId InitialKeys
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PQSupport -> InitialKeys
IKLinkPQ PQSupport
PQSupportOff)
    pqSupP :: Parser PQSupport
    pqSupP :: Parser ConfirmationId PQSupport
pqSupP = Parser ConfirmationId PQSupport
forall a. StrEncoding a => Parser a
strP_ Parser ConfirmationId PQSupport
-> Parser ConfirmationId PQSupport
-> Parser ConfirmationId PQSupport
forall a.
Parser ConfirmationId a
-> Parser ConfirmationId a -> Parser ConfirmationId a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PQSupport -> Parser ConfirmationId PQSupport
forall a. a -> Parser ConfirmationId a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PQSupport
PQSupportOff

-- | Serialize SMP agent command.
serializeCommand :: ACommand -> ByteString
serializeCommand :: ACommand -> ConfirmationId
serializeCommand = \case
  NEW SndQueueSecured
ntfs AConnectionMode
cMode InitialKeys
pqIK SubscriptionMode
subMode -> (ACommandTag, SndQueueSecured, AConnectionMode, InitialKeys,
 SubscriptionMode)
-> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
s (ACommandTag
NEW_, SndQueueSecured
ntfs, AConnectionMode
cMode, InitialKeys
pqIK, SubscriptionMode
subMode)
  LSET UserConnLinkData 'CMContact
uld Maybe CRClientData
cd_ -> (ACommandTag, UserConnLinkData 'CMContact) -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
s (ACommandTag
LSET_, UserConnLinkData 'CMContact
uld) ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
-> (CRClientData -> ConfirmationId)
-> Maybe CRClientData
-> ConfirmationId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConfirmationId
"" (Char -> ConfirmationId -> ConfirmationId
B.cons Char
' ' (ConfirmationId -> ConfirmationId)
-> (CRClientData -> ConfirmationId)
-> CRClientData
-> ConfirmationId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CRClientData -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
s) Maybe CRClientData
cd_
  LGET ConnShortLink 'CMContact
sl -> (ACommandTag, ConnShortLink 'CMContact) -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
s (ACommandTag
LGET_, ConnShortLink 'CMContact
sl)
  JOIN SndQueueSecured
ntfs AConnectionRequestUri
cReq PQSupport
pqSup SubscriptionMode
subMode ConfirmationId
cInfo -> (ACommandTag, SndQueueSecured, AConnectionRequestUri, PQSupport,
 SubscriptionMode, Str)
-> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
s (ACommandTag
JOIN_, SndQueueSecured
ntfs, AConnectionRequestUri
cReq, PQSupport
pqSup, SubscriptionMode
subMode, ConfirmationId -> Str
Str (ConfirmationId -> Str) -> ConfirmationId -> Str
forall a b. (a -> b) -> a -> b
$ ConfirmationId -> ConfirmationId
serializeBinary ConfirmationId
cInfo)
  LET ConfirmationId
confId ConfirmationId
cInfo -> [ConfirmationId] -> ConfirmationId
B.unwords [ACommandTag -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
s ACommandTag
LET_, ConfirmationId
Item [ConfirmationId]
confId, ConfirmationId -> ConfirmationId
serializeBinary ConfirmationId
cInfo]
  ACK AgentMsgId
mId Maybe ConfirmationId
rcptInfo_ -> (ACommandTag, AgentMsgId) -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
s (ACommandTag
ACK_, AgentMsgId
mId) ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
-> (ConfirmationId -> ConfirmationId)
-> Maybe ConfirmationId
-> ConfirmationId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConfirmationId
"" (Char -> ConfirmationId -> ConfirmationId
B.cons Char
' ' (ConfirmationId -> ConfirmationId)
-> (ConfirmationId -> ConfirmationId)
-> ConfirmationId
-> ConfirmationId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfirmationId -> ConfirmationId
serializeBinary) Maybe ConfirmationId
rcptInfo_
  ACommand
SWCH -> ACommandTag -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
s ACommandTag
SWCH_
  ACommand
DEL -> ACommandTag -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
s ACommandTag
DEL_
  where
    s :: StrEncoding a => a -> ByteString
    s :: forall a. StrEncoding a => a -> ConfirmationId
s = a -> ConfirmationId
forall a. StrEncoding a => a -> ConfirmationId
strEncode

serializeBinary :: ByteString -> ByteString
serializeBinary :: ConfirmationId -> ConfirmationId
serializeBinary ConfirmationId
body = Int -> ConfirmationId
forall a. Show a => a -> ConfirmationId
bshow (ConfirmationId -> Int
B.length ConfirmationId
body) ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
"\n" ConfirmationId -> ConfirmationId -> ConfirmationId
forall a. Semigroup a => a -> a -> a
<> ConfirmationId
body

$(J.deriveJSON (enumJSON fstToLower) ''QueueStatus)

$(J.deriveJSON (sumTypeJSON $ dropPrefix "SS") ''SubscriptionStatus)

$(J.deriveJSON defaultJSON ''RcvQueueInfo)

$(J.deriveJSON defaultJSON ''SndQueueInfo)

$(J.deriveJSON defaultJSON ''ConnectionStats)

$(J.deriveJSON (sumTypeJSON fstToLower) ''MsgErrorType)

$(J.deriveJSON (sumTypeJSON fstToLower) ''MsgIntegrity)

$(J.deriveJSON (sumTypeJSON id) ''CommandErrorType)

$(J.deriveJSON (sumTypeJSON id) ''ConnectionErrorType)

$(J.deriveJSON (sumTypeJSON id) ''AgentCryptoError)

$(J.deriveJSON defaultJSON ''DroppedMsg)

$(J.deriveJSON (sumTypeJSON id) ''SMPAgentError)

$(J.deriveJSON (sumTypeJSON id) ''AgentErrorType)

$(J.deriveJSON (enumJSON $ dropPrefix "QD") ''QueueDirection)

$(J.deriveJSON (enumJSON $ dropPrefix "SP") ''SwitchPhase)

instance ConnectionModeI m => FromJSON (CreatedConnLink m) where
  parseJSON :: Value -> Parser (CreatedConnLink m)
parseJSON = $(J.mkParseJSON defaultJSON ''CreatedConnLink)

instance ConnectionModeI m => ToJSON (CreatedConnLink m) where
  toEncoding :: CreatedConnLink m -> Encoding
toEncoding = $(J.mkToEncoding defaultJSON ''CreatedConnLink)
  toJSON :: CreatedConnLink m -> Value
toJSON = $(J.mkToJSON defaultJSON ''CreatedConnLink)

instance FromJSON ACreatedConnLink where
  parseJSON :: Value -> Parser ACreatedConnLink
parseJSON (Object Object
v) = do
    ACR SConnectionMode m
m ConnectionRequestUri m
cReq <- Object
v Object -> Key -> Parser AConnectionRequestUri
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"connFullLink"
    Maybe (ConnShortLink m)
shortLink <- Object
v Object -> Key -> Parser (Maybe (ConnShortLink m))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"connShortLink"
    ACreatedConnLink -> Parser ACreatedConnLink
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACreatedConnLink -> Parser ACreatedConnLink)
-> ACreatedConnLink -> Parser ACreatedConnLink
forall a b. (a -> b) -> a -> b
$ SConnectionMode m -> CreatedConnLink m -> ACreatedConnLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> CreatedConnLink m -> ACreatedConnLink
ACCL SConnectionMode m
m (CreatedConnLink m -> ACreatedConnLink)
-> CreatedConnLink m -> ACreatedConnLink
forall a b. (a -> b) -> a -> b
$ ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnectionRequestUri m
cReq Maybe (ConnShortLink m)
shortLink
  parseJSON Value
invalid =
    FilePath -> Parser ACreatedConnLink -> Parser ACreatedConnLink
forall a. FilePath -> Parser a -> Parser a
JT.prependFailure FilePath
"bad ACreatedConnLink, " (FilePath -> Value -> Parser ACreatedConnLink
forall a. FilePath -> Value -> Parser a
JT.typeMismatch FilePath
"Object" Value
invalid)

instance ToJSON ACreatedConnLink where
  toEncoding :: ACreatedConnLink -> Encoding
toEncoding (ACCL SConnectionMode m
_ CreatedConnLink m
ccLink) = CreatedConnLink m -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding CreatedConnLink m
ccLink
  toJSON :: ACreatedConnLink -> Value
toJSON (ACCL SConnectionMode m
_ CreatedConnLink m
ccLink) = CreatedConnLink m -> Value
forall a. ToJSON a => a -> Value
toJSON CreatedConnLink m
ccLink