{-# 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 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 (..),
    SMPQueueInfo (..),
    AgentErrorType (..),
    CommandErrorType (..),
    ConnectionErrorType (..),
    BrokerErrorType (..),
    SMPAgentError (..),
    ATransmission,
    ATransmissionOrError,
    ARawTransmission,
    ConnId,
    ConfirmationId,
    IntroId,
    InvitationId,
    AckMode (..),
    OnOff (..),
    MsgIntegrity (..),
    MsgErrorType (..),
    QueueStatus (..),
    SignatureKey,
    VerificationKey,
    EncryptionKey,
    DecryptionKey,
    ACorrId,
    AgentMsgId,

    -- * Parse and serialize
    serializeCommand,
    serializeSMPMessage,
    serializeMsgIntegrity,
    serializeServer,
    serializeSmpQueueInfo,
    serializeAgentError,
    commandP,
    parseSMPMessage,
    smpServerP,
    smpQueueInfoP,
    msgIntegrityP,
    agentErrorTypeP,

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

import Control.Applicative (optional, (<|>))
import Control.Monad.IO.Class
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Base64
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.String (IsString (..))
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.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

-- | 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 :: ACommand Client -- response INV
  INV :: SMPQueueInfo -> ACommand Agent
  JOIN :: SMPQueueInfo -> ConnInfo -> ACommand Client -- response OK
  REQ :: ConfirmationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
  ACPT :: ConfirmationId -> ConnInfo -> ACommand Client -- ConnInfo is from 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)

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 :: SMPQueueInfo -> AMessage
  -- | agent envelope for the client message
  A_MSG :: MsgBody -> 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
  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 = SMPQueueInfo -> AMessage
REPLY (SMPQueueInfo -> AMessage)
-> Parser MsgId SMPQueueInfo -> Parser MsgId AMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId SMPQueueInfo
smpQueueInfoP
    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
    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 queue information parser.
smpQueueInfoP :: Parser SMPQueueInfo
smpQueueInfoP :: Parser MsgId SMPQueueInfo
smpQueueInfoP =
  Parser MsgId MsgId
"smp::" Parser MsgId MsgId
-> Parser MsgId SMPQueueInfo -> Parser MsgId SMPQueueInfo
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SMPServer -> MsgId -> SenderPublicKey -> SMPQueueInfo
SMPQueueInfo (SMPServer -> MsgId -> SenderPublicKey -> SMPQueueInfo)
-> Parser MsgId SMPServer
-> Parser MsgId (MsgId -> SenderPublicKey -> SMPQueueInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId SMPServer
smpServerP Parser MsgId (MsgId -> SenderPublicKey -> SMPQueueInfo)
-> Parser MsgId MsgId
-> Parser MsgId (MsgId -> SenderPublicKey -> SMPQueueInfo)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId MsgId
"::" Parser MsgId (MsgId -> SenderPublicKey -> SMPQueueInfo)
-> Parser MsgId MsgId
-> Parser MsgId (SenderPublicKey -> SMPQueueInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId MsgId
base64P Parser MsgId (SenderPublicKey -> SMPQueueInfo)
-> Parser MsgId MsgId
-> Parser MsgId (SenderPublicKey -> SMPQueueInfo)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId MsgId
"::" Parser MsgId (SenderPublicKey -> SMPQueueInfo)
-> Parser MsgId SenderPublicKey -> Parser MsgId SMPQueueInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId SenderPublicKey
C.pubKeyP)

-- | SMP server location parser.
smpServerP :: Parser SMPServer
smpServerP :: Parser MsgId 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 MsgId 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 SMPQueueInfo
qInfo -> MsgId
"REPLY " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> SMPQueueInfo -> MsgId
serializeSmpQueueInfo SMPQueueInfo
qInfo
  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"

-- | Serialize SMP queue information that is sent out-of-band.
serializeSmpQueueInfo :: SMPQueueInfo -> ByteString
serializeSmpQueueInfo :: SMPQueueInfo -> MsgId
serializeSmpQueueInfo (SMPQueueInfo SMPServer
srv MsgId
qId SenderPublicKey
ek) =
  MsgId -> [MsgId] -> MsgId
B.intercalate MsgId
"::" [MsgId
"smp", SMPServer -> MsgId
serializeServer SMPServer
srv, MsgId -> MsgId
encode MsgId
qId, SenderPublicKey -> MsgId
C.serializePubKey SenderPublicKey
ek]

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

-- | 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 MsgId SMPServer -> MsgId -> Either String SMPServer
forall a. Parser a -> MsgId -> Either String a
parseAll Parser MsgId SMPServer
smpServerP

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

type ConfirmationId = ByteString

type IntroId = 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 SMPQueueInfo = SMPQueueInfo SMPServer SMP.SenderId EncryptionKey
  deriving (SMPQueueInfo -> SMPQueueInfo -> Bool
(SMPQueueInfo -> SMPQueueInfo -> Bool)
-> (SMPQueueInfo -> SMPQueueInfo -> Bool) -> Eq SMPQueueInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SMPQueueInfo -> SMPQueueInfo -> Bool
$c/= :: SMPQueueInfo -> SMPQueueInfo -> Bool
== :: SMPQueueInfo -> SMPQueueInfo -> Bool
$c== :: SMPQueueInfo -> SMPQueueInfo -> Bool
Eq, Int -> SMPQueueInfo -> ShowS
[SMPQueueInfo] -> ShowS
SMPQueueInfo -> String
(Int -> SMPQueueInfo -> ShowS)
-> (SMPQueueInfo -> String)
-> ([SMPQueueInfo] -> ShowS)
-> Show SMPQueueInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SMPQueueInfo] -> ShowS
$cshowList :: [SMPQueueInfo] -> ShowS
show :: SMPQueueInfo -> String
$cshow :: SMPQueueInfo -> String
showsPrec :: Int -> SMPQueueInfo -> ShowS
$cshowsPrec :: Int -> SMPQueueInfo -> ShowS
Show)

