{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# 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
  ( -- * SMP agent protocol types
    ConnInfo,
    ACommand (..),
    AParty (..),
    SAParty (..),
    MsgHash,
    MsgMeta (..),
    SMPMessage (..),
    AMessage (..),
    SMPServer (..),
    SMPQueueUri (..),
    ConnectionMode (..),
    SConnectionMode (..),
    AConnectionMode (..),
    cmInvitation,
    cmContact,
    ConnectionModeI (..),
    ConnectionRequest (..),
    AConnectionRequest (..),
    ConnReqData (..),
    ConnReqScheme (..),
    simplexChat,
    AgentErrorType (..),
    CommandErrorType (..),
    ConnectionErrorType (..),
    BrokerErrorType (..),
    SMPAgentError (..),
    ATransmission,
    ATransmissionOrError,
    ARawTransmission,
    ConnId,
    ConfirmationId,
    InvitationId,
    AckMode (..),
    OnOff (..),
    MsgIntegrity (..),
    MsgErrorType (..),
    QueueStatus (..),
    SignatureKey,
    VerificationKey,
    EncryptionKey,
    DecryptionKey,
    ACorrId,
    AgentMsgId,

    -- * Parse and serialize
    serializeCommand,
    serializeSMPMessage,
    serializeMsgIntegrity,
    serializeServer,
    serializeSMPQueueUri,
    reservedServerKey, -- TODO remove
    serializeConnMode,
    serializeConnMode',
    connMode,
    connMode',
    serializeConnReq,
    serializeConnReq',
    serializeAgentError,
    commandP,
    parseSMPMessage,
    smpServerP,
    smpQueueUriP,
    connModeT,
    connReqP,
    connReqP',
    msgIntegrityP,
    agentErrorTypeP,
    agentMessageP,

    -- * TCP transport functions
    tPut,
    tGet,
    tPutRaw,
    tGetRaw,
  )
where

import Control.Applicative (optional, (<|>))
import Control.Monad.IO.Class
import qualified Crypto.PubKey.RSA as R
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Base64
import qualified Data.ByteString.Base64.URL as U
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Functor (($>))
import Data.Int (Int64)
import Data.Kind (Type)
import Data.List (find)
import qualified Data.List.NonEmpty as L
import Data.Maybe (isJust)
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Time.ISO8601
import Data.Type.Equality
import Data.Typeable ()
import GHC.Generics (Generic)
import Generic.Random (genericArbitraryU)
import Network.HTTP.Types (parseSimpleQuery, renderSimpleQuery)
import Network.Socket (HostName, ServiceName)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Parsers
import Simplex.Messaging.Protocol
  ( ErrorType,
    MsgBody,
    MsgId,
    SenderPublicKey,
  )
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Transport (Transport (..), TransportError, serializeTransportError, transportErrorP)
import Simplex.Messaging.Util
import Test.QuickCheck (Arbitrary (..))
import Text.Read
import UnliftIO.Exception (Exception)

-- | Raw (unparsed) SMP agent protocol transmission.
type ARawTransmission = (ByteString, ByteString, ByteString)

-- | Parsed SMP agent protocol transmission.
type ATransmission p = (ACorrId, ConnId, ACommand p)

-- | SMP agent protocol transmission or transmission error.
type ATransmissionOrError p = (ACorrId, ConnId, Either AgentErrorType (ACommand p))

type ACorrId = ByteString

-- | SMP agent protocol participants.
data AParty = Agent | Client
  deriving (AParty -> AParty -> Bool
(AParty -> AParty -> Bool)
-> (AParty -> AParty -> Bool) -> Eq AParty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AParty -> AParty -> Bool
$c/= :: AParty -> AParty -> Bool
== :: AParty -> AParty -> Bool
$c== :: AParty -> AParty -> Bool
Eq, Int -> AParty -> ShowS
[AParty] -> ShowS
AParty -> String
(Int -> AParty -> ShowS)
-> (AParty -> String) -> ([AParty] -> ShowS) -> Show AParty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AParty] -> ShowS
$cshowList :: [AParty] -> ShowS
show :: AParty -> String
$cshow :: AParty -> String
showsPrec :: Int -> AParty -> ShowS
$cshowsPrec :: Int -> AParty -> ShowS
Show)

-- | Singleton types for SMP agent protocol participants.
data SAParty :: AParty -> Type where
  SAgent :: SAParty Agent
  SClient :: SAParty Client

deriving instance Show (SAParty p)

deriving instance Eq (SAParty p)

instance TestEquality SAParty where
  testEquality :: SAParty a -> SAParty b -> Maybe (a :~: b)
testEquality SAParty a
SAgent SAParty b
SAgent = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  testEquality SAParty a
SClient SAParty b
SClient = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  testEquality SAParty a
_ SAParty b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing

data ACmd = forall p. ACmd (SAParty p) (ACommand p)

deriving instance Show ACmd

type ConnInfo = ByteString

-- | Parameterized type for SMP agent protocol commands and responses from all participants.
data ACommand (p :: AParty) where
  NEW :: AConnectionMode -> ACommand Client -- response INV
  INV :: AConnectionRequest -> ACommand Agent
  JOIN :: AConnectionRequest -> ConnInfo -> ACommand Client -- response OK
  CONF :: ConfirmationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
  LET :: ConfirmationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
  REQ :: InvitationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
  ACPT :: InvitationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
  RJCT :: InvitationId -> ACommand Client
  INFO :: ConnInfo -> ACommand Agent
  CON :: ACommand Agent -- notification that connection is established
  SUB :: ACommand Client
  END :: ACommand Agent
  DOWN :: ACommand Agent
  UP :: ACommand Agent
  -- QST :: QueueDirection -> ACommand Client
  -- STAT :: QueueDirection -> Maybe QueueStatus -> Maybe SubMode -> ACommand Agent
  SEND :: MsgBody -> ACommand Client
  MID :: AgentMsgId -> ACommand Agent
  SENT :: AgentMsgId -> ACommand Agent
  MERR :: AgentMsgId -> AgentErrorType -> ACommand Agent
  MSG :: MsgMeta -> MsgBody -> ACommand Agent
  ACK :: AgentMsgId -> ACommand Client
  -- RCVD :: AgentMsgId -> ACommand Agent
  OFF :: ACommand Client
  DEL :: ACommand Client
  OK :: ACommand Agent
  ERR :: AgentErrorType -> ACommand Agent

deriving instance Eq (ACommand p)

deriving instance Show (ACommand p)

data ConnectionMode = CMInvitation | CMContact
  deriving (ConnectionMode -> ConnectionMode -> Bool
(ConnectionMode -> ConnectionMode -> Bool)
-> (ConnectionMode -> ConnectionMode -> Bool) -> Eq ConnectionMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionMode -> ConnectionMode -> Bool
$c/= :: ConnectionMode -> ConnectionMode -> Bool
== :: ConnectionMode -> ConnectionMode -> Bool
$c== :: ConnectionMode -> ConnectionMode -> Bool
Eq, Int -> ConnectionMode -> ShowS
[ConnectionMode] -> ShowS
ConnectionMode -> String
(Int -> ConnectionMode -> ShowS)
-> (ConnectionMode -> String)
-> ([ConnectionMode] -> ShowS)
-> Show ConnectionMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionMode] -> ShowS
$cshowList :: [ConnectionMode] -> ShowS
show :: ConnectionMode -> String
$cshow :: ConnectionMode -> String
showsPrec :: Int -> ConnectionMode -> ShowS
$cshowsPrec :: Int -> 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 :: SConnectionMode a -> SConnectionMode b -> Maybe (a :~: b)
testEquality SConnectionMode a
SCMInvitation SConnectionMode b
SCMInvitation = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  testEquality SConnectionMode a
SCMContact SConnectionMode b
SCMContact = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
  testEquality SConnectionMode a
_ SConnectionMode b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing

data AConnectionMode = forall m. ACM (SConnectionMode m)

instance Eq AConnectionMode where
  ACM SConnectionMode m
m == :: AConnectionMode -> AConnectionMode -> Bool
== ACM SConnectionMode m
m' = Maybe (m :~: m) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (m :~: m) -> Bool) -> Maybe (m :~: m) -> Bool
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)
testEquality SConnectionMode m
m SConnectionMode m
m'

cmInvitation :: AConnectionMode
cmInvitation :: AConnectionMode
cmInvitation = SConnectionMode 'CMInvitation -> AConnectionMode
forall (m :: ConnectionMode). SConnectionMode m -> AConnectionMode
ACM SConnectionMode 'CMInvitation
SCMInvitation

cmContact :: AConnectionMode
cmContact :: AConnectionMode
cmContact = SConnectionMode 'CMContact -> AConnectionMode
forall (m :: ConnectionMode). SConnectionMode m -> AConnectionMode
ACM SConnectionMode 'CMContact
SCMContact

deriving instance Show AConnectionMode

connMode :: SConnectionMode m -> ConnectionMode
connMode :: SConnectionMode m -> ConnectionMode
connMode SConnectionMode m
SCMInvitation = ConnectionMode
CMInvitation
connMode SConnectionMode m
SCMContact = ConnectionMode
CMContact

connMode' :: ConnectionMode -> AConnectionMode
connMode' :: ConnectionMode -> AConnectionMode
connMode' ConnectionMode
CMInvitation = AConnectionMode
cmInvitation
connMode' ConnectionMode
CMContact = AConnectionMode
cmContact

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 -> (MsgId, UTCTime)
broker :: (MsgId, UTCTime),
    MsgMeta -> (AgentMsgId, UTCTime)
sender :: (AgentMsgId, UTCTime)
  }
  deriving (MsgMeta -> MsgMeta -> Bool
(MsgMeta -> MsgMeta -> Bool)
-> (MsgMeta -> MsgMeta -> Bool) -> Eq MsgMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgMeta -> MsgMeta -> Bool
$c/= :: MsgMeta -> MsgMeta -> Bool
== :: MsgMeta -> MsgMeta -> Bool
$c== :: MsgMeta -> MsgMeta -> Bool
Eq, Int -> MsgMeta -> ShowS
[MsgMeta] -> ShowS
MsgMeta -> String
(Int -> MsgMeta -> ShowS)
-> (MsgMeta -> String) -> ([MsgMeta] -> ShowS) -> Show MsgMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgMeta] -> ShowS
$cshowList :: [MsgMeta] -> ShowS
show :: MsgMeta -> String
$cshow :: MsgMeta -> String
showsPrec :: Int -> MsgMeta -> ShowS
$cshowsPrec :: Int -> MsgMeta -> ShowS
Show)

-- | SMP message formats.
data SMPMessage
  = -- | SMP confirmation
    -- (see <https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#send-message SMP protocol>)
    SMPConfirmation
      { -- | sender's public key to use for authentication of sender's commands at the recepient's server
        SMPMessage -> SenderPublicKey
senderKey :: SenderPublicKey,
        -- | sender's information to be associated with the connection, e.g. sender's profile information
        SMPMessage -> MsgId
connInfo :: ConnInfo
      }
  | -- | Agent message header and envelope for client messages
    -- (see <https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents SMP agent protocol>)
    SMPMessage
      { -- | sequential ID assigned by the sending agent
        SMPMessage -> AgentMsgId
senderMsgId :: AgentMsgId,
        -- | timestamp from the sending agent
        SMPMessage -> UTCTime
senderTimestamp :: SenderTimestamp,
        -- | digest of the previous message
        SMPMessage -> MsgId
previousMsgHash :: MsgHash,
        -- | messages sent between agents once queue is secured
        SMPMessage -> AMessage
agentMessage :: AMessage
      }
  deriving (Int -> SMPMessage -> ShowS
[SMPMessage] -> ShowS
SMPMessage -> String
(Int -> SMPMessage -> ShowS)
-> (SMPMessage -> String)
-> ([SMPMessage] -> ShowS)
-> Show SMPMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SMPMessage] -> ShowS
$cshowList :: [SMPMessage] -> ShowS
show :: SMPMessage -> String
$cshow :: SMPMessage -> String
showsPrec :: Int -> SMPMessage -> ShowS
$cshowsPrec :: Int -> SMPMessage -> ShowS
Show)

-- | 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 where
  -- | the first message in the queue to validate it is secured
  HELLO :: VerificationKey -> AckMode -> AMessage
  -- | reply queue information
  REPLY :: ConnectionRequest CMInvitation -> AMessage
  -- | agent envelope for the client message
  A_MSG :: MsgBody -> AMessage
  -- | connection request with the invitation to connect
  A_INV :: ConnectionRequest CMInvitation -> ConnInfo -> AMessage
  deriving (Int -> AMessage -> ShowS
[AMessage] -> ShowS
AMessage -> String
(Int -> AMessage -> ShowS)
-> (AMessage -> String) -> ([AMessage] -> ShowS) -> Show AMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AMessage] -> ShowS
$cshowList :: [AMessage] -> ShowS
show :: AMessage -> String
$cshow :: AMessage -> String
showsPrec :: Int -> AMessage -> ShowS
$cshowsPrec :: Int -> AMessage -> ShowS
Show)

-- | Parse SMP message.
parseSMPMessage :: ByteString -> Either AgentErrorType SMPMessage
parseSMPMessage :: MsgId -> Either AgentErrorType SMPMessage
parseSMPMessage = Parser SMPMessage
-> AgentErrorType -> MsgId -> Either AgentErrorType SMPMessage
forall a e. Parser a -> e -> MsgId -> Either e a
parse (Parser SMPMessage
smpMessageP Parser SMPMessage -> Parser MsgId () -> Parser SMPMessage
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId ()
A.endOfLine) (AgentErrorType -> MsgId -> Either AgentErrorType SMPMessage)
-> AgentErrorType -> MsgId -> Either AgentErrorType SMPMessage
forall a b. (a -> b) -> a -> b
$ SMPAgentError -> AgentErrorType
AGENT SMPAgentError
A_MESSAGE
  where
    smpMessageP :: Parser SMPMessage
    smpMessageP :: Parser SMPMessage
smpMessageP = Parser MsgId ()
A.endOfLine Parser MsgId () -> Parser SMPMessage -> Parser SMPMessage
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser SMPMessage
smpClientMessageP Parser SMPMessage -> Parser SMPMessage -> Parser SMPMessage
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SMPMessage
smpConfirmationP

    smpConfirmationP :: Parser SMPMessage
    smpConfirmationP :: Parser SMPMessage
