Copyright | (c) simplex.chat |
---|---|
License | AGPL-3 |
Maintainer | chat@simplex.chat |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
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
Synopsis
- data ACommand (p :: AParty) where
- NEW :: ACommand Client
- INV :: SMPQueueInfo -> ACommand Agent
- JOIN :: SMPQueueInfo -> ReplyMode -> ACommand Client
- CON :: ACommand Agent
- SUB :: ACommand Client
- SUBALL :: ACommand Client
- END :: ACommand Agent
- SEND :: MsgBody -> ACommand Client
- SENT :: AgentMsgId -> ACommand Agent
- MSG :: {..} -> ACommand Agent
- OFF :: ACommand Client
- DEL :: ACommand Client
- OK :: ACommand Agent
- ERR :: AgentErrorType -> ACommand Agent
- data AParty
- data SAParty :: AParty -> Type where
- data SMPMessage
- = SMPConfirmation SenderPublicKey
- | SMPMessage {
- senderMsgId :: AgentMsgId
- senderTimestamp :: SenderTimestamp
- previousMsgHash :: ByteString
- agentMessage :: AMessage
- data AMessage where
- HELLO :: VerificationKey -> AckMode -> AMessage
- REPLY :: SMPQueueInfo -> AMessage
- A_MSG :: MsgBody -> AMessage
- data SMPServer = SMPServer {}
- data SMPQueueInfo = SMPQueueInfo SMPServer SenderId EncryptionKey
- data AgentErrorType
- data CommandErrorType
- = PROHIBITED
- | SYNTAX
- | NO_CONN
- | SIZE
- | LARGE
- data ConnectionErrorType
- data BrokerErrorType
- data SMPAgentError
- type ATransmission p = (CorrId, ConnAlias, ACommand p)
- type ATransmissionOrError p = (CorrId, ConnAlias, Either AgentErrorType (ACommand p))
- type ARawTransmission = (ByteString, ByteString, ByteString)
- type ConnAlias = ByteString
- newtype ReplyMode = ReplyMode OnOff
- newtype AckMode = AckMode OnOff
- data OnOff
- data MsgIntegrity
- data MsgErrorType
- = MsgSkipped AgentMsgId AgentMsgId
- | MsgBadId AgentMsgId
- | MsgBadHash
- | MsgDuplicate
- data QueueStatus
- type SignatureKey = SafePrivateKey
- type VerificationKey = PublicKey
- type EncryptionKey = PublicKey
- type DecryptionKey = SafePrivateKey
- serializeCommand :: ACommand p -> ByteString
- serializeSMPMessage :: SMPMessage -> ByteString
- serializeMsgIntegrity :: MsgIntegrity -> ByteString
- serializeServer :: SMPServer -> ByteString
- serializeSmpQueueInfo :: SMPQueueInfo -> ByteString
- serializeAgentError :: AgentErrorType -> ByteString
- commandP :: Parser ACmd
- parseSMPMessage :: ByteString -> Either AgentErrorType SMPMessage
- smpServerP :: Parser SMPServer
- smpQueueInfoP :: Parser SMPQueueInfo
- msgIntegrityP :: Parser MsgIntegrity
- agentErrorTypeP :: Parser AgentErrorType
- tPut :: (Transport c, MonadIO m) => c -> ATransmission p -> m ()
- tGet :: forall c m p. (Transport c, MonadIO m) => SAParty p -> c -> m (ATransmissionOrError p)
- tPutRaw :: Transport c => c -> ARawTransmission -> IO ()
- tGetRaw :: Transport c => c -> IO ARawTransmission
SMP agent protocol types
data ACommand (p :: AParty) where Source #
Parameterized type for SMP agent protocol commands and responses from all participants.
NEW :: ACommand Client | |
INV :: SMPQueueInfo -> ACommand Agent | |
JOIN :: SMPQueueInfo -> ReplyMode -> ACommand Client | |
CON :: ACommand Agent | |
SUB :: ACommand Client | |
SUBALL :: ACommand Client | |
END :: ACommand Agent | |
SEND :: MsgBody -> ACommand Client | |
SENT :: AgentMsgId -> ACommand Agent | |
MSG | |
| |
OFF :: ACommand Client | |
DEL :: ACommand Client | |
OK :: ACommand Agent | |
ERR :: AgentErrorType -> ACommand Agent |
SMP agent protocol participants.
data SAParty :: AParty -> Type where Source #
Singleton types for SMP agent protocol participants.
data SMPMessage Source #
SMP message formats.
SMPConfirmation SenderPublicKey | SMP confirmation (see SMP protocol) |
SMPMessage | Agent message header and envelope for client messages (see SMP agent protocol) |
|
Instances
Show SMPMessage Source # | |
Defined in Simplex.Messaging.Agent.Protocol showsPrec :: Int -> SMPMessage -> ShowS # show :: SMPMessage -> String # showList :: [SMPMessage] -> ShowS # |
Messages sent between SMP agents once SMP queue is secured.
HELLO :: VerificationKey -> AckMode -> AMessage | the first message in the queue to validate it is secured |
REPLY :: SMPQueueInfo -> AMessage | reply queue information |
A_MSG :: MsgBody -> AMessage | agent envelope for the client message |
SMP server location and transport key digest (hash).
data SMPQueueInfo Source #
SMP queue information sent out-of-band.
Instances
Eq SMPQueueInfo Source # | |
Defined in Simplex.Messaging.Agent.Protocol (==) :: SMPQueueInfo -> SMPQueueInfo -> Bool # (/=) :: SMPQueueInfo -> SMPQueueInfo -> Bool # | |
Show SMPQueueInfo Source # | |
Defined in Simplex.Messaging.Agent.Protocol showsPrec :: Int -> SMPQueueInfo -> ShowS # show :: SMPQueueInfo -> String # showList :: [SMPQueueInfo] -> ShowS # |
data AgentErrorType Source #
Error type used in errors sent to agent clients.
CMD CommandErrorType | command or response error |
CONN ConnectionErrorType | connection errors |
SMP ErrorType | SMP protocol errors forwarded to agent clients |
BROKER BrokerErrorType | SMP server errors |
AGENT SMPAgentError | errors of other agents |
INTERNAL String | agent implementation or dependency errors |
Instances
data CommandErrorType Source #
SMP agent protocol command or response error.
PROHIBITED | command is prohibited |
SYNTAX | command syntax is invalid |
NO_CONN | connection alias is required with this command |
SIZE | message size is not correct (no terminating space) |
LARGE | message does not fit in SMP block |
Instances
data ConnectionErrorType Source #
Connection error.
UNKNOWN | connection alias is not in the database |
DUPLICATE | connection alias already exists |
SIMPLEX | connection is simplex, but operation requires another queue |
Instances
data BrokerErrorType Source #
SMP server errors.
RESPONSE ErrorType | invalid server response (failed to parse) |
UNEXPECTED | unexpected response |
NETWORK | network error |
TRANSPORT TransportError | handshake or other transport error |
TIMEOUT | command response timeout |
Instances
data SMPAgentError Source #
Errors of another SMP agent.
A_MESSAGE | possibly should include bytestring that failed to parse |
A_PROHIBITED | possibly should include the prohibited SMP/agent message |
A_ENCRYPTION | cannot RSA/AES-decrypt or parse decrypted header |
A_SIGNATURE | invalid RSA signature |
Instances
type ATransmission p = (CorrId, ConnAlias, ACommand p) Source #
Parsed SMP agent protocol transmission.
type ATransmissionOrError p = (CorrId, ConnAlias, Either AgentErrorType (ACommand p)) Source #
SMP agent protocol transmission or transmission error.
type ARawTransmission = (ByteString, ByteString, ByteString) Source #
Raw (unparsed) SMP agent protocol transmission.
type ConnAlias = ByteString Source #
SMP agent connection alias.
Connection reply mode (used in JOIN command).
data MsgIntegrity Source #
Result of received message integrity validation.
Instances
Eq MsgIntegrity Source # | |
Defined in Simplex.Messaging.Agent.Protocol (==) :: MsgIntegrity -> MsgIntegrity -> Bool # (/=) :: MsgIntegrity -> MsgIntegrity -> Bool # | |
Show MsgIntegrity Source # | |
Defined in Simplex.Messaging.Agent.Protocol showsPrec :: Int -> MsgIntegrity -> ShowS # show :: MsgIntegrity -> String # showList :: [MsgIntegrity] -> ShowS # | |
FromField MsgIntegrity Source # | |
Defined in Simplex.Messaging.Agent.Store.SQLite | |
ToField MsgIntegrity Source # | |
Defined in Simplex.Messaging.Agent.Store.SQLite toField :: MsgIntegrity -> SQLData # |
data MsgErrorType Source #
Error of message integrity validation.
MsgSkipped AgentMsgId AgentMsgId | |
MsgBadId AgentMsgId | |
MsgBadHash | |
MsgDuplicate |
Instances
Eq MsgErrorType Source # | |
Defined in Simplex.Messaging.Agent.Protocol (==) :: MsgErrorType -> MsgErrorType -> Bool # (/=) :: MsgErrorType -> MsgErrorType -> Bool # | |
Show MsgErrorType Source # | |
Defined in Simplex.Messaging.Agent.Protocol showsPrec :: Int -> MsgErrorType -> ShowS # show :: MsgErrorType -> String # showList :: [MsgErrorType] -> ShowS # |
data QueueStatus Source #
SMP queue status.
New | queue is created |
Confirmed | queue is confirmed by the sender |
Secured | queue is secured with sender key (only used by the queue recipient) |
Active | queue is active |
Disabled | queue is disabled (only used by the queue recipient) |
Instances
Eq QueueStatus Source # | |
Defined in Simplex.Messaging.Agent.Protocol (==) :: QueueStatus -> QueueStatus -> Bool # (/=) :: QueueStatus -> QueueStatus -> Bool # | |
Read QueueStatus Source # | |
Defined in Simplex.Messaging.Agent.Protocol readsPrec :: Int -> ReadS QueueStatus # readList :: ReadS [QueueStatus] # readPrec :: ReadPrec QueueStatus # readListPrec :: ReadPrec [QueueStatus] # | |
Show QueueStatus Source # | |
Defined in Simplex.Messaging.Agent.Protocol showsPrec :: Int -> QueueStatus -> ShowS # show :: QueueStatus -> String # showList :: [QueueStatus] -> ShowS # | |
FromField QueueStatus Source # | |
Defined in Simplex.Messaging.Agent.Store.SQLite | |
ToField QueueStatus Source # | |
Defined in Simplex.Messaging.Agent.Store.SQLite toField :: QueueStatus -> SQLData # |
type SignatureKey = SafePrivateKey Source #
Private key used to sign SMP commands
type VerificationKey = PublicKey Source #
Public key used by SMP server to authorize (verify) SMP commands.
type EncryptionKey = PublicKey Source #
Public key used to E2E encrypt SMP messages.
type DecryptionKey = SafePrivateKey Source #
Private key used to E2E decrypt SMP messages.
Parse and serialize
serializeCommand :: ACommand p -> ByteString Source #
Serialize SMP agent command.
serializeSMPMessage :: SMPMessage -> ByteString Source #
Serialize SMP message.
serializeMsgIntegrity :: MsgIntegrity -> ByteString Source #
Serialize message integrity validation result.
serializeServer :: SMPServer -> ByteString Source #
Serialize SMP server location.
serializeSmpQueueInfo :: SMPQueueInfo -> ByteString Source #
Serialize SMP queue information that is sent out-of-band.
serializeAgentError :: AgentErrorType -> ByteString Source #
Serialize SMP agent protocol error.
parseSMPMessage :: ByteString -> Either AgentErrorType SMPMessage Source #
Parse SMP message.
smpServerP :: Parser SMPServer Source #
SMP server location parser.
smpQueueInfoP :: Parser SMPQueueInfo Source #
SMP queue information parser.
msgIntegrityP :: Parser MsgIntegrity Source #
Message integrity validation result parser.
agentErrorTypeP :: Parser AgentErrorType Source #
SMP agent protocol error parser.
TCP transport functions
tPut :: (Transport c, MonadIO m) => c -> ATransmission p -> m () Source #
Send SMP agent protocol command (or response) to TCP connection.
tGet :: forall c m p. (Transport c, MonadIO m) => SAParty p -> c -> m (ATransmissionOrError p) Source #
Receive client and agent transmissions from TCP connection.