-- | 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 -> 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
NEW
    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
"REQ " Parser MsgId MsgId -> Parser ACmd -> Parser ACmd
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ACmd
reqCmd
    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
"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
    invResp :: Parser ACmd
invResp = SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent (ACommand 'Agent -> ACmd)
-> (SMPQueueInfo -> ACommand 'Agent) -> SMPQueueInfo -> ACmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMPQueueInfo -> ACommand 'Agent
INV (SMPQueueInfo -> ACmd) -> Parser MsgId SMPQueueInfo -> Parser ACmd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId SMPQueueInfo
smpQueueInfoP
    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
<$> (SMPQueueInfo -> MsgId -> ACommand 'Client
JOIN (SMPQueueInfo -> MsgId -> ACommand 'Client)
-> Parser MsgId SMPQueueInfo
-> Parser MsgId (MsgId -> ACommand 'Client)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId SMPQueueInfo
smpQueueInfoP 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)
    reqCmd :: Parser ACmd
reqCmd = 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)
    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
  ACommand p
NEW -> MsgId
"NEW"
  INV SMPQueueInfo
qInfo -> MsgId
"INV " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> SMPQueueInfo -> MsgId
serializeSmpQueueInfo SMPQueueInfo
qInfo
  JOIN SMPQueueInfo
qInfo MsgId
cInfo -> MsgId
"JOIN " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> SMPQueueInfo -> MsgId
serializeSmpQueueInfo SMPQueueInfo
qInfo MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
" " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId -> MsgId
serializeBinary MsgId
cInfo
  REQ MsgId
confId MsgId
cInfo -> MsgId
"REQ " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
confId MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
" " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId -> MsgId
serializeBinary MsgId
cInfo
  ACPT MsgId
confId MsgId
cInfo -> MsgId
"ACPT " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
confId MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
" " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId -> MsgId
serializeBinary MsgId
cInfo
  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
"MERR " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> AgentMsgId -> MsgId
forall a. Show a => a -> MsgId
bshow AgentMsgId
mId MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
" " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> AgentErrorType -> MsgId
serializeAgentError AgentErrorType
e
  MSG MsgMeta
msgMeta MsgId
msgBody ->
    MsgId
"MSG " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgMeta -> MsgId
serializeMsgMeta MsgMeta
msgMeta MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId
" " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> 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
      ACommand p
NEW -> 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
      -- 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 SMPQueueInfo
qInfo MsgId
cInfo -> SMPQueueInfo -> MsgId -> ACommand 'Client
JOIN SMPQueueInfo
qInfo (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
confId MsgId
cInfo -> MsgId -> MsgId -> ACommand 'Agent
REQ 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
      ACPT MsgId
confId MsgId
cInfo -> MsgId -> MsgId -> ACommand 'Client
ACPT 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
      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