smpConfirmationP = Parser MsgId MsgId
"KEY " Parser MsgId MsgId -> Parser SMPMessage -> Parser SMPMessage
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SenderPublicKey -> MsgId -> SMPMessage
SMPConfirmation (SenderPublicKey -> MsgId -> SMPMessage)
-> Parser MsgId SenderPublicKey
-> Parser MsgId (MsgId -> SMPMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId SenderPublicKey
C.pubKeyP Parser MsgId (MsgId -> SMPMessage)
-> Parser MsgId () -> Parser MsgId (MsgId -> SMPMessage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId ()
A.endOfLine Parser MsgId (MsgId -> SMPMessage)
-> Parser MsgId () -> Parser MsgId (MsgId -> SMPMessage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId ()
A.endOfLine Parser MsgId (MsgId -> SMPMessage)
-> Parser MsgId MsgId -> Parser SMPMessage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId MsgId
binaryBodyP Parser SMPMessage -> Parser MsgId () -> Parser SMPMessage
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId ()
A.endOfLine)

    smpClientMessageP :: Parser SMPMessage
    smpClientMessageP :: Parser SMPMessage
smpClientMessageP =
      AgentMsgId -> UTCTime -> MsgId -> AMessage -> SMPMessage
SMPMessage
        (AgentMsgId -> UTCTime -> MsgId -> AMessage -> SMPMessage)
-> Parser MsgId AgentMsgId
-> Parser MsgId (UTCTime -> MsgId -> AMessage -> SMPMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId AgentMsgId
forall a. Integral a => Parser a
A.decimal Parser MsgId (UTCTime -> MsgId -> AMessage -> SMPMessage)
-> Parser MsgId Char
-> Parser MsgId (UTCTime -> MsgId -> AMessage -> SMPMessage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space
        Parser MsgId (UTCTime -> MsgId -> AMessage -> SMPMessage)
-> Parser MsgId UTCTime
-> Parser MsgId (MsgId -> AMessage -> SMPMessage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId UTCTime
tsISO8601P Parser MsgId (MsgId -> AMessage -> SMPMessage)
-> Parser MsgId Char
-> Parser MsgId (MsgId -> AMessage -> SMPMessage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space
        -- TODO previous message hash should become mandatory when we support HELLO and REPLY
        -- (for HELLO it would be the hash of SMPConfirmation)
        Parser MsgId (MsgId -> AMessage -> SMPMessage)
-> Parser MsgId MsgId -> Parser MsgId (AMessage -> SMPMessage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser MsgId MsgId
base64P Parser MsgId MsgId -> Parser MsgId MsgId -> Parser MsgId MsgId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MsgId -> Parser MsgId MsgId
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgId
"") Parser MsgId (AMessage -> SMPMessage)
-> Parser MsgId () -> Parser MsgId (AMessage -> SMPMessage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId ()
A.endOfLine
        Parser MsgId (AMessage -> SMPMessage)
-> Parser MsgId AMessage -> Parser SMPMessage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId AMessage
agentMessageP

-- | Serialize SMP message.
serializeSMPMessage :: SMPMessage -> ByteString
serializeSMPMessage :: SMPMessage -> MsgId
serializeSMPMessage = \case
  SMPConfirmation SenderPublicKey
sKey MsgId
cInfo -> MsgId -> MsgId -> MsgId -> MsgId
smpMessage (MsgId
"KEY " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> SenderPublicKey -> MsgId
C.serializePubKey SenderPublicKey
sKey) MsgId
"" (MsgId -> MsgId
serializeBinary MsgId
cInfo) MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
"\n"
  SMPMessage {AgentMsgId
senderMsgId :: AgentMsgId
senderMsgId :: SMPMessage -> AgentMsgId
senderMsgId, UTCTime
senderTimestamp :: UTCTime
senderTimestamp :: SMPMessage -> UTCTime
senderTimestamp, MsgId
previousMsgHash :: MsgId
previousMsgHash :: SMPMessage -> MsgId
previousMsgHash, AMessage
agentMessage :: AMessage
agentMessage :: SMPMessage -> AMessage
agentMessage} ->
    let header :: MsgId
header = AgentMsgId -> UTCTime -> MsgId -> MsgId
forall a. Show a => a -> UTCTime -> MsgId -> MsgId
messageHeader AgentMsgId
senderMsgId UTCTime
senderTimestamp MsgId
previousMsgHash
        body :: MsgId
body = AMessage -> MsgId
serializeAgentMessage AMessage
agentMessage
     in MsgId -> MsgId -> MsgId -> MsgId
smpMessage MsgId
"" MsgId
header MsgId
body
  where
    messageHeader :: a -> UTCTime -> MsgId -> MsgId
messageHeader a
msgId UTCTime
ts MsgId
prevMsgHash =
      [MsgId] -> MsgId
B.unwords [a -> MsgId
forall a. Show a => a -> MsgId
bshow a
msgId, String -> MsgId
B.pack (String -> MsgId) -> String -> MsgId
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
formatISO8601Millis UTCTime
ts, MsgId -> MsgId
encode MsgId
prevMsgHash]
    smpMessage :: MsgId -> MsgId -> MsgId -> MsgId
smpMessage MsgId
smpHeader MsgId
aHeader MsgId
aBody = MsgId -> [MsgId] -> MsgId
B.intercalate MsgId
"\n" [MsgId
smpHeader, MsgId
aHeader, MsgId
aBody, MsgId
""]

agentMessageP :: Parser AMessage
agentMessageP :: Parser MsgId AMessage
agentMessageP =
  Parser MsgId MsgId
"HELLO " Parser MsgId MsgId
-> Parser MsgId AMessage -> Parser MsgId AMessage
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser MsgId AMessage
hello
    Parser MsgId AMessage
-> Parser MsgId AMessage -> Parser MsgId AMessage
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"REPLY " Parser MsgId MsgId
-> Parser MsgId AMessage -> Parser MsgId AMessage
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser MsgId AMessage
reply
    Parser MsgId AMessage
-> Parser MsgId AMessage -> Parser MsgId AMessage
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"MSG " Parser MsgId MsgId
-> Parser MsgId AMessage -> Parser MsgId AMessage
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser MsgId AMessage
a_msg
    Parser MsgId AMessage
-> Parser MsgId AMessage -> Parser MsgId AMessage
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"INV " Parser MsgId MsgId
-> Parser MsgId AMessage -> Parser MsgId AMessage
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser MsgId AMessage
a_inv
  where
    hello :: Parser MsgId AMessage
hello = SenderPublicKey -> AckMode -> AMessage
HELLO (SenderPublicKey -> AckMode -> AMessage)
-> Parser MsgId SenderPublicKey
-> Parser MsgId (AckMode -> AMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId SenderPublicKey
C.pubKeyP Parser MsgId (AckMode -> AMessage)
-> Parser MsgId AckMode -> Parser MsgId AMessage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId AckMode
ackMode
    reply :: Parser MsgId AMessage
reply = ConnectionRequest 'CMInvitation -> AMessage
REPLY (ConnectionRequest 'CMInvitation -> AMessage)
-> Parser MsgId (ConnectionRequest 'CMInvitation)
-> Parser MsgId AMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId (ConnectionRequest 'CMInvitation)
forall (m :: ConnectionMode).
ConnectionModeI m =>
Parser (ConnectionRequest m)
connReqP'
    a_msg :: Parser MsgId AMessage
a_msg = MsgId -> AMessage
A_MSG (MsgId -> AMessage) -> Parser MsgId MsgId -> Parser MsgId AMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId MsgId
binaryBodyP Parser MsgId AMessage -> Parser MsgId () -> Parser MsgId AMessage
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId ()
A.endOfLine
    a_inv :: Parser MsgId AMessage
a_inv = ConnectionRequest 'CMInvitation -> MsgId -> AMessage
A_INV (ConnectionRequest 'CMInvitation -> MsgId -> AMessage)
-> Parser MsgId (ConnectionRequest 'CMInvitation)
-> Parser MsgId (MsgId -> AMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId (ConnectionRequest 'CMInvitation)
forall (m :: ConnectionMode).
ConnectionModeI m =>
Parser (ConnectionRequest m)
connReqP' Parser MsgId (MsgId -> AMessage)
-> Parser MsgId Char -> Parser MsgId (MsgId -> AMessage)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space Parser MsgId (MsgId -> AMessage)
-> Parser MsgId MsgId -> Parser MsgId AMessage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId MsgId
binaryBodyP Parser MsgId AMessage -> Parser MsgId () -> Parser MsgId AMessage
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId ()
A.endOfLine
    ackMode :: Parser MsgId AckMode
ackMode = OnOff -> AckMode
AckMode (OnOff -> AckMode) -> Parser MsgId OnOff -> Parser MsgId AckMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser MsgId MsgId
" NO_ACK" Parser MsgId MsgId -> OnOff -> Parser MsgId OnOff
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> OnOff
Off Parser MsgId OnOff -> Parser MsgId OnOff -> Parser MsgId OnOff
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OnOff -> Parser MsgId OnOff
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnOff
On)

-- | SMP server location parser.
smpServerP :: Parser SMPServer
smpServerP :: Parser SMPServer
smpServerP = String -> Maybe String -> Maybe KeyHash -> SMPServer
SMPServer (String -> Maybe String -> Maybe KeyHash -> SMPServer)
-> Parser MsgId String
-> Parser MsgId (Maybe String -> Maybe KeyHash -> SMPServer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId String
server Parser MsgId (Maybe String -> Maybe KeyHash -> SMPServer)
-> Parser MsgId (Maybe String)
-> Parser MsgId (Maybe KeyHash -> SMPServer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId String -> Parser MsgId (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser MsgId String
port Parser MsgId (Maybe KeyHash -> SMPServer)
-> Parser MsgId (Maybe KeyHash) -> Parser SMPServer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId KeyHash -> Parser MsgId (Maybe KeyHash)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser MsgId KeyHash
kHash
  where
    server :: Parser MsgId String
server = MsgId -> String
B.unpack (MsgId -> String) -> Parser MsgId MsgId -> Parser MsgId String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser MsgId MsgId
A.takeWhile1 (String -> Char -> Bool
A.notInClass String
":#,; ")
    port :: Parser MsgId String
port = Char -> Parser MsgId Char
A.char Char
':' Parser MsgId Char -> Parser MsgId String -> Parser MsgId String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (MsgId -> String
B.unpack (MsgId -> String) -> Parser MsgId MsgId -> Parser MsgId String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser MsgId MsgId
A.takeWhile1 Char -> Bool
A.isDigit)
    kHash :: Parser MsgId KeyHash
kHash = MsgId -> KeyHash
C.KeyHash (MsgId -> KeyHash) -> Parser MsgId MsgId -> Parser MsgId KeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser MsgId Char
A.char Char
'#' Parser MsgId Char -> Parser MsgId MsgId -> Parser MsgId MsgId
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser MsgId MsgId
base64P)

serializeAgentMessage :: AMessage -> ByteString
serializeAgentMessage :: AMessage -> MsgId
serializeAgentMessage = \case
  HELLO SenderPublicKey
verifyKey AckMode
ackMode -> MsgId
"HELLO " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> SenderPublicKey -> MsgId
C.serializePubKey SenderPublicKey
verifyKey MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> if AckMode
ackMode AckMode -> AckMode -> Bool
forall a. Eq a => a -> a -> Bool
== OnOff -> AckMode
AckMode OnOff
Off then MsgId
" NO_ACK" else MsgId
""
  REPLY ConnectionRequest 'CMInvitation
cReq -> MsgId
"REPLY " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> ConnectionRequest 'CMInvitation -> MsgId
forall (m :: ConnectionMode). ConnectionRequest m -> MsgId
serializeConnReq' ConnectionRequest 'CMInvitation
cReq
  A_MSG MsgId
body -> MsgId
"MSG " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId -> MsgId
serializeBinary MsgId
body MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
"\n"
  A_INV ConnectionRequest 'CMInvitation
cReq MsgId
cInfo -> [MsgId] -> MsgId
B.unwords [MsgId
"INV", ConnectionRequest 'CMInvitation -> MsgId
forall (m :: ConnectionMode). ConnectionRequest m -> MsgId
serializeConnReq' ConnectionRequest 'CMInvitation
cReq, MsgId -> MsgId
serializeBinary MsgId
cInfo] MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
"\n"

-- | Serialize SMP queue information that is sent out-of-band.
serializeSMPQueueUri :: SMPQueueUri -> ByteString
serializeSMPQueueUri :: SMPQueueUri -> MsgId
serializeSMPQueueUri (SMPQueueUri SMPServer
srv MsgId
qId SenderPublicKey
_) =
  SMPServer -> MsgId
serializeServerUri SMPServer
srv MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
"/" MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId -> MsgId
U.encode MsgId
qId MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
"#"

-- | SMP queue information parser.
smpQueueUriP :: Parser SMPQueueUri
smpQueueUriP :: Parser SMPQueueUri
smpQueueUriP =
  SMPServer -> MsgId -> SenderPublicKey -> SMPQueueUri
SMPQueueUri (SMPServer -> MsgId -> SenderPublicKey -> SMPQueueUri)
-> Parser SMPServer
-> Parser MsgId (MsgId -> SenderPublicKey -> SMPQueueUri)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SMPServer
smpServerUriP Parser MsgId (MsgId -> SenderPublicKey -> SMPQueueUri)
-> Parser MsgId MsgId
-> Parser MsgId (MsgId -> SenderPublicKey -> SMPQueueUri)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId MsgId
"/" Parser MsgId (MsgId -> SenderPublicKey -> SMPQueueUri)
-> Parser MsgId MsgId
-> Parser MsgId (SenderPublicKey -> SMPQueueUri)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId MsgId
base64UriP Parser MsgId (SenderPublicKey -> SMPQueueUri)
-> Parser MsgId MsgId
-> Parser MsgId (SenderPublicKey -> SMPQueueUri)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId MsgId
"#" Parser MsgId (SenderPublicKey -> SMPQueueUri)
-> Parser MsgId SenderPublicKey -> Parser SMPQueueUri
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SenderPublicKey -> Parser MsgId SenderPublicKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure SenderPublicKey
reservedServerKey

reservedServerKey :: C.PublicKey
reservedServerKey :: SenderPublicKey
reservedServerKey = PublicKey -> SenderPublicKey
C.PublicKey (PublicKey -> SenderPublicKey) -> PublicKey -> SenderPublicKey
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> Integer -> PublicKey
R.PublicKey Int
1 Integer
0 Integer
0

serializeConnReq :: AConnectionRequest -> ByteString
serializeConnReq :: AConnectionRequest -> MsgId
serializeConnReq (ACR SConnectionMode m
_ ConnectionRequest m
cr) = ConnectionRequest m -> MsgId
forall (m :: ConnectionMode). ConnectionRequest m -> MsgId
serializeConnReq' ConnectionRequest m
cr

serializeConnReq' :: ConnectionRequest m -> ByteString
serializeConnReq' :: ConnectionRequest m -> MsgId
serializeConnReq' = \case
  CRInvitation ConnReqData
crData -> ConnectionMode -> ConnReqData -> MsgId
serialize ConnectionMode
CMInvitation ConnReqData
crData
  CRContact ConnReqData
crData -> ConnectionMode -> ConnReqData -> MsgId
serialize ConnectionMode
CMContact ConnReqData
crData
  where
    serialize :: ConnectionMode -> ConnReqData -> MsgId
serialize ConnectionMode
crMode ConnReqData {ConnReqScheme
crScheme :: ConnReqData -> ConnReqScheme
crScheme :: ConnReqScheme
crScheme, NonEmpty SMPQueueUri
crSmpQueues :: ConnReqData -> NonEmpty SMPQueueUri
crSmpQueues :: NonEmpty SMPQueueUri
crSmpQueues, SenderPublicKey
crEncryptKey :: ConnReqData -> SenderPublicKey
crEncryptKey :: SenderPublicKey
crEncryptKey} =
      MsgId
sch MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
"/" MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
m MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
"#/" MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
queryStr
      where
        sch :: MsgId
sch = case ConnReqScheme
crScheme of
          ConnReqScheme
CRSSimplex -> MsgId
"simplex:"
          CRSAppServer String
host Maybe String
port -> String -> MsgId
B.pack (String -> MsgId) -> String -> MsgId
forall a b. (a -> b) -> a -> b
$ String
"https://" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
host String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
:) Maybe String
port
        m :: MsgId
m = case ConnectionMode
crMode of
          ConnectionMode
CMInvitation -> MsgId
"invitation"
          ConnectionMode
CMContact -> MsgId
"contact"
        queryStr :: MsgId
queryStr = Bool -> SimpleQuery -> MsgId
renderSimpleQuery Bool
True [(MsgId
"smp", MsgId
queues), (MsgId
"e2e", MsgId
key)]
        queues :: MsgId
queues = MsgId -> [MsgId] -> MsgId
B.intercalate MsgId
"," ([MsgId] -> MsgId)
-> ([SMPQueueUri] -> [MsgId]) -> [SMPQueueUri] -> MsgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SMPQueueUri -> MsgId) -> [SMPQueueUri] -> [MsgId]
forall a b. (a -> b) -> [a] -> [b]
map SMPQueueUri -> MsgId
serializeSMPQueueUri ([SMPQueueUri] -> MsgId) -> [SMPQueueUri] -> MsgId
forall a b. (a -> b) -> a -> b
$ NonEmpty SMPQueueUri -> [SMPQueueUri]
forall a. NonEmpty a -> [a]
L.toList NonEmpty SMPQueueUri
crSmpQueues
        key :: MsgId
key = SenderPublicKey -> MsgId
C.serializePubKeyUri SenderPublicKey
crEncryptKey

connReqP' :: forall m. ConnectionModeI m => Parser (ConnectionRequest m)
connReqP' :: Parser (ConnectionRequest m)
connReqP' = do
  ACR SConnectionMode m
m ConnectionRequest m
cr <- Parser AConnectionRequest
connReqP
  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)
testEquality SConnectionMode m
m (SConnectionMode m -> Maybe (m :~: m))
-> SConnectionMode m -> Maybe (m :~: m)
forall a b. (a -> b) -> a -> b
$ ConnectionModeI m => SConnectionMode m
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m
sConnectionMode @m of
    Just m :~: m
Refl -> ConnectionRequest m -> Parser MsgId (ConnectionRequest m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectionRequest m
cr
    Maybe (m :~: m)
_ -> String -> Parser (ConnectionRequest m)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad connection request mode"

connReqP :: Parser AConnectionRequest
connReqP :: Parser AConnectionRequest
connReqP = do
  ConnReqScheme
crScheme <- Parser MsgId MsgId
"simplex:" Parser MsgId MsgId -> ConnReqScheme -> Parser MsgId ConnReqScheme
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ConnReqScheme
CRSSimplex Parser MsgId ConnReqScheme
-> Parser MsgId ConnReqScheme -> Parser MsgId ConnReqScheme
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"https://" Parser MsgId MsgId
-> Parser MsgId ConnReqScheme -> Parser MsgId ConnReqScheme
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser MsgId ConnReqScheme
appServer
  ConnectionMode
crMode <- Parser MsgId MsgId
"/" Parser MsgId MsgId
-> Parser MsgId ConnectionMode -> Parser MsgId ConnectionMode
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser MsgId ConnectionMode
mode Parser MsgId ConnectionMode
-> Parser MsgId MsgId -> Parser MsgId ConnectionMode
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId MsgId
"#/?"
  SimpleQuery
query <- MsgId -> SimpleQuery
parseSimpleQuery (MsgId -> SimpleQuery)
-> Parser MsgId MsgId -> Parser MsgId SimpleQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser MsgId MsgId
A.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
  NonEmpty SMPQueueUri
crSmpQueues <- MsgId
-> Parser (NonEmpty SMPQueueUri)
-> SimpleQuery
-> Parser (NonEmpty SMPQueueUri)
forall (m :: * -> *) (t :: * -> *) a b.
(MonadFail m, Foldable t, Eq a) =>
a -> Parser b -> t (a, MsgId) -> m b
paramP MsgId
"smp" Parser (NonEmpty SMPQueueUri)
smpQueues SimpleQuery
query
  SenderPublicKey
crEncryptKey <- MsgId
-> Parser MsgId SenderPublicKey
-> SimpleQuery
-> Parser MsgId SenderPublicKey
forall (m :: * -> *) (t :: * -> *) a b.
(MonadFail m, Foldable t, Eq a) =>
a -> Parser b -> t (a, MsgId) -> m b
paramP MsgId
"e2e" Parser MsgId SenderPublicKey
C.pubKeyUriP SimpleQuery
query
  let cReq :: ConnReqData
cReq = ConnReqData :: ConnReqScheme
-> NonEmpty SMPQueueUri -> SenderPublicKey -> ConnReqData
ConnReqData {ConnReqScheme
crScheme :: ConnReqScheme
crScheme :: ConnReqScheme
crScheme, NonEmpty SMPQueueUri
crSmpQueues :: NonEmpty SMPQueueUri
crSmpQueues :: NonEmpty SMPQueueUri
crSmpQueues, SenderPublicKey
crEncryptKey :: SenderPublicKey
crEncryptKey :: SenderPublicKey
crEncryptKey}
  AConnectionRequest -> Parser AConnectionRequest
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AConnectionRequest -> Parser AConnectionRequest)
-> AConnectionRequest -> Parser AConnectionRequest
forall a b. (a -> b) -> a -> b
$ case ConnectionMode
crMode of
    ConnectionMode
CMInvitation -> SConnectionMode 'CMInvitation
-> ConnectionRequest 'CMInvitation -> AConnectionRequest
forall (m :: ConnectionMode).
SConnectionMode m -> ConnectionRequest m -> AConnectionRequest
ACR SConnectionMode 'CMInvitation
SCMInvitation (ConnectionRequest 'CMInvitation -> AConnectionRequest)
-> ConnectionRequest 'CMInvitation -> AConnectionRequest
forall a b. (a -> b) -> a -> b
$ ConnReqData -> ConnectionRequest 'CMInvitation
CRInvitation ConnReqData
cReq
    ConnectionMode
CMContact -> SConnectionMode 'CMContact
-> ConnectionRequest 'CMContact -> AConnectionRequest
forall (m :: ConnectionMode).
SConnectionMode m -> ConnectionRequest m -> AConnectionRequest
ACR SConnectionMode 'CMContact
SCMContact (ConnectionRequest 'CMContact -> AConnectionRequest)
-> ConnectionRequest 'CMContact -> AConnectionRequest
forall a b. (a -> b) -> a -> b
$ ConnReqData -> ConnectionRequest 'CMContact
CRContact ConnReqData
cReq
  where
    appServer :: Parser MsgId ConnReqScheme
appServer = String -> Maybe String -> ConnReqScheme
CRSAppServer (String -> Maybe String -> ConnReqScheme)
-> Parser MsgId String
-> Parser MsgId (Maybe String -> ConnReqScheme)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId String
host Parser MsgId (Maybe String -> ConnReqScheme)
-> Parser MsgId (Maybe String) -> Parser MsgId ConnReqScheme
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId String -> Parser MsgId (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser MsgId String
port
    host :: Parser MsgId String
host = MsgId -> String
B.unpack (MsgId -> String) -> Parser MsgId MsgId -> Parser MsgId String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser MsgId MsgId
A.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')
    port :: Parser MsgId String
port = MsgId -> String
B.unpack (MsgId -> String) -> Parser MsgId MsgId -> Parser MsgId String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser MsgId Char
A.char Char
':' Parser MsgId Char -> Parser MsgId MsgId -> Parser MsgId MsgId
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser MsgId MsgId
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'))
    mode :: Parser MsgId ConnectionMode
mode = Parser MsgId MsgId
"invitation" Parser MsgId MsgId -> ConnectionMode -> Parser MsgId ConnectionMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ConnectionMode
CMInvitation Parser MsgId ConnectionMode
-> Parser MsgId ConnectionMode -> Parser MsgId ConnectionMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"contact" Parser MsgId MsgId -> ConnectionMode -> Parser MsgId ConnectionMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ConnectionMode
CMContact
    paramP :: a -> Parser b -> t (a, MsgId) -> m b
paramP a
param Parser b
parser t (a, MsgId)
query =
      let p :: m MsgId
p = m MsgId -> ((a, MsgId) -> m MsgId) -> Maybe (a, MsgId) -> m MsgId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m MsgId
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"") (MsgId -> m MsgId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MsgId -> m MsgId)
-> ((a, MsgId) -> MsgId) -> (a, MsgId) -> m MsgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, MsgId) -> MsgId
forall a b. (a, b) -> b
snd) (Maybe (a, MsgId) -> m MsgId) -> Maybe (a, MsgId) -> m MsgId
forall a b. (a -> b) -> a -> b
$ ((a, MsgId) -> Bool) -> t (a, MsgId) -> Maybe (a, MsgId)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
param) (a -> Bool) -> ((a, MsgId) -> a) -> (a, MsgId) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, MsgId) -> a
forall a b. (a, b) -> a
fst) t (a, MsgId)
query
       in Parser b -> MsgId -> Either String b
forall a. Parser a -> MsgId -> Either String a
parseAll Parser b
parser (MsgId -> Either String b) -> m MsgId -> m b
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> m MsgId
p
    smpQueues :: Parser (NonEmpty SMPQueueUri)
smpQueues =
      Parser (NonEmpty SMPQueueUri)
-> (NonEmpty SMPQueueUri -> Parser (NonEmpty SMPQueueUri))
-> Maybe (NonEmpty SMPQueueUri)
-> Parser (NonEmpty SMPQueueUri)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser (NonEmpty SMPQueueUri)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no SMP queues") NonEmpty SMPQueueUri -> Parser (NonEmpty SMPQueueUri)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (NonEmpty SMPQueueUri) -> Parser (NonEmpty SMPQueueUri))
-> ([SMPQueueUri] -> Maybe (NonEmpty SMPQueueUri))
-> [SMPQueueUri]
-> Parser (NonEmpty SMPQueueUri)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SMPQueueUri] -> Maybe (NonEmpty SMPQueueUri)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty
        ([SMPQueueUri] -> Parser (NonEmpty SMPQueueUri))
-> Parser MsgId [SMPQueueUri] -> Parser (NonEmpty SMPQueueUri)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Parser SMPQueueUri
smpQueue Parser SMPQueueUri
-> Parser MsgId Char -> Parser MsgId [SMPQueueUri]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`A.sepBy1'` Char -> Parser MsgId Char
A.char Char
',')
    smpQueue :: Parser SMPQueueUri
smpQueue = Parser SMPQueueUri -> MsgId -> Either String SMPQueueUri
forall a. Parser a -> MsgId -> Either String a
parseAll Parser SMPQueueUri
smpQueueUriP (MsgId -> Either String SMPQueueUri)
-> Parser MsgId MsgId -> Parser SMPQueueUri
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> (Char -> Bool) -> Parser MsgId MsgId
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',')

-- | Serialize SMP server location.
serializeServer :: SMPServer -> ByteString
serializeServer :: SMPServer -> MsgId
serializeServer SMPServer {String
host :: SMPServer -> String
host :: String
host, Maybe String
port :: SMPServer -> Maybe String
port :: Maybe String
port, Maybe KeyHash
keyHash :: SMPServer -> Maybe KeyHash
keyHash :: Maybe KeyHash
keyHash} =
  String -> MsgId
B.pack (String -> MsgId) -> String -> MsgId
forall a b. (a -> b) -> a -> b
$ String
host String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
:) Maybe String
port String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> (KeyHash -> String) -> Maybe KeyHash -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((Char
'#' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (KeyHash -> String) -> KeyHash -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgId -> String
B.unpack (MsgId -> String) -> (KeyHash -> MsgId) -> KeyHash -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgId -> MsgId
encode (MsgId -> MsgId) -> (KeyHash -> MsgId) -> KeyHash -> MsgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash -> MsgId
C.unKeyHash) Maybe KeyHash
keyHash

serializeServerUri :: SMPServer -> ByteString
serializeServerUri :: SMPServer -> MsgId
serializeServerUri SMPServer {String
host :: String
host :: SMPServer -> String
host, Maybe String
port :: Maybe String
port :: SMPServer -> Maybe String
port, Maybe KeyHash
keyHash :: Maybe KeyHash
keyHash :: SMPServer -> Maybe KeyHash
keyHash} = MsgId
"smp://" MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
kh MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> String -> MsgId
B.pack String
host MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
p
  where
    kh :: MsgId
kh = MsgId -> (KeyHash -> MsgId) -> Maybe KeyHash -> MsgId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MsgId
"" ((MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
"@") (MsgId -> MsgId) -> (KeyHash -> MsgId) -> KeyHash -> MsgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgId -> MsgId
U.encode (MsgId -> MsgId) -> (KeyHash -> MsgId) -> KeyHash -> MsgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash -> MsgId
C.unKeyHash) Maybe KeyHash
keyHash
    p :: MsgId
p = String -> MsgId
B.pack (String -> MsgId) -> String -> MsgId
forall a b. (a -> b) -> a -> b
$ String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
:) Maybe String
port

smpServerUriP :: Parser SMPServer
smpServerUriP :: Parser SMPServer
smpServerUriP = do
  MsgId
_ <- Parser MsgId MsgId
"smp://"
  Maybe KeyHash
keyHash <- Parser MsgId KeyHash -> Parser MsgId (Maybe KeyHash)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser MsgId KeyHash -> Parser MsgId (Maybe KeyHash))
-> Parser MsgId KeyHash -> Parser MsgId (Maybe KeyHash)
forall a b. (a -> b) -> a -> b
$ MsgId -> KeyHash
C.KeyHash (MsgId -> KeyHash) -> Parser MsgId MsgId -> Parser MsgId KeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MsgId -> Either String MsgId
U.decode (MsgId -> Either String MsgId)
-> Parser MsgId MsgId -> Parser MsgId MsgId
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> (Char -> Bool) -> Parser MsgId MsgId
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@') Parser MsgId MsgId -> Parser MsgId Char -> Parser MsgId MsgId
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser MsgId Char
A.char Char
'@')
  String
host <- MsgId -> String
B.unpack (MsgId -> String) -> Parser MsgId MsgId -> Parser MsgId String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser MsgId MsgId
A.takeWhile1 (String -> Char -> Bool
A.notInClass String
":#,;/ ")
  Maybe String
port <- Parser MsgId String -> Parser MsgId (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser MsgId String -> Parser MsgId (Maybe String))
-> Parser MsgId String -> Parser MsgId (Maybe String)
forall a b. (a -> b) -> a -> b
$ MsgId -> String
B.unpack (MsgId -> String) -> Parser MsgId MsgId -> Parser MsgId String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser MsgId Char
A.char Char
':' Parser MsgId Char -> Parser MsgId MsgId -> Parser MsgId MsgId
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser MsgId MsgId
A.takeWhile1 Char -> Bool
A.isDigit)
  SMPServer -> Parser SMPServer
forall (f :: * -> *) a. Applicative f => a -> f a
pure SMPServer :: String -> Maybe String -> Maybe KeyHash -> SMPServer
SMPServer {String
host :: String
host :: String
host, Maybe String
port :: Maybe String
port :: Maybe String
port, Maybe KeyHash
keyHash :: Maybe KeyHash
keyHash :: Maybe KeyHash
keyHash}

serializeConnMode :: AConnectionMode -> ByteString
serializeConnMode :: AConnectionMode -> MsgId
serializeConnMode (ACM SConnectionMode m
cMode) = ConnectionMode -> MsgId
serializeConnMode' (ConnectionMode -> MsgId) -> ConnectionMode -> MsgId
forall a b. (a -> b) -> a -> b
$ SConnectionMode m -> ConnectionMode
forall (m :: ConnectionMode). SConnectionMode m -> ConnectionMode
connMode SConnectionMode m
cMode

serializeConnMode' :: ConnectionMode -> ByteString
serializeConnMode' :: ConnectionMode -> MsgId
serializeConnMode' = \case
  ConnectionMode
CMInvitation -> MsgId
"INV"
  ConnectionMode
CMContact -> MsgId
"CON"

connModeP' :: Parser ConnectionMode
connModeP' :: Parser MsgId ConnectionMode
connModeP' = Parser MsgId MsgId
"INV" Parser MsgId MsgId -> ConnectionMode -> Parser MsgId ConnectionMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ConnectionMode
CMInvitation Parser MsgId ConnectionMode
-> Parser MsgId ConnectionMode -> Parser MsgId ConnectionMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"CON" Parser MsgId MsgId -> ConnectionMode -> Parser MsgId ConnectionMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ConnectionMode
CMContact

connModeP :: Parser AConnectionMode
connModeP :: Parser AConnectionMode
connModeP = ConnectionMode -> AConnectionMode
connMode' (ConnectionMode -> AConnectionMode)
-> Parser MsgId ConnectionMode -> Parser AConnectionMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId ConnectionMode
connModeP'

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

-- | SMP server location and transport key digest (hash).
data SMPServer = SMPServer
  { SMPServer -> String
host :: HostName,
    SMPServer -> Maybe String
port :: Maybe ServiceName,
    SMPServer -> Maybe KeyHash
keyHash :: Maybe C.KeyHash
  }
  deriving (SMPServer -> SMPServer -> Bool
(SMPServer -> SMPServer -> Bool)
-> (SMPServer -> SMPServer -> Bool) -> Eq SMPServer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SMPServer -> SMPServer -> Bool
$c/= :: SMPServer -> SMPServer -> Bool
== :: SMPServer -> SMPServer -> Bool
$c== :: SMPServer -> SMPServer -> Bool
Eq, Eq SMPServer
Eq SMPServer
-> (SMPServer -> SMPServer -> Ordering)
-> (SMPServer -> SMPServer -> Bool)
-> (SMPServer -> SMPServer -> Bool)
-> (SMPServer -> SMPServer -> Bool)
-> (SMPServer -> SMPServer -> Bool)
-> (SMPServer -> SMPServer -> SMPServer)
-> (SMPServer -> SMPServer -> SMPServer)
-> Ord SMPServer
SMPServer -> SMPServer -> Bool
SMPServer -> SMPServer -> Ordering
SMPServer -> SMPServer -> SMPServer
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SMPServer -> SMPServer -> SMPServer
$cmin :: SMPServer -> SMPServer -> SMPServer
max :: SMPServer -> SMPServer -> SMPServer
$cmax :: SMPServer -> SMPServer -> SMPServer
>= :: SMPServer -> SMPServer -> Bool
$c>= :: SMPServer -> SMPServer -> Bool
> :: SMPServer -> SMPServer -> Bool
$c> :: SMPServer -> SMPServer -> Bool
<= :: SMPServer -> SMPServer -> Bool
$c<= :: SMPServer -> SMPServer -> Bool
< :: SMPServer -> SMPServer -> Bool
$c< :: SMPServer -> SMPServer -> Bool
compare :: SMPServer -> SMPServer -> Ordering
$ccompare :: SMPServer -> SMPServer -> Ordering
$cp1Ord :: Eq SMPServer
Ord, Int -> SMPServer -> ShowS
[SMPServer] -> ShowS
SMPServer -> String
(Int -> SMPServer -> ShowS)
-> (SMPServer -> String)
-> ([SMPServer] -> ShowS)
-> Show SMPServer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SMPServer] -> ShowS
$cshowList :: [SMPServer] -> ShowS
show :: SMPServer -> String
$cshow :: SMPServer -> String
showsPrec :: Int -> SMPServer -> ShowS
$cshowsPrec :: Int -> SMPServer -> ShowS
Show)

instance IsString SMPServer where
  fromString :: String -> SMPServer
fromString = (MsgId -> Either String SMPServer) -> String -> SMPServer
forall a. (MsgId -> Either String a) -> String -> a
parseString ((MsgId -> Either String SMPServer) -> String -> SMPServer)
-> (MsgId -> Either String SMPServer) -> String -> SMPServer
forall a b. (a -> b) -> a -> b
$ Parser SMPServer -> MsgId -> Either String SMPServer
forall a. Parser a -> MsgId -> Either String a
parseAll Parser SMPServer
smpServerP

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

type ConfirmationId = ByteString

type InvitationId = ByteString

-- | Connection modes.
data OnOff = On | Off deriving (OnOff -> OnOff -> Bool
(OnOff -> OnOff -> Bool) -> (OnOff -> OnOff -> Bool) -> Eq OnOff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OnOff -> OnOff -> Bool
$c/= :: OnOff -> OnOff -> Bool
== :: OnOff -> OnOff -> Bool
$c== :: OnOff -> OnOff -> Bool
Eq, Int -> OnOff -> ShowS
[OnOff] -> ShowS
OnOff -> String
(Int -> OnOff -> ShowS)
-> (OnOff -> String) -> ([OnOff] -> ShowS) -> Show OnOff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OnOff] -> ShowS
$cshowList :: [OnOff] -> ShowS
show :: OnOff -> String
$cshow :: OnOff -> String
showsPrec :: Int -> OnOff -> ShowS
$cshowsPrec :: Int -> OnOff -> ShowS
Show, ReadPrec [OnOff]
ReadPrec OnOff
Int -> ReadS OnOff
ReadS [OnOff]
(Int -> ReadS OnOff)
-> ReadS [OnOff]
-> ReadPrec OnOff
-> ReadPrec [OnOff]
-> Read OnOff
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OnOff]
$creadListPrec :: ReadPrec [OnOff]
readPrec :: ReadPrec OnOff
$creadPrec :: ReadPrec OnOff
readList :: ReadS [OnOff]
$creadList :: ReadS [OnOff]
readsPrec :: Int -> ReadS OnOff
$creadsPrec :: Int -> ReadS OnOff
Read)

