{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# 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
    ACommand (..),
    AParty (..),
    SAParty (..),
    SMPMessage (..),
    AMessage (..),
    SMPServer (..),
    SMPQueueInfo (..),
    AgentErrorType (..),
    CommandErrorType (..),
    ConnectionErrorType (..),
    BrokerErrorType (..),
    SMPAgentError (..),
    ATransmission,
    ATransmissionOrError,
    ARawTransmission,
    ConnAlias,
    ReplyMode (..),
    AckMode (..),
    OnOff (..),
    MsgIntegrity (..),
    MsgErrorType (..),
    QueueStatus (..),
    SignatureKey,
    VerificationKey,
    EncryptionKey,
    DecryptionKey,

    -- * 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
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Parsers
import Simplex.Messaging.Protocol
  ( CorrId (..),
    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 = (CorrId, ConnAlias, ACommand p)

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

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

-- | 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 -> ReplyMode -> ACommand Client -- response OK
  CON :: ACommand Agent -- notification that connection is established
  -- TODO currently it automatically allows whoever sends the confirmation
  -- CONF :: OtherPartyId -> ACommand Agent
  -- LET :: OtherPartyId -> ACommand Client
  SUB :: ACommand Client
  SUBALL :: ACommand Client -- TODO should be moved to chat protocol - hack for subscribing to all
  END :: ACommand Agent
  -- QST :: QueueDirection -> ACommand Client
  -- STAT :: QueueDirection -> Maybe QueueStatus -> Maybe SubMode -> ACommand Agent
  SEND :: MsgBody -> ACommand Client
  SENT :: AgentMsgId -> ACommand Agent
  MSG ::
    { ACommand 'Agent -> (AgentMsgId, UTCTime)
recipientMeta :: (AgentMsgId, UTCTime),
      ACommand 'Agent -> (MsgId, UTCTime)
brokerMeta :: (MsgId, UTCTime),
      ACommand 'Agent -> (AgentMsgId, UTCTime)
senderMeta :: (AgentMsgId, UTCTime),
      ACommand 'Agent -> MsgIntegrity
msgIntegrity :: MsgIntegrity,
      ACommand 'Agent -> MsgId
msgBody :: 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)

-- | 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 SenderPublicKey
  | -- | 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 :: ByteString,
        -- | 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 SMPMessage
smpConfirmationP Parser SMPMessage -> Parser MsgId () -> Parser SMPMessage
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId ()
A.endOfLine
        Parser SMPMessage -> Parser SMPMessage -> Parser SMPMessage
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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

    smpConfirmationP :: Parser SMPMessage
    smpConfirmationP :: Parser SMPMessage
smpConfirmationP = SenderPublicKey -> SMPMessage
SMPConfirmation (SenderPublicKey -> SMPMessage)
-> Parser MsgId SenderPublicKey -> Parser SMPMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser MsgId MsgId
"KEY " Parser MsgId MsgId
-> Parser MsgId SenderPublicKey -> Parser MsgId SenderPublicKey
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser MsgId SenderPublicKey
C.pubKeyP Parser MsgId SenderPublicKey
-> Parser MsgId () -> Parser MsgId SenderPublicKey
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 -> MsgId -> MsgId -> MsgId
smpMessage (MsgId
"KEY " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> SenderPublicKey -> MsgId
C.serializePubKey SenderPublicKey
sKey) MsgId
"" MsgId
""
  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 = 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
      MsgId -> AMessage
A_MSG (MsgId -> AMessage) -> Parser MsgId MsgId -> Parser MsgId AMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser MsgId MsgId
A.take Int
size 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
serializeMsg 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)
-> (Parser MsgId SMPServer -> MsgId -> Either String SMPServer)
-> Parser MsgId SMPServer
-> String
-> SMPServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser MsgId SMPServer -> MsgId -> Either String SMPServer
forall a. Parser a -> MsgId -> Either String a
parseAll (Parser MsgId SMPServer -> String -> SMPServer)
-> Parser MsgId SMPServer -> String -> SMPServer
forall a b. (a -> b) -> a -> b
$ Parser MsgId SMPServer
smpServerP

-- | SMP agent connection alias.
type ConnAlias = 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)