-- | Message acknowledgement mode of the connection.
newtype AckMode = AckMode OnOff deriving (AckMode -> AckMode -> Bool
(AckMode -> AckMode -> Bool)
-> (AckMode -> AckMode -> Bool) -> Eq AckMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AckMode -> AckMode -> Bool
$c/= :: AckMode -> AckMode -> Bool
== :: AckMode -> AckMode -> Bool
$c== :: AckMode -> AckMode -> Bool
Eq, Int -> AckMode -> ShowS
[AckMode] -> ShowS
AckMode -> String
(Int -> AckMode -> ShowS)
-> (AckMode -> String) -> ([AckMode] -> ShowS) -> Show AckMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AckMode] -> ShowS
$cshowList :: [AckMode] -> ShowS
show :: AckMode -> String
$cshow :: AckMode -> String
showsPrec :: Int -> AckMode -> ShowS
$cshowsPrec :: Int -> AckMode -> ShowS
Show)

-- | SMP queue information sent out-of-band.
--
-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#out-of-band-messages
data SMPQueueUri = SMPQueueUri
  { SMPQueueUri -> SMPServer
smpServer :: SMPServer,
    SMPQueueUri -> MsgId
senderId :: SMP.SenderId,
    SMPQueueUri -> SenderPublicKey
serverVerifyKey :: VerificationKey
  }
  deriving (SMPQueueUri -> SMPQueueUri -> Bool
(SMPQueueUri -> SMPQueueUri -> Bool)
-> (SMPQueueUri -> SMPQueueUri -> Bool) -> Eq SMPQueueUri
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SMPQueueUri -> SMPQueueUri -> Bool
$c/= :: SMPQueueUri -> SMPQueueUri -> Bool
== :: SMPQueueUri -> SMPQueueUri -> Bool
$c== :: SMPQueueUri -> SMPQueueUri -> Bool
Eq, Int -> SMPQueueUri -> ShowS
[SMPQueueUri] -> ShowS
SMPQueueUri -> String
(Int -> SMPQueueUri -> ShowS)
-> (SMPQueueUri -> String)
-> ([SMPQueueUri] -> ShowS)
-> Show SMPQueueUri
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SMPQueueUri] -> ShowS
$cshowList :: [SMPQueueUri] -> ShowS
show :: SMPQueueUri -> String
$cshow :: SMPQueueUri -> String
showsPrec :: Int -> SMPQueueUri -> ShowS
$cshowsPrec :: Int -> SMPQueueUri -> ShowS
Show)

data ConnectionRequest (m :: ConnectionMode) where
  CRInvitation :: ConnReqData -> ConnectionRequest CMInvitation
  CRContact :: ConnReqData -> ConnectionRequest CMContact

deriving instance Eq (ConnectionRequest m)

deriving instance Show (ConnectionRequest m)

data AConnectionRequest = forall m. ACR (SConnectionMode m) (ConnectionRequest m)

instance Eq AConnectionRequest where
  ACR SConnectionMode m
m ConnectionRequest m
cr == :: AConnectionRequest -> AConnectionRequest -> Bool
== ACR SConnectionMode m
m' ConnectionRequest 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)
testEquality SConnectionMode m
m SConnectionMode m
m' of
    Just m :~: m
Refl -> ConnectionRequest m
cr ConnectionRequest m -> ConnectionRequest m -> Bool
forall a. Eq a => a -> a -> Bool
== ConnectionRequest m
ConnectionRequest m
cr'
    Maybe (m :~: m)
_ -> Bool
False

deriving instance Show AConnectionRequest

data ConnReqData = ConnReqData
  { ConnReqData -> ConnReqScheme
crScheme :: ConnReqScheme,
    ConnReqData -> NonEmpty SMPQueueUri
crSmpQueues :: L.NonEmpty SMPQueueUri,
    ConnReqData -> SenderPublicKey
crEncryptKey :: EncryptionKey
  }
  deriving (ConnReqData -> ConnReqData -> Bool
(ConnReqData -> ConnReqData -> Bool)
-> (ConnReqData -> ConnReqData -> Bool) -> Eq ConnReqData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnReqData -> ConnReqData -> Bool
$c/= :: ConnReqData -> ConnReqData -> Bool
== :: ConnReqData -> ConnReqData -> Bool
$c== :: ConnReqData -> ConnReqData -> Bool
Eq, Int -> ConnReqData -> ShowS
[ConnReqData] -> ShowS
ConnReqData -> String
(Int -> ConnReqData -> ShowS)
-> (ConnReqData -> String)
-> ([ConnReqData] -> ShowS)
-> Show ConnReqData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnReqData] -> ShowS
$cshowList :: [ConnReqData] -> ShowS
show :: ConnReqData -> String
$cshow :: ConnReqData -> String
showsPrec :: Int -> ConnReqData -> ShowS
$cshowsPrec :: Int -> ConnReqData -> ShowS
Show)

data ConnReqScheme = CRSSimplex | CRSAppServer HostName (Maybe ServiceName)
  deriving (ConnReqScheme -> ConnReqScheme -> Bool
(ConnReqScheme -> ConnReqScheme -> Bool)
-> (ConnReqScheme -> ConnReqScheme -> Bool) -> Eq ConnReqScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnReqScheme -> ConnReqScheme -> Bool
$c/= :: ConnReqScheme -> ConnReqScheme -> Bool
== :: ConnReqScheme -> ConnReqScheme -> Bool
$c== :: ConnReqScheme -> ConnReqScheme -> Bool
Eq, Int -> ConnReqScheme -> ShowS
[ConnReqScheme] -> ShowS
ConnReqScheme -> String
(Int -> ConnReqScheme -> ShowS)
-> (ConnReqScheme -> String)
-> ([ConnReqScheme] -> ShowS)
-> Show ConnReqScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnReqScheme] -> ShowS
$cshowList :: [ConnReqScheme] -> ShowS
show :: ConnReqScheme -> String
$cshow :: ConnReqScheme -> String
showsPrec :: Int -> ConnReqScheme -> ShowS
$cshowsPrec :: Int -> ConnReqScheme -> ShowS
Show)

simplexChat :: ConnReqScheme
simplexChat :: ConnReqScheme
simplexChat = String -> Maybe String -> ConnReqScheme
CRSAppServer String
"simplex.chat" Maybe String
forall a. Maybe a
Nothing

-- | Public key used to E2E encrypt SMP messages.
type EncryptionKey = C.PublicKey

-- | Private key used to E2E decrypt SMP messages.
type DecryptionKey = C.SafePrivateKey

-- | Private key used to sign SMP commands
type SignatureKey = C.APrivateKey

-- | Public key used by SMP server to authorize (verify) SMP commands.
type VerificationKey = C.PublicKey

data QueueDirection = SND | RCV deriving (Int -> QueueDirection -> ShowS
[QueueDirection] -> ShowS
QueueDirection -> String
(Int -> QueueDirection -> ShowS)
-> (QueueDirection -> String)
-> ([QueueDirection] -> ShowS)
-> Show QueueDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueueDirection] -> ShowS
$cshowList :: [QueueDirection] -> ShowS
show :: QueueDirection -> String
$cshow :: QueueDirection -> String
showsPrec :: Int -> QueueDirection -> ShowS
$cshowsPrec :: Int -> QueueDirection -> ShowS
Show)