-- | Connection reply mode (used in JOIN command).
newtype ReplyMode = ReplyMode OnOff deriving (ReplyMode -> ReplyMode -> Bool
(ReplyMode -> ReplyMode -> Bool)
-> (ReplyMode -> ReplyMode -> Bool) -> Eq ReplyMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplyMode -> ReplyMode -> Bool
$c/= :: ReplyMode -> ReplyMode -> Bool
== :: ReplyMode -> ReplyMode -> Bool
$c== :: ReplyMode -> ReplyMode -> Bool
Eq, Int -> ReplyMode -> ShowS
[ReplyMode] -> ShowS
ReplyMode -> String
(Int -> ReplyMode -> ShowS)
-> (ReplyMode -> String)
-> ([ReplyMode] -> ShowS)
-> Show ReplyMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplyMode] -> ShowS
$cshowList :: [ReplyMode] -> ShowS
show :: ReplyMode -> String
$cshow :: ReplyMode -> String
showsPrec :: Int -> ReplyMode -> ShowS
$cshowsPrec :: Int -> ReplyMode -> 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.SafePrivateKey

-- | 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
    PROHIBITED
  | -- | command syntax is invalid
    SYNTAX
  | -- | connection alias 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
    UNKNOWN
  | -- | 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

-- | AMP 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
"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
"SUBALL" 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
SUBALL -- TODO remove - hack for subscribing to all
    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
"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
"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
"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
"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 -> ReplyMode -> ACommand 'Client
JOIN (SMPQueueInfo -> ReplyMode -> ACommand 'Client)
-> Parser MsgId SMPQueueInfo
-> Parser MsgId (ReplyMode -> ACommand 'Client)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MsgId SMPQueueInfo
smpQueueInfoP Parser MsgId (ReplyMode -> ACommand 'Client)
-> Parser MsgId ReplyMode -> Parser MsgId (ACommand 'Client)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MsgId ReplyMode
replyMode)
    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
    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
    message :: Parser ACmd
message = do
      MsgIntegrity
msgIntegrity <- Parser MsgIntegrity
msgIntegrityP Parser MsgIntegrity -> Parser MsgId Char -> Parser MsgIntegrity
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space
      (AgentMsgId, UTCTime)
recipientMeta <- 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)
brokerMeta <- 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)
senderMeta <- 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
      MsgId
msgBody <- Parser MsgId MsgId
A.takeByteString
      ACmd -> Parser ACmd
forall (m :: * -> *) a. Monad m => a -> m a
return (ACmd -> Parser ACmd) -> ACmd -> Parser ACmd
forall a b. (a -> b) -> a -> b
$ SAParty 'Agent -> ACommand 'Agent -> ACmd
forall (p :: AParty). SAParty p -> ACommand p -> ACmd
ACmd SAParty 'Agent
SAgent MSG :: (AgentMsgId, UTCTime)
-> (MsgId, UTCTime)
-> (AgentMsgId, UTCTime)
-> MsgIntegrity
-> MsgId
-> ACommand 'Agent
MSG {(AgentMsgId, UTCTime)
recipientMeta :: (AgentMsgId, UTCTime)
recipientMeta :: (AgentMsgId, UTCTime)
recipientMeta, (MsgId, UTCTime)
brokerMeta :: (MsgId, UTCTime)
brokerMeta :: (MsgId, UTCTime)
brokerMeta, (AgentMsgId, UTCTime)
senderMeta :: (AgentMsgId, UTCTime)
senderMeta :: (AgentMsgId, UTCTime)
senderMeta, MsgIntegrity
msgIntegrity :: MsgIntegrity
msgIntegrity :: MsgIntegrity
msgIntegrity, MsgId
msgBody :: MsgId
msgBody :: MsgId
msgBody}
    replyMode :: Parser MsgId ReplyMode
replyMode = OnOff -> ReplyMode
ReplyMode (OnOff -> ReplyMode)
-> Parser MsgId OnOff -> Parser MsgId ReplyMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser MsgId MsgId
" NO_REPLY" 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)
    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 Parser MsgId (a, UTCTime)
-> Parser MsgId Char -> Parser MsgId (a, UTCTime)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser MsgId Char
A.space
    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 ReplyMode