-- | 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 -> Bool
(QueueStatus -> QueueStatus -> Bool)
-> (QueueStatus -> QueueStatus -> Bool) -> Eq QueueStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueueStatus -> QueueStatus -> Bool
$c/= :: QueueStatus -> QueueStatus -> Bool
== :: QueueStatus -> QueueStatus -> Bool
$c== :: QueueStatus -> QueueStatus -> Bool
Eq, Int -> QueueStatus -> ShowS
[QueueStatus] -> ShowS
QueueStatus -> String
(Int -> QueueStatus -> ShowS)
-> (QueueStatus -> String)
-> ([QueueStatus] -> ShowS)
-> Show QueueStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueueStatus] -> ShowS
$cshowList :: [QueueStatus] -> ShowS
show :: QueueStatus -> String
$cshow :: QueueStatus -> String
showsPrec :: Int -> QueueStatus -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [QueueStatus]
$creadListPrec :: ReadPrec [QueueStatus]
readPrec :: ReadPrec QueueStatus
$creadPrec :: ReadPrec QueueStatus
readList :: ReadS [QueueStatus]
$creadList :: ReadS [QueueStatus]
readsPrec :: Int -> ReadS QueueStatus
$creadsPrec :: Int -> ReadS QueueStatus
Read)

type AgentMsgId = Int64

type SenderTimestamp = UTCTime

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

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

-- | Error type used in errors sent to agent clients.
data AgentErrorType
  = -- | command or response error
    CMD CommandErrorType
  | -- | connection errors
    CONN ConnectionErrorType
  | -- | SMP protocol errors forwarded to agent clients
    SMP ErrorType
  | -- | SMP server errors
    BROKER BrokerErrorType
  | -- | errors of other agents
    AGENT SMPAgentError
  | -- | agent implementation or dependency errors
    INTERNAL String
  deriving (AgentErrorType -> AgentErrorType -> Bool
(AgentErrorType -> AgentErrorType -> Bool)
-> (AgentErrorType -> AgentErrorType -> Bool) -> Eq AgentErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AgentErrorType -> AgentErrorType -> Bool
$c/= :: AgentErrorType -> AgentErrorType -> Bool
== :: AgentErrorType -> AgentErrorType -> Bool
$c== :: AgentErrorType -> AgentErrorType -> Bool
Eq, (forall x. AgentErrorType -> Rep AgentErrorType x)
-> (forall x. Rep AgentErrorType x -> AgentErrorType)
-> Generic AgentErrorType
forall x. Rep AgentErrorType x -> AgentErrorType
forall x. AgentErrorType -> Rep AgentErrorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AgentErrorType x -> AgentErrorType
$cfrom :: forall x. AgentErrorType -> Rep AgentErrorType x
Generic, ReadPrec [AgentErrorType]
ReadPrec AgentErrorType
Int -> ReadS AgentErrorType
ReadS [AgentErrorType]
(Int -> ReadS AgentErrorType)
-> ReadS [AgentErrorType]
-> ReadPrec AgentErrorType
-> ReadPrec [AgentErrorType]
-> Read AgentErrorType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AgentErrorType]
$creadListPrec :: ReadPrec [AgentErrorType]
readPrec :: ReadPrec AgentErrorType
$creadPrec :: ReadPrec AgentErrorType
readList :: ReadS [AgentErrorType]
$creadList :: ReadS [AgentErrorType]
readsPrec :: Int -> ReadS AgentErrorType
$creadsPrec :: Int -> ReadS AgentErrorType
Read, Int -> AgentErrorType -> ShowS
[AgentErrorType] -> ShowS
AgentErrorType -> String
(Int -> AgentErrorType -> ShowS)
-> (AgentErrorType -> String)
-> ([AgentErrorType] -> ShowS)
-> Show AgentErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AgentErrorType] -> ShowS
$cshowList :: [AgentErrorType] -> ShowS
show :: AgentErrorType -> String
$cshow :: AgentErrorType -> String
showsPrec :: Int -> AgentErrorType -> ShowS
$cshowsPrec :: Int -> AgentErrorType -> ShowS
Show, Show AgentErrorType
Typeable AgentErrorType
Typeable AgentErrorType
-> Show AgentErrorType
-> (AgentErrorType -> SomeException)
-> (SomeException -> Maybe AgentErrorType)
-> (AgentErrorType -> String)
-> Exception AgentErrorType
SomeException -> Maybe AgentErrorType
AgentErrorType -> String
AgentErrorType -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: AgentErrorType -> String
$cdisplayException :: AgentErrorType -> String
fromException :: SomeException -> Maybe AgentErrorType
$cfromException :: SomeException -> Maybe AgentErrorType
toException :: AgentErrorType -> SomeException
$ctoException :: AgentErrorType -> SomeException
$cp2Exception :: Show AgentErrorType
$cp1Exception :: Typeable AgentErrorType
Exception)

-- | 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 -> Bool
(CommandErrorType -> CommandErrorType -> Bool)
-> (CommandErrorType -> CommandErrorType -> Bool)
-> Eq CommandErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandErrorType -> CommandErrorType -> Bool
$c/= :: CommandErrorType -> CommandErrorType -> Bool
== :: CommandErrorType -> CommandErrorType -> Bool
$c== :: CommandErrorType -> CommandErrorType -> Bool
Eq, (forall x. CommandErrorType -> Rep CommandErrorType x)
-> (forall x. Rep CommandErrorType x -> CommandErrorType)
-> Generic CommandErrorType
forall x. Rep CommandErrorType x -> CommandErrorType
forall x. CommandErrorType -> Rep CommandErrorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CommandErrorType x -> CommandErrorType
$cfrom :: forall x. CommandErrorType -> Rep CommandErrorType x
Generic, 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
readListPrec :: ReadPrec [CommandErrorType]
$creadListPrec :: ReadPrec [CommandErrorType]
readPrec :: ReadPrec CommandErrorType
$creadPrec :: ReadPrec CommandErrorType
readList :: ReadS [CommandErrorType]
$creadList :: ReadS [CommandErrorType]
readsPrec :: Int -> ReadS CommandErrorType
$creadsPrec :: Int -> ReadS CommandErrorType
Read, Int -> CommandErrorType -> ShowS
[CommandErrorType] -> ShowS
CommandErrorType -> String
(Int -> CommandErrorType -> ShowS)
-> (CommandErrorType -> String)
-> ([CommandErrorType] -> ShowS)
-> Show CommandErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandErrorType] -> ShowS
$cshowList :: [CommandErrorType] -> ShowS
show :: CommandErrorType -> String
$cshow :: CommandErrorType -> String
showsPrec :: Int -> CommandErrorType -> ShowS
$cshowsPrec :: Int -> CommandErrorType -> ShowS
Show, Show CommandErrorType
Typeable CommandErrorType
Typeable CommandErrorType
-> Show CommandErrorType
-> (CommandErrorType -> SomeException)
-> (SomeException -> Maybe CommandErrorType)
-> (CommandErrorType -> String)
-> Exception CommandErrorType
SomeException -> Maybe CommandErrorType
CommandErrorType -> String
CommandErrorType -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: CommandErrorType -> String
$cdisplayException :: CommandErrorType -> String
fromException :: SomeException -> Maybe CommandErrorType
$cfromException :: SomeException -> Maybe CommandErrorType
toException :: CommandErrorType -> SomeException
$ctoException :: CommandErrorType -> SomeException
$cp2Exception :: Show CommandErrorType
$cp1Exception :: Typeable CommandErrorType
Exception)

-- | Connection error.
data ConnectionErrorType
  = -- | connection alias is not in the database
    NOT_FOUND
  | -- | connection alias already exists
    DUPLICATE
  | -- | connection is simplex, but operation requires another queue
    SIMPLEX
  deriving (ConnectionErrorType -> ConnectionErrorType -> Bool
(ConnectionErrorType -> ConnectionErrorType -> Bool)
-> (ConnectionErrorType -> ConnectionErrorType -> Bool)
-> Eq ConnectionErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionErrorType -> ConnectionErrorType -> Bool
$c/= :: ConnectionErrorType -> ConnectionErrorType -> Bool
== :: ConnectionErrorType -> ConnectionErrorType -> Bool
$c== :: ConnectionErrorType -> ConnectionErrorType -> Bool
Eq, (forall x. ConnectionErrorType -> Rep ConnectionErrorType x)
-> (forall x. Rep ConnectionErrorType x -> ConnectionErrorType)
-> Generic ConnectionErrorType
forall x. Rep ConnectionErrorType x -> ConnectionErrorType
forall x. ConnectionErrorType -> Rep ConnectionErrorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConnectionErrorType x -> ConnectionErrorType
$cfrom :: forall x. ConnectionErrorType -> Rep ConnectionErrorType x
Generic, 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
readListPrec :: ReadPrec [ConnectionErrorType]
$creadListPrec :: ReadPrec [ConnectionErrorType]
readPrec :: ReadPrec ConnectionErrorType
$creadPrec :: ReadPrec ConnectionErrorType
readList :: ReadS [ConnectionErrorType]
$creadList :: ReadS [ConnectionErrorType]
readsPrec :: Int -> ReadS ConnectionErrorType
$creadsPrec :: Int -> ReadS ConnectionErrorType
Read, Int -> ConnectionErrorType -> ShowS
[ConnectionErrorType] -> ShowS
ConnectionErrorType -> String
(Int -> ConnectionErrorType -> ShowS)
-> (ConnectionErrorType -> String)
-> ([ConnectionErrorType] -> ShowS)
-> Show ConnectionErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionErrorType] -> ShowS
$cshowList :: [ConnectionErrorType] -> ShowS
show :: ConnectionErrorType -> String
$cshow :: ConnectionErrorType -> String
showsPrec :: Int -> ConnectionErrorType -> ShowS
$cshowsPrec :: Int -> ConnectionErrorType -> ShowS
Show, Show ConnectionErrorType
Typeable ConnectionErrorType
Typeable ConnectionErrorType
-> Show ConnectionErrorType
-> (ConnectionErrorType -> SomeException)
-> (SomeException -> Maybe ConnectionErrorType)
-> (ConnectionErrorType -> String)
-> Exception ConnectionErrorType
SomeException -> Maybe ConnectionErrorType
ConnectionErrorType -> String
ConnectionErrorType -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ConnectionErrorType -> String
$cdisplayException :: ConnectionErrorType -> String
fromException :: SomeException -> Maybe ConnectionErrorType
$cfromException :: SomeException -> Maybe ConnectionErrorType
toException :: ConnectionErrorType -> SomeException
$ctoException :: ConnectionErrorType -> SomeException
$cp2Exception :: Show ConnectionErrorType
$cp1Exception :: Typeable ConnectionErrorType
Exception)

-- | SMP server errors.
data BrokerErrorType
  = -- | invalid server response (failed to parse)
    RESPONSE ErrorType
  | -- | unexpected response
    UNEXPECTED
  | -- | network error
    NETWORK
  | -- | handshake or other transport error
    TRANSPORT TransportError
  | -- | command response timeout
    TIMEOUT
  deriving (BrokerErrorType -> BrokerErrorType -> Bool
(BrokerErrorType -> BrokerErrorType -> Bool)
-> (BrokerErrorType -> BrokerErrorType -> Bool)
-> Eq BrokerErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BrokerErrorType -> BrokerErrorType -> Bool
$c/= :: BrokerErrorType -> BrokerErrorType -> Bool
== :: BrokerErrorType -> BrokerErrorType -> Bool
$c== :: BrokerErrorType -> BrokerErrorType -> Bool
Eq, (forall x. BrokerErrorType -> Rep BrokerErrorType x)
-> (forall x. Rep BrokerErrorType x -> BrokerErrorType)
-> Generic BrokerErrorType
forall x. Rep BrokerErrorType x -> BrokerErrorType
forall x. BrokerErrorType -> Rep BrokerErrorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BrokerErrorType x -> BrokerErrorType
$cfrom :: forall x. BrokerErrorType -> Rep BrokerErrorType x
Generic, ReadPrec [BrokerErrorType]
ReadPrec BrokerErrorType
Int -> ReadS BrokerErrorType
ReadS [BrokerErrorType]
(Int -> ReadS BrokerErrorType)
-> ReadS [BrokerErrorType]
-> ReadPrec BrokerErrorType
-> ReadPrec [BrokerErrorType]
-> Read BrokerErrorType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BrokerErrorType]
$creadListPrec :: ReadPrec [BrokerErrorType]
readPrec :: ReadPrec BrokerErrorType
$creadPrec :: ReadPrec BrokerErrorType
readList :: ReadS [BrokerErrorType]
$creadList :: ReadS [BrokerErrorType]
readsPrec :: Int -> ReadS BrokerErrorType
$creadsPrec :: Int -> ReadS BrokerErrorType
Read, Int -> BrokerErrorType -> ShowS
[BrokerErrorType] -> ShowS
BrokerErrorType -> String
(Int -> BrokerErrorType -> ShowS)
-> (BrokerErrorType -> String)
-> ([BrokerErrorType] -> ShowS)
-> Show BrokerErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrokerErrorType] -> ShowS
$cshowList :: [BrokerErrorType] -> ShowS
show :: BrokerErrorType -> String
$cshow :: BrokerErrorType -> String
showsPrec :: Int -> BrokerErrorType -> ShowS
$cshowsPrec :: Int -> BrokerErrorType -> ShowS
Show, Show BrokerErrorType
Typeable BrokerErrorType
Typeable BrokerErrorType
-> Show BrokerErrorType
-> (BrokerErrorType -> SomeException)
-> (SomeException -> Maybe BrokerErrorType)
-> (BrokerErrorType -> String)
-> Exception BrokerErrorType
SomeException -> Maybe BrokerErrorType
BrokerErrorType -> String
BrokerErrorType -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: BrokerErrorType -> String
$cdisplayException :: BrokerErrorType -> String
fromException :: SomeException -> Maybe BrokerErrorType
$cfromException :: SomeException -> Maybe BrokerErrorType
toException :: BrokerErrorType -> SomeException
$ctoException :: BrokerErrorType -> SomeException
$cp2Exception :: Show BrokerErrorType
$cp1Exception :: Typeable BrokerErrorType
Exception)

-- | Errors of another SMP agent.
data SMPAgentError
  = -- | possibly should include bytestring that failed to parse
    A_MESSAGE
  | -- | possibly should include the prohibited SMP/agent message
    A_PROHIBITED
  | -- | cannot RSA/AES-decrypt or parse decrypted header
    A_ENCRYPTION
  | -- | invalid RSA signature
    A_SIGNATURE
  deriving (SMPAgentError -> SMPAgentError -> Bool
(SMPAgentError -> SMPAgentError -> Bool)
-> (SMPAgentError -> SMPAgentError -> Bool) -> Eq SMPAgentError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SMPAgentError -> SMPAgentError -> Bool
$c/= :: SMPAgentError -> SMPAgentError -> Bool
== :: SMPAgentError -> SMPAgentError -> Bool
$c== :: SMPAgentError -> SMPAgentError -> Bool
Eq, (forall x. SMPAgentError -> Rep SMPAgentError x)
-> (forall x. Rep SMPAgentError x -> SMPAgentError)
-> Generic SMPAgentError
forall x. Rep SMPAgentError x -> SMPAgentError
forall x. SMPAgentError -> Rep SMPAgentError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SMPAgentError x -> SMPAgentError
$cfrom :: forall x. SMPAgentError -> Rep SMPAgentError x
Generic, ReadPrec [SMPAgentError]
ReadPrec SMPAgentError
Int -> ReadS SMPAgentError
ReadS [SMPAgentError]
(Int -> ReadS SMPAgentError)
-> ReadS [SMPAgentError]
-> ReadPrec SMPAgentError
-> ReadPrec [SMPAgentError]
-> Read SMPAgentError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SMPAgentError]
$creadListPrec :: ReadPrec [SMPAgentError]
readPrec :: ReadPrec SMPAgentError
$creadPrec :: ReadPrec SMPAgentError
readList :: ReadS [SMPAgentError]
$creadList :: ReadS [SMPAgentError]
readsPrec :: Int -> ReadS SMPAgentError
$creadsPrec :: Int -> ReadS SMPAgentError
Read, Int -> SMPAgentError -> ShowS
[SMPAgentError] -> ShowS
SMPAgentError -> String
(Int -> SMPAgentError -> ShowS)
-> (SMPAgentError -> String)
-> ([SMPAgentError] -> ShowS)
-> Show SMPAgentError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SMPAgentError] -> ShowS
$cshowList :: [SMPAgentError] -> ShowS
show :: SMPAgentError -> String
$cshow :: SMPAgentError -> String
showsPrec :: Int -> SMPAgentError -> ShowS
$cshowsPrec :: Int -> SMPAgentError -> ShowS
Show, Show SMPAgentError
Typeable SMPAgentError
Typeable SMPAgentError
-> Show SMPAgentError
-> (SMPAgentError -> SomeException)
-> (SomeException -> Maybe SMPAgentError)
-> (SMPAgentError -> String)
-> Exception SMPAgentError
SomeException -> Maybe SMPAgentError
SMPAgentError -> String
SMPAgentError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: SMPAgentError -> String
$cdisplayException :: SMPAgentError -> String
fromException :: SomeException -> Maybe SMPAgentError
$cfromException :: SomeException -> Maybe SMPAgentError
toException :: SMPAgentError -> SomeException
$ctoException :: SMPAgentError -> SomeException
$cp2Exception :: Show SMPAgentError
$cp1Exception :: Typeable SMPAgentError
Exception)

instance Arbitrary AgentErrorType where arbitrary :: Gen AgentErrorType
arbitrary = Gen AgentErrorType
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU

instance Arbitrary CommandErrorType where arbitrary :: Gen CommandErrorType
arbitrary = Gen CommandErrorType
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU

instance Arbitrary ConnectionErrorType where arbitrary :: Gen ConnectionErrorType
arbitrary = Gen ConnectionErrorType
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU

instance Arbitrary BrokerErrorType where arbitrary :: Gen BrokerErrorType
arbitrary = Gen BrokerErrorType
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU

instance Arbitrary SMPAgentError where arbitrary :: Gen SMPAgentError
arbitrary = Gen SMPAgentError
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU

-- | SMP agent command and response parser
commandP :: Parser ACmd
commandP :: Parser ACmd
commandP =
  Parser MsgId MsgId
"NEW " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
newCmd
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"INV " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
invResp
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"JOIN " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
joinCmd
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"CONF " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
confMsg
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"LET " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
letCmd
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"REQ " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
reqMsg
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"ACPT " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
acptCmd
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"RJCT " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
rjctCmd
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"INFO " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
infoCmd
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"SUB" Parser MsgId MsgId -> ACmd -> Parser ACmd
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SAParty 'Client -> ACommand 'Client -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Client
SClient ACommand 'Client
SUB
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"END" Parser MsgId MsgId -> ACmd -> Parser ACmd
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent ACommand 'Agent
END
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"DOWN" Parser MsgId MsgId -> ACmd -> Parser ACmd
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent ACommand 'Agent
DOWN
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"UP" Parser MsgId MsgId -> ACmd -> Parser ACmd
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent ACommand 'Agent
UP
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"SEND " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
sendCmd
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"MID " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
msgIdResp
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"SENT " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
sentResp
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"MERR " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
msgErrResp
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"MSG " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
message
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"ACK " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
ackCmd
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"OFF" Parser MsgId MsgId -> ACmd -> Parser ACmd
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SAParty 'Client -> ACommand 'Client -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Client
SClient ACommand 'Client
OFF
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"DEL" Parser MsgId MsgId -> ACmd -> Parser ACmd
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SAParty 'Client -> ACommand 'Client -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Client
SClient ACommand 'Client
DEL
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"ERR " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
agentError
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"CON" Parser MsgId MsgId -> ACmd -> Parser ACmd
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent ACommand 'Agent
CON
    Parser ACmd -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"OK" Parser MsgId MsgId -> ACmd -> Parser ACmd
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent ACommand 'Agent
OK
  where
    newCmd :: Parser ACmd