rMode -> 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
<> ReplyMode -> MsgId
replyMode ReplyMode
rMode
  ACommand p
SUB -> MsgId
"SUB"
  ACommand p
SUBALL -> MsgId
"SUBALL" -- TODO remove - hack for subscribing to all
  ACommand p
END -> MsgId
"END"
  SEND MsgId
msgBody -> MsgId
"SEND " MsgId -> MsgId -> MsgId
forall a. Semigroup a => a -> a -> a
<> MsgId -> MsgId
serializeMsg MsgId
msgBody
  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
  MSG {recipientMeta :: ACommand 'Agent -> (AgentMsgId, UTCTime)
recipientMeta = (AgentMsgId
rmId, UTCTime
rTs), brokerMeta :: ACommand 'Agent -> (MsgId, UTCTime)
brokerMeta = (MsgId
bmId, UTCTime
bTs), senderMeta :: ACommand 'Agent -> (AgentMsgId, UTCTime)
senderMeta = (AgentMsgId
smId, UTCTime
sTs), MsgIntegrity
msgIntegrity :: MsgIntegrity
msgIntegrity :: ACommand 'Agent -> MsgIntegrity
msgIntegrity, MsgId
msgBody :: MsgId
msgBody :: ACommand 'Agent -> MsgId
msgBody} ->
    [MsgId] -> MsgId
B.unwords
      [ MsgId
"MSG",
        MsgIntegrity -> MsgId
serializeMsgIntegrity MsgIntegrity
msgIntegrity,
        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,
        MsgId -> MsgId
serializeMsg MsgId
msgBody
      ]
  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
    replyMode :: ReplyMode -> ByteString
    replyMode :: ReplyMode -> MsgId
replyMode = \case
      ReplyMode OnOff
Off -> MsgId
" NO_REPLY"
      ReplyMode OnOff
On -> MsgId
""
    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

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

serializeMsg :: ByteString -> ByteString
serializeMsg :: MsgId -> MsgId
serializeMsg 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
connAlias, 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
connAlias
  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 (CorrId 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
connAlias, 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)
tConnAlias 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
CorrId MsgId
corrId, MsgId
connAlias, 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

    tConnAlias :: ARawTransmission -> ACommand p -> Either AgentErrorType (ACommand p)
    tConnAlias :: ARawTransmission
-> ACommand p -> Either AgentErrorType (ACommand p)
tConnAlias (MsgId
_, MsgId
connAlias, MsgId
_) ACommand p
cmd = case ACommand p
cmd of
      -- NEW and JOIN have optional connAlias
      ACommand p
NEW -> ACommand p -> Either AgentErrorType (ACommand p)
forall a b. b -> Either a b
Right ACommand p
cmd
      JOIN SMPQueueInfo
_ ReplyMode
_ -> ACommand p -> Either AgentErrorType (ACommand p)
forall a b. b -> Either a b
Right ACommand p
cmd
      -- ERROR response does not always have connAlias
      ERR AgentErrorType
_ -> ACommand p -> Either AgentErrorType (ACommand p)
forall a b. b -> Either a b
Right ACommand p
cmd
      -- other responses must have connAlias
      ACommand p
_
        | MsgId -> Bool
B.null MsgId
connAlias -> 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)
getMsgBody MsgId
body
      MSG (AgentMsgId, UTCTime)
agentMsgId (MsgId, UTCTime)
srvTS (AgentMsgId, UTCTime)
agentTS MsgIntegrity
integrity MsgId
body -> (AgentMsgId, UTCTime)
-> (MsgId, UTCTime)
-> (AgentMsgId, UTCTime)
-> MsgIntegrity
-> MsgId
-> ACommand 'Agent
MSG (AgentMsgId, UTCTime)
agentMsgId (MsgId, UTCTime)
srvTS (AgentMsgId, UTCTime)
agentTS MsgIntegrity
integrity (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)
getMsgBody MsgId
body
      ACommand p
cmd -> 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)))
-> 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
    getMsgBody :: MsgBody -> m (Either AgentErrorType MsgBody)
    getMsgBody :: MsgId -> m (Either AgentErrorType MsgId)
getMsgBody MsgId
msgBody =
      case MsgId -> String
B.unpack MsgId
msgBody 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