newCmd = SAParty 'Client -> ACommand 'Client -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Client
SClient (ACommand 'Client -> ACmd)
-> (AConnectionMode -> ACommand 'Client) -> AConnectionMode -> ACmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AConnectionMode -> ACommand 'Client
NEW (AConnectionMode -> ACmd) -> Parser AConnectionMode -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AConnectionMode
connModeP
    invResp :: Parser ACmd
invResp = SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent (ACommand 'Agent -> ACmd)
-> (AConnectionRequest -> ACommand 'Agent)
-> AConnectionRequest
-> ACmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AConnectionRequest -> ACommand 'Agent
INV (AConnectionRequest -> ACmd)
-> Parser AConnectionRequest -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AConnectionRequest
connReqP
    joinCmd :: Parser ACmd
joinCmd = SAParty 'Client -> ACommand 'Client -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Client
SClient (ACommand 'Client -> ACmd)
-> Parser MsgId (ACommand 'Client) -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AConnectionRequest -> MsgId -> ACommand 'Client
JOIN (AConnectionRequest -> MsgId -> ACommand 'Client)
-> Parser AConnectionRequest
-> Parser MsgId (MsgId -> ACommand 'Client)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AConnectionRequest
connReqP Parser MsgId (MsgId -> ACommand 'Client)
-> Parser MsgId Char -> Parser MsgId (MsgId -> ACommand 'Client)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space Parser MsgId (MsgId -> ACommand 'Client)
-> Parser MsgId MsgId -> Parser MsgId (ACommand 'Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId MsgId
A.takeByteString)
    confMsg :: Parser ACmd
confMsg = SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent (ACommand 'Agent -> ACmd)
-> Parser MsgId (ACommand 'Agent) -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MsgId -> MsgId -> ACommand 'Agent
CONF (MsgId -> MsgId -> ACommand 'Agent)
-> Parser MsgId MsgId -> Parser MsgId (MsgId -> ACommand 'Agent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser MsgId MsgId
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser MsgId (MsgId -> ACommand 'Agent)
-> Parser MsgId Char -> Parser MsgId (MsgId -> ACommand 'Agent)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space Parser MsgId (MsgId -> ACommand 'Agent)
-> Parser MsgId MsgId -> Parser MsgId (ACommand 'Agent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId MsgId
A.takeByteString)
    letCmd :: Parser ACmd
letCmd = SAParty 'Client -> ACommand 'Client -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Client
SClient (ACommand 'Client -> ACmd)
-> Parser MsgId (ACommand 'Client) -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MsgId -> MsgId -> ACommand 'Client
LET (MsgId -> MsgId -> ACommand 'Client)
-> Parser MsgId MsgId -> Parser MsgId (MsgId -> ACommand 'Client)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser MsgId MsgId
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser MsgId (MsgId -> ACommand 'Client)
-> Parser MsgId Char -> Parser MsgId (MsgId -> ACommand 'Client)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space Parser MsgId (MsgId -> ACommand 'Client)
-> Parser MsgId MsgId -> Parser MsgId (ACommand 'Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId MsgId
A.takeByteString)
    reqMsg :: Parser ACmd
reqMsg = SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent (ACommand 'Agent -> ACmd)
-> Parser MsgId (ACommand 'Agent) -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MsgId -> MsgId -> ACommand 'Agent
REQ (MsgId -> MsgId -> ACommand 'Agent)
-> Parser MsgId MsgId -> Parser MsgId (MsgId -> ACommand 'Agent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser MsgId MsgId
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser MsgId (MsgId -> ACommand 'Agent)
-> Parser MsgId Char -> Parser MsgId (MsgId -> ACommand 'Agent)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space Parser MsgId (MsgId -> ACommand 'Agent)
-> Parser MsgId MsgId -> Parser MsgId (ACommand 'Agent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId MsgId
A.takeByteString)
    acptCmd :: Parser ACmd
acptCmd = SAParty 'Client -> ACommand 'Client -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Client
SClient (ACommand 'Client -> ACmd)
-> Parser MsgId (ACommand 'Client) -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MsgId -> MsgId -> ACommand 'Client
ACPT (MsgId -> MsgId -> ACommand 'Client)
-> Parser MsgId MsgId -> Parser MsgId (MsgId -> ACommand 'Client)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser MsgId MsgId
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser MsgId (MsgId -> ACommand 'Client)
-> Parser MsgId Char -> Parser MsgId (MsgId -> ACommand 'Client)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space Parser MsgId (MsgId -> ACommand 'Client)
-> Parser MsgId MsgId -> Parser MsgId (ACommand 'Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId MsgId
A.takeByteString)
    rjctCmd :: Parser ACmd
rjctCmd = SAParty 'Client -> ACommand 'Client -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Client
SClient (ACommand 'Client -> ACmd)
-> (MsgId -> ACommand 'Client) -> MsgId -> ACmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgId -> ACommand 'Client
RJCT (MsgId -> ACmd) -> Parser MsgId MsgId -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId MsgId
A.takeByteString
    infoCmd :: Parser ACmd
infoCmd = SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent (ACommand 'Agent -> ACmd)
-> (MsgId -> ACommand 'Agent) -> MsgId -> ACmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgId -> ACommand 'Agent
INFO (MsgId -> ACmd) -> Parser MsgId MsgId -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId MsgId
A.takeByteString
    sendCmd :: Parser ACmd
sendCmd = SAParty 'Client -> ACommand 'Client -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Client
SClient (ACommand 'Client -> ACmd)
-> (MsgId -> ACommand 'Client) -> MsgId -> ACmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgId -> ACommand 'Client
SEND (MsgId -> ACmd) -> Parser MsgId MsgId -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId MsgId
A.takeByteString
    msgIdResp :: Parser ACmd
msgIdResp = SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent (ACommand 'Agent -> ACmd)
-> (AgentMsgId -> ACommand 'Agent) -> AgentMsgId -> ACmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AgentMsgId -> ACommand 'Agent
MID (AgentMsgId -> ACmd) -> Parser MsgId AgentMsgId -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId AgentMsgId
forall a. Integral a => Parser a
A.decimal
    sentResp :: Parser ACmd
sentResp = SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent (ACommand 'Agent -> ACmd)
-> (AgentMsgId -> ACommand 'Agent) -> AgentMsgId -> ACmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AgentMsgId -> ACommand 'Agent
SENT (AgentMsgId -> ACmd) -> Parser MsgId AgentMsgId -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId AgentMsgId
forall a. Integral a => Parser a
A.decimal
    msgErrResp :: Parser ACmd
msgErrResp = SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent (ACommand 'Agent -> ACmd)
-> Parser MsgId (ACommand 'Agent) -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentMsgId -> AgentErrorType -> ACommand 'Agent
MERR (AgentMsgId -> AgentErrorType -> ACommand 'Agent)
-> Parser MsgId AgentMsgId
-> Parser MsgId (AgentErrorType -> ACommand 'Agent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId AgentMsgId
forall a. Integral a => Parser a
A.decimal Parser MsgId (AgentErrorType -> ACommand 'Agent)
-> Parser MsgId Char
-> Parser MsgId (AgentErrorType -> ACommand 'Agent)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space Parser MsgId (AgentErrorType -> ACommand 'Agent)
-> Parser MsgId AgentErrorType -> Parser MsgId (ACommand 'Agent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId AgentErrorType
agentErrorTypeP)
    message :: Parser ACmd
message = SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent (ACommand 'Agent -> ACmd)
-> Parser MsgId (ACommand 'Agent) -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MsgMeta -> MsgId -> ACommand 'Agent
MSG (MsgMeta -> MsgId -> ACommand 'Agent)
-> Parser MsgId MsgMeta -> Parser MsgId (MsgId -> ACommand 'Agent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId MsgMeta
msgMetaP Parser MsgId (MsgId -> ACommand 'Agent)
-> Parser MsgId Char -> Parser MsgId (MsgId -> ACommand 'Agent)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space Parser MsgId (MsgId -> ACommand 'Agent)
-> Parser MsgId MsgId -> Parser MsgId (ACommand 'Agent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId MsgId
A.takeByteString)
    ackCmd :: Parser ACmd
ackCmd = SAParty 'Client -> ACommand 'Client -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Client
SClient (ACommand 'Client -> ACmd)
-> (AgentMsgId -> ACommand 'Client) -> AgentMsgId -> ACmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AgentMsgId -> ACommand 'Client
ACK (AgentMsgId -> ACmd) -> Parser MsgId AgentMsgId -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId AgentMsgId
forall a. Integral a => Parser a
A.decimal
    msgMetaP :: Parser MsgId MsgMeta
msgMetaP = do
      MsgIntegrity
integrity <- Parser MsgIntegrity
msgIntegrityP
      (AgentMsgId, UTCTime)
recipient <- Parser MsgId MsgId
" R=" Parser MsgId MsgId
-> Parser MsgId (AgentMsgId, UTCTime)
-> Parser MsgId (AgentMsgId, UTCTime)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser MsgId AgentMsgId -> Parser MsgId (AgentMsgId, UTCTime)
forall a. Parser MsgId a -> Parser MsgId (a, UTCTime)
partyMeta Parser MsgId AgentMsgId
forall a. Integral a => Parser a
A.decimal
      (MsgId, UTCTime)
broker <- Parser MsgId MsgId
" B=" Parser MsgId MsgId
-> Parser MsgId (MsgId, UTCTime) -> Parser MsgId (MsgId, UTCTime)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser MsgId MsgId -> Parser MsgId (MsgId, UTCTime)
forall a. Parser MsgId a -> Parser MsgId (a, UTCTime)
partyMeta Parser MsgId MsgId
base64P
      (AgentMsgId, UTCTime)
sender <- Parser MsgId MsgId
" S=" Parser MsgId MsgId
-> Parser MsgId (AgentMsgId, UTCTime)
-> Parser MsgId (AgentMsgId, UTCTime)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser MsgId AgentMsgId -> Parser MsgId (AgentMsgId, UTCTime)
forall a. Parser MsgId a -> Parser MsgId (a, UTCTime)
partyMeta Parser MsgId AgentMsgId
forall a. Integral a => Parser a
A.decimal
      MsgMeta -> Parser MsgId MsgMeta
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgMeta :: MsgIntegrity
-> (AgentMsgId, UTCTime)
-> (MsgId, UTCTime)
-> (AgentMsgId, UTCTime)
-> MsgMeta
MsgMeta {MsgIntegrity
integrity :: MsgIntegrity
integrity :: MsgIntegrity
integrity, (AgentMsgId, UTCTime)
recipient :: (AgentMsgId, UTCTime)
recipient :: (AgentMsgId, UTCTime)
recipient, (MsgId, UTCTime)
broker :: (MsgId, UTCTime)
broker :: (MsgId, UTCTime)
broker, (AgentMsgId, UTCTime)
sender :: (AgentMsgId, UTCTime)
sender :: (AgentMsgId, UTCTime)
sender}
    partyMeta :: Parser MsgId a -> Parser MsgId (a, UTCTime)
partyMeta Parser MsgId a
idParser = (,) (a -> UTCTime -> (a, UTCTime))
-> Parser MsgId a -> Parser MsgId (UTCTime -> (a, UTCTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId a
idParser Parser MsgId (UTCTime -> (a, UTCTime))
-> Parser MsgId MsgId -> Parser MsgId (UTCTime -> (a, UTCTime))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId MsgId
"," Parser MsgId (UTCTime -> (a, UTCTime))
-> Parser MsgId UTCTime -> Parser MsgId (a, UTCTime)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId UTCTime
tsISO8601P
    agentError :: Parser ACmd
agentError = SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent (ACommand 'Agent -> ACmd)
-> (AgentErrorType -> ACommand 'Agent) -> AgentErrorType -> ACmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AgentErrorType -> ACommand 'Agent
ERR (AgentErrorType -> ACmd)
-> Parser MsgId AgentErrorType -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId AgentErrorType
agentErrorTypeP

-- | Message integrity validation result parser.
msgIntegrityP :: Parser MsgIntegrity
msgIntegrityP :: Parser MsgIntegrity
msgIntegrityP = Parser MsgId MsgId
"OK" Parser MsgId MsgId -> MsgIntegrity -> Parser MsgIntegrity
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MsgIntegrity
MsgOk Parser MsgIntegrity -> Parser MsgIntegrity -> Parser MsgIntegrity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"ERR " Parser MsgId MsgId -> Parser MsgIntegrity -> Parser MsgIntegrity
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (MsgErrorType -> MsgIntegrity
MsgError (MsgErrorType -> MsgIntegrity)
-> Parser MsgId MsgErrorType -> Parser MsgIntegrity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId MsgErrorType
msgErrorType)
  where
    msgErrorType :: Parser MsgId MsgErrorType
msgErrorType =
      Parser MsgId MsgId
"ID " Parser MsgId MsgId
-> Parser MsgId MsgErrorType -> Parser MsgId MsgErrorType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AgentMsgId -> MsgErrorType
MsgBadId (AgentMsgId -> MsgErrorType)
-> Parser MsgId AgentMsgId -> Parser MsgId MsgErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId AgentMsgId
forall a. Integral a => Parser a
A.decimal)
        Parser MsgId MsgErrorType
-> Parser MsgId MsgErrorType -> Parser MsgId MsgErrorType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"IDS " Parser MsgId MsgId
-> Parser MsgId MsgErrorType -> Parser MsgId MsgErrorType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AgentMsgId -> AgentMsgId -> MsgErrorType
MsgSkipped (AgentMsgId -> AgentMsgId -> MsgErrorType)
-> Parser MsgId AgentMsgId
-> Parser MsgId (AgentMsgId -> MsgErrorType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId AgentMsgId
forall a. Integral a => Parser a
A.decimal Parser MsgId (AgentMsgId -> MsgErrorType)
-> Parser MsgId Char -> Parser MsgId (AgentMsgId -> MsgErrorType)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space Parser MsgId (AgentMsgId -> MsgErrorType)
-> Parser MsgId AgentMsgId -> Parser MsgId MsgErrorType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId AgentMsgId
forall a. Integral a => Parser a
A.decimal)
        Parser MsgId MsgErrorType
-> Parser MsgId MsgErrorType -> Parser MsgId MsgErrorType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"HASH" Parser MsgId MsgId -> MsgErrorType -> Parser MsgId MsgErrorType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MsgErrorType
MsgBadHash
        Parser MsgId MsgErrorType
-> Parser MsgId MsgErrorType -> Parser MsgId MsgErrorType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"DUPLICATE" Parser MsgId MsgId -> MsgErrorType -> Parser MsgId MsgErrorType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MsgErrorType
MsgDuplicate

parseCommand :: ByteString -> Either AgentErrorType ACmd
parseCommand :: MsgId -> Either AgentErrorType ACmd
parseCommand = Parser ACmd
-> AgentErrorType -> MsgId -> Either AgentErrorType ACmd
forall a e. Parser a -> e -> MsgId -> Either e a
parse Parser ACmd
commandP (AgentErrorType -> MsgId -> Either AgentErrorType ACmd)
-> AgentErrorType -> MsgId -> Either AgentErrorType ACmd
forall a b. (a -> b) -> a -> b
$ CommandErrorType -> AgentErrorType
CMD CommandErrorType
SYNTAX

-- | Serialize SMP agent command.
serializeCommand :: ACommand p -> ByteString
serializeCommand :: ACommand p -> MsgId
serializeCommand = \case
  NEW AConnectionMode
cMode -> MsgId
"NEW " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> AConnectionMode -> MsgId
serializeConnMode AConnectionMode
cMode
  INV AConnectionRequest
cReq -> MsgId
"INV " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> AConnectionRequest -> MsgId
serializeConnReq AConnectionRequest
cReq
  JOIN AConnectionRequest
cReq MsgId
cInfo -> [MsgId] -> MsgId
B.unwords [MsgId
"JOIN", AConnectionRequest -> MsgId
serializeConnReq AConnectionRequest
cReq, MsgId -> MsgId
serializeBinary MsgId
cInfo]
  CONF MsgId
confId MsgId
cInfo -> [MsgId] -> MsgId
B.unwords [MsgId
"CONF", MsgId
confId, MsgId -> MsgId
serializeBinary MsgId
cInfo]
  LET MsgId
confId MsgId
cInfo -> [MsgId] -> MsgId
B.unwords [MsgId
"LET", MsgId
confId, MsgId -> MsgId
serializeBinary MsgId
cInfo]
  REQ MsgId
invId MsgId
cInfo -> [MsgId] -> MsgId
B.unwords [MsgId
"REQ", MsgId
invId, MsgId -> MsgId
serializeBinary MsgId
cInfo]
  ACPT MsgId
invId MsgId
cInfo -> [MsgId] -> MsgId
B.unwords [MsgId
"ACPT", MsgId
invId, MsgId -> MsgId
serializeBinary MsgId
cInfo]
  RJCT MsgId
invId -> MsgId
"RJCT " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
invId
  INFO MsgId
cInfo -> MsgId
"INFO " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId -> MsgId
serializeBinary MsgId
cInfo
  ACommand p
SUB -> MsgId
"SUB"
  ACommand p
END -> MsgId
"END"
  ACommand p
DOWN -> MsgId
"DOWN"
  ACommand p
UP -> MsgId
"UP"
  SEND MsgId
msgBody -> MsgId
"SEND " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId -> MsgId
serializeBinary MsgId
msgBody
  MID AgentMsgId
mId -> MsgId
"MID " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> AgentMsgId -> MsgId
forall a. Show a => a -> MsgId
bshow AgentMsgId
mId
  SENT AgentMsgId
mId -> MsgId
"SENT " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> AgentMsgId -> MsgId
forall a. Show a => a -> MsgId
bshow AgentMsgId
mId
  MERR AgentMsgId
mId AgentErrorType
e -> [MsgId] -> MsgId
B.unwords [MsgId
"MERR", AgentMsgId -> MsgId
forall a. Show a => a -> MsgId
bshow AgentMsgId
mId, AgentErrorType -> MsgId
serializeAgentError AgentErrorType
e]
  MSG MsgMeta
msgMeta MsgId
msgBody -> [MsgId] -> MsgId
B.unwords [MsgId
"MSG", MsgMeta -> MsgId
serializeMsgMeta MsgMeta
msgMeta, MsgId -> MsgId
serializeBinary MsgId
msgBody]
  ACK AgentMsgId
mId -> MsgId
"ACK " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> AgentMsgId -> MsgId
forall a. Show a => a -> MsgId
bshow AgentMsgId
mId
  ACommand p
OFF -> MsgId
"OFF"
  ACommand p
DEL -> MsgId
"DEL"
  ACommand p
CON -> MsgId
"CON"
  ERR AgentErrorType
e -> MsgId
"ERR " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> AgentErrorType -> MsgId
serializeAgentError AgentErrorType
e
  ACommand p
OK -> MsgId
"OK"
  where
    showTs :: UTCTime -> ByteString
    showTs :: UTCTime -> MsgId
showTs = String -> MsgId
B.pack (String -> MsgId) -> (UTCTime -> String) -> UTCTime -> MsgId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
formatISO8601Millis
    serializeMsgMeta :: MsgMeta -> ByteString
    serializeMsgMeta :: MsgMeta -> MsgId
serializeMsgMeta MsgMeta {MsgIntegrity
integrity :: MsgIntegrity
integrity :: MsgMeta -> MsgIntegrity
integrity, recipient :: MsgMeta -> (AgentMsgId, UTCTime)
recipient = (AgentMsgId
rmId, UTCTime
rTs), broker :: MsgMeta -> (MsgId, UTCTime)
broker = (MsgId
bmId, UTCTime
bTs), sender :: MsgMeta -> (AgentMsgId, UTCTime)
sender = (AgentMsgId
smId, UTCTime
sTs)} =
      [MsgId] -> MsgId
B.unwords
        [ MsgIntegrity -> MsgId
serializeMsgIntegrity MsgIntegrity
integrity,
          MsgId
"R=" MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> AgentMsgId -> MsgId
forall a. Show a => a -> MsgId
bshow AgentMsgId
rmId MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
"," MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> UTCTime -> MsgId
showTs UTCTime
rTs,
          MsgId
"B=" MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId -> MsgId
encode MsgId
bmId MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
"," MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> UTCTime -> MsgId
showTs UTCTime
bTs,
          MsgId
"S=" MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> AgentMsgId -> MsgId
forall a. Show a => a -> MsgId
bshow AgentMsgId
smId MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
"," MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> UTCTime -> MsgId
showTs UTCTime
sTs
        ]

-- | Serialize message integrity validation result.
serializeMsgIntegrity :: MsgIntegrity -> ByteString
serializeMsgIntegrity :: MsgIntegrity -> MsgId
serializeMsgIntegrity = \case
  MsgIntegrity
MsgOk -> MsgId
"OK"
  MsgError MsgErrorType
e ->
    MsgId
"ERR " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> case MsgErrorType
e of
      MsgSkipped AgentMsgId
fromMsgId AgentMsgId
toMsgId ->
        [MsgId] -> MsgId
B.unwords [MsgId
"NO_ID", AgentMsgId -> MsgId
forall a. Show a => a -> MsgId
bshow AgentMsgId
fromMsgId, AgentMsgId -> MsgId
forall a. Show a => a -> MsgId
bshow AgentMsgId
toMsgId]
      MsgBadId AgentMsgId
aMsgId -> MsgId
"ID " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> AgentMsgId -> MsgId
forall a. Show a => a -> MsgId
bshow AgentMsgId
aMsgId
      MsgErrorType
MsgBadHash -> MsgId
"HASH"
      MsgErrorType
MsgDuplicate -> MsgId
"DUPLICATE"

-- | SMP agent protocol error parser.
agentErrorTypeP :: Parser AgentErrorType
agentErrorTypeP :: Parser MsgId AgentErrorType
agentErrorTypeP =
  Parser MsgId MsgId
"SMP " Parser MsgId MsgId
-> Parser MsgId AgentErrorType -> Parser MsgId AgentErrorType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ErrorType -> AgentErrorType
SMP (ErrorType -> AgentErrorType)
-> Parser MsgId ErrorType -> Parser MsgId AgentErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId ErrorType
SMP.errorTypeP)
    Parser MsgId AgentErrorType
-> Parser MsgId AgentErrorType -> Parser MsgId AgentErrorType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"BROKER RESPONSE " Parser MsgId MsgId
-> Parser MsgId AgentErrorType -> Parser MsgId AgentErrorType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (BrokerErrorType -> AgentErrorType
BROKER (BrokerErrorType -> AgentErrorType)
-> (ErrorType -> BrokerErrorType) -> ErrorType -> AgentErrorType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorType -> BrokerErrorType
RESPONSE (ErrorType -> AgentErrorType)
-> Parser MsgId ErrorType -> Parser MsgId AgentErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId ErrorType
SMP.errorTypeP)
    Parser MsgId AgentErrorType
-> Parser MsgId AgentErrorType -> Parser MsgId AgentErrorType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"BROKER TRANSPORT " Parser MsgId MsgId
-> Parser MsgId AgentErrorType -> Parser MsgId AgentErrorType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (BrokerErrorType -> AgentErrorType
BROKER (BrokerErrorType -> AgentErrorType)
-> (TransportError -> BrokerErrorType)
-> TransportError
-> AgentErrorType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransportError -> BrokerErrorType
TRANSPORT (TransportError -> AgentErrorType)
-> Parser MsgId TransportError -> Parser MsgId AgentErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId TransportError
transportErrorP)
    Parser MsgId AgentErrorType
-> Parser MsgId AgentErrorType -> Parser MsgId AgentErrorType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId MsgId
"INTERNAL " Parser MsgId MsgId
-> Parser MsgId AgentErrorType -> Parser MsgId AgentErrorType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> AgentErrorType
INTERNAL (String -> AgentErrorType)
-> Parser MsgId String -> Parser MsgId AgentErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId MsgId -> Parser MsgId String
forall a. Read a => Parser MsgId MsgId -> Parser a
parseRead Parser MsgId MsgId
A.takeByteString)
    Parser MsgId AgentErrorType
-> Parser MsgId AgentErrorType -> Parser MsgId AgentErrorType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MsgId AgentErrorType
forall a. Read a => Parser a
parseRead2

-- | Serialize SMP agent protocol error.
serializeAgentError :: AgentErrorType -> ByteString
serializeAgentError :: AgentErrorType -> MsgId
serializeAgentError = \case
  SMP ErrorType
e -> MsgId
"SMP " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> ErrorType -> MsgId
SMP.serializeErrorType ErrorType
e
  BROKER (RESPONSE ErrorType
e) -> MsgId
"BROKER RESPONSE " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> ErrorType -> MsgId
SMP.serializeErrorType ErrorType
e
  BROKER (TRANSPORT TransportError
e) -> MsgId
"BROKER TRANSPORT " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> TransportError -> MsgId
serializeTransportError TransportError
e
  AgentErrorType
e -> AgentErrorType -> MsgId
forall a. Show a => a -> MsgId
bshow AgentErrorType
e

binaryBodyP :: Parser ByteString
binaryBodyP :: Parser MsgId MsgId
binaryBodyP = do
  Int
size :: Int <- Parser Int
forall a. Integral a => Parser a
A.decimal Parser Int -> Parser MsgId () -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId ()
A.endOfLine
  Int -> Parser MsgId MsgId
A.take Int
size

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

-- | Send raw (unparsed) SMP agent protocol transmission to TCP connection.
tPutRaw :: Transport c => c -> ARawTransmission -> IO ()
tPutRaw :: c -> ARawTransmission -> IO ()
tPutRaw c
h (MsgId
corrId, MsgId
entity, MsgId
command) = do
  c -> MsgId -> IO ()
forall c. Transport c => c -> MsgId -> IO ()
putLn c
h MsgId
corrId
  c -> MsgId -> IO ()
forall c. Transport c => c -> MsgId -> IO ()
putLn c
h MsgId
entity
  c -> MsgId -> IO ()
forall c. Transport c => c -> MsgId -> IO ()
putLn c
h MsgId
command

-- | Receive raw (unparsed) SMP agent protocol transmission from TCP connection.
tGetRaw :: Transport c => c -> IO ARawTransmission
tGetRaw :: c -> IO ARawTransmission
tGetRaw c
h = (,,) (MsgId -> MsgId -> MsgId -> ARawTransmission)
-> IO MsgId -> IO (MsgId -> MsgId -> ARawTransmission)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> IO MsgId
forall c. Transport c => c -> IO MsgId
getLn c
h IO (MsgId -> MsgId -> ARawTransmission)
-> IO MsgId -> IO (MsgId -> ARawTransmission)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> IO MsgId
forall c. Transport c => c -> IO MsgId
getLn c
h IO (MsgId -> ARawTransmission) -> IO MsgId -> IO ARawTransmission
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> IO MsgId
forall c. Transport c => c -> IO MsgId
getLn c
h

-- | Send SMP agent protocol command (or response) to TCP connection.
tPut :: (Transport c, MonadIO m) => c -> ATransmission p -> m ()
tPut :: c -> ATransmission p -> m ()
tPut c
h (MsgId
corrId, MsgId
connAlias, ACommand p
command) =
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ c -> ARawTransmission -> IO ()
forall c. Transport c => c -> ARawTransmission -> IO ()
tPutRaw c
h (MsgId
corrId, MsgId
connAlias, ACommand p -> MsgId
forall (p :: AParty). ACommand p -> MsgId
serializeCommand ACommand p
command)

-- | Receive client and agent transmissions from TCP connection.
tGet :: forall c m p. (Transport c, MonadIO m) => SAParty p -> c -> m (ATransmissionOrError p)
tGet :: SAParty p -> c -> m (ATransmissionOrError p)
tGet SAParty p
party c
h = IO ARawTransmission -> m ARawTransmission
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (c -> IO ARawTransmission
forall c. Transport c => c -> IO ARawTransmission
tGetRaw c
h) m ARawTransmission
-> (ARawTransmission -> m (ATransmissionOrError p))
-> m (ATransmissionOrError p)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ARawTransmission -> m (ATransmissionOrError p)
tParseLoadBody
  where
    tParseLoadBody :: ARawTransmission -> m (ATransmissionOrError p)
    tParseLoadBody :: ARawTransmission -> m (ATransmissionOrError p)
tParseLoadBody t :: ARawTransmission
t@(MsgId
corrId, MsgId
connId, MsgId
command) = do
      let cmd :: Either AgentErrorType (ACommand p)
cmd = MsgId -> Either AgentErrorType ACmd
parseCommand MsgId
command Either AgentErrorType ACmd
-> (ACmd -> Either AgentErrorType (ACommand p))
-> Either AgentErrorType (ACommand p)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ACmd -> Either AgentErrorType (ACommand p)
fromParty Either AgentErrorType (ACommand p)
-> (ACommand p -> Either AgentErrorType (ACommand p))
-> Either AgentErrorType (ACommand p)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ARawTransmission
-> ACommand p -> Either AgentErrorType (ACommand p)
tConnId ARawTransmission
t
      Either AgentErrorType (ACommand p)
fullCmd <- (AgentErrorType -> m (Either AgentErrorType (ACommand p)))
-> (ACommand p -> m (Either AgentErrorType (ACommand p)))
-> Either AgentErrorType (ACommand p)
-> m (Either AgentErrorType (ACommand p))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either AgentErrorType (ACommand p)
-> m (Either AgentErrorType (ACommand p))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AgentErrorType (ACommand p)
 -> m (Either AgentErrorType (ACommand p)))
-> (AgentErrorType -> Either AgentErrorType (ACommand p))
-> AgentErrorType
-> m (Either AgentErrorType (ACommand p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AgentErrorType -> Either AgentErrorType (ACommand p)
forall a b. a -> Either a b
Left) ACommand p -> m (Either AgentErrorType (ACommand p))
cmdWithMsgBody Either AgentErrorType (ACommand p)
cmd
      ATransmissionOrError p -> m (ATransmissionOrError p)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgId
corrId, MsgId
connId, Either AgentErrorType (ACommand p)
fullCmd)

    fromParty :: ACmd -> Either AgentErrorType (ACommand p)
    fromParty :: ACmd -> Either AgentErrorType (ACommand p)
fromParty (ACmd (SAParty p
p :: p1) ACommand p
cmd) = case SAParty p -> SAParty p -> Maybe (p :~: p)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality SAParty p
party SAParty p
p of
      Just p :~: p
Refl -> ACommand p -> Either AgentErrorType (ACommand p)
forall a b. b -> Either a b
Right ACommand p
cmd
      Maybe (p :~: p)
_ -> AgentErrorType -> Either AgentErrorType (ACommand p)
forall a b. a -> Either a b
Left (AgentErrorType -> Either AgentErrorType (ACommand p))
-> AgentErrorType -> Either AgentErrorType (ACommand p)
forall a b. (a -> b) -> a -> b
$ CommandErrorType -> AgentErrorType
CMD CommandErrorType
PROHIBITED

    tConnId :: ARawTransmission -> ACommand p -> Either AgentErrorType (ACommand p)
    tConnId :: ARawTransmission
-> ACommand p -> Either AgentErrorType (ACommand p)
tConnId (MsgId
_, MsgId
connId, MsgId
_) ACommand p
cmd = case ACommand p
cmd of
      -- NEW, JOIN and ACPT have optional connId
      NEW AConnectionMode
_ -> ACommand p -> Either AgentErrorType (ACommand p)
forall a b. b -> Either a b
Right ACommand p
cmd
      JOIN {} -> ACommand p -> Either AgentErrorType (ACommand p)
forall a b. b -> Either a b
Right ACommand p
cmd
      ACPT {} -> ACommand p -> Either AgentErrorType (ACommand p)
forall a b. b -> Either a b
Right ACommand p
cmd
      -- ERROR response does not always have connId
      ERR AgentErrorType
_ -> ACommand p -> Either AgentErrorType (ACommand p)
forall a b. b -> Either a b
Right ACommand p
cmd
      -- other responses must have connId
      ACommand p
_
        | MsgId -> Bool
B.null MsgId
connId -> AgentErrorType -> Either AgentErrorType (ACommand p)
forall a b. a -> Either a b
Left (AgentErrorType -> Either AgentErrorType (ACommand p))
-> AgentErrorType -> Either AgentErrorType (ACommand p)
forall a b. (a -> b) -> a -> b
$ CommandErrorType -> AgentErrorType
CMD CommandErrorType
NO_CONN
        | Bool
otherwise -> ACommand p -> Either AgentErrorType (ACommand p)
forall a b. b -> Either a b
Right ACommand p
cmd

    cmdWithMsgBody :: ACommand p -> m (Either AgentErrorType (ACommand p))
    cmdWithMsgBody :: ACommand p -> m (Either AgentErrorType (ACommand p))
cmdWithMsgBody = \case
      SEND MsgId
body -> MsgId -> ACommand 'Client
SEND (MsgId -> ACommand 'Client)
-> m (Either AgentErrorType MsgId)
-> m (Either AgentErrorType (ACommand 'Client))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> MsgId -> m (Either AgentErrorType MsgId)
getBody MsgId
body
      MSG MsgMeta
msgMeta MsgId
body -> MsgMeta -> MsgId -> ACommand 'Agent
MSG MsgMeta
msgMeta (MsgId -> ACommand 'Agent)
-> m (Either AgentErrorType MsgId)
-> m (Either AgentErrorType (ACommand 'Agent))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> MsgId -> m (Either AgentErrorType MsgId)
getBody MsgId
body
      JOIN AConnectionRequest
qUri MsgId
cInfo -> AConnectionRequest -> MsgId -> ACommand 'Client
JOIN AConnectionRequest
qUri (MsgId -> ACommand 'Client)
-> m (Either AgentErrorType MsgId)
-> m (Either AgentErrorType (ACommand 'Client))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> MsgId -> m (Either AgentErrorType MsgId)
getBody MsgId
cInfo
      CONF MsgId
confId MsgId
cInfo -> MsgId -> MsgId -> ACommand 'Agent
CONF MsgId
confId (MsgId -> ACommand 'Agent)
-> m (Either AgentErrorType MsgId)
-> m (Either AgentErrorType (ACommand 'Agent))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> MsgId -> m (Either AgentErrorType MsgId)
getBody MsgId
cInfo
      LET MsgId
confId MsgId
cInfo -> MsgId -> MsgId -> ACommand 'Client
LET MsgId
confId (MsgId -> ACommand 'Client)
-> m (Either AgentErrorType MsgId)
-> m (Either AgentErrorType (ACommand 'Client))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> MsgId -> m (Either AgentErrorType MsgId)
getBody MsgId
cInfo
      REQ MsgId
invId MsgId
cInfo -> MsgId -> MsgId -> ACommand 'Agent
REQ MsgId
invId (MsgId -> ACommand 'Agent)
-> m (Either AgentErrorType MsgId)
-> m (Either AgentErrorType (ACommand 'Agent))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> MsgId -> m (Either AgentErrorType MsgId)
getBody MsgId
cInfo
      ACPT MsgId
invId MsgId
cInfo -> MsgId -> MsgId -> ACommand 'Client
ACPT MsgId
invId (MsgId -> ACommand 'Client)
-> m (Either AgentErrorType MsgId)
-> m (Either AgentErrorType (ACommand 'Client))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> MsgId -> m (Either AgentErrorType MsgId)
getBody MsgId
cInfo
      INFO MsgId
cInfo -> MsgId -> ACommand 'Agent
INFO (MsgId -> ACommand 'Agent)
-> m (Either AgentErrorType MsgId)
-> m (Either AgentErrorType (ACommand 'Agent))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> MsgId -> m (Either AgentErrorType MsgId)
getBody MsgId
cInfo
      ACommand p
cmd -> Either AgentErrorType (ACommand p)
-> m (Either AgentErrorType (ACommand p))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AgentErrorType (ACommand p)
 -> m (Either AgentErrorType (ACommand p)))
-> Either AgentErrorType (ACommand p)
-> m (Either AgentErrorType (ACommand p))
forall a b. (a -> b) -> a -> b
$ ACommand p -> Either AgentErrorType (ACommand p)
forall a b. b -> Either a b
Right ACommand p
cmd

    -- TODO refactor with server
    getBody :: ByteString -> m (Either AgentErrorType ByteString)
    getBody :: MsgId -> m (Either AgentErrorType MsgId)
getBody MsgId
binary =
      case MsgId -> String
B.unpack MsgId
binary of
        Char
':' : String
body -> Either AgentErrorType MsgId -> m (Either AgentErrorType MsgId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AgentErrorType MsgId -> m (Either AgentErrorType MsgId))
-> (MsgId -> Either AgentErrorType MsgId)
-> MsgId
-> m (Either AgentErrorType MsgId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgId -> Either AgentErrorType MsgId
forall a b. b -> Either a b
Right (MsgId -> m (Either AgentErrorType MsgId))
-> MsgId -> m (Either AgentErrorType MsgId)
forall a b. (a -> b) -> a -> b
$ String -> MsgId
B.pack String
body
        String
str -> case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
str :: Maybe Int of
          Just Int
size -> IO (Either AgentErrorType MsgId) -> m (Either AgentErrorType MsgId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either AgentErrorType MsgId)
 -> m (Either AgentErrorType MsgId))
-> IO (Either AgentErrorType MsgId)
-> m (Either AgentErrorType MsgId)
forall a b. (a -> b) -> a -> b
$ do
            MsgId
body <- c -> Int -> IO MsgId
forall c. Transport c => c -> Int -> IO MsgId
cGet c
h Int
size
            MsgId
s <- c -> IO MsgId
forall c. Transport c => c -> IO MsgId
getLn c
h
            Either AgentErrorType MsgId -> IO (Either AgentErrorType MsgId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AgentErrorType MsgId -> IO (Either AgentErrorType MsgId))
-> Either AgentErrorType MsgId -> IO (Either AgentErrorType MsgId)
forall a b. (a -> b) -> a -> b
$ if MsgId -> Bool
B.null MsgId
s then MsgId -> Either AgentErrorType MsgId
forall a b. b -> Either a b
Right MsgId
body else AgentErrorType -> Either AgentErrorType MsgId
forall a b. a -> Either a b
Left (AgentErrorType -> Either AgentErrorType MsgId)
-> AgentErrorType -> Either AgentErrorType MsgId
forall a b. (a -> b) -> a -> b
$ CommandErrorType -> AgentErrorType
CMD CommandErrorType
SIZE
          Maybe Int
Nothing -> Either AgentErrorType MsgId -> m (Either AgentErrorType MsgId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AgentErrorType MsgId -> m (Either AgentErrorType MsgId))
-> (AgentErrorType -> Either AgentErrorType MsgId)
-> AgentErrorType
-> m (Either AgentErrorType MsgId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AgentErrorType -> Either AgentErrorType MsgId
forall a b. a -> Either a b
Left (AgentErrorType -> m (Either AgentErrorType MsgId))
-> AgentErrorType -> m (Either AgentErrorType MsgId)
forall a b. (a -> b) -> a -> b
$ CommandErrorType -> AgentErrorType
CMD CommandErrorType
SYNTAX