Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- class Monad m => MonadAgentStore s m where
- createRcvConn :: s -> RcvQueue -> m ()
- createSndConn :: s -> SndQueue -> m ()
- getConn :: s -> ConnAlias -> m SomeConn
- getAllConnAliases :: s -> m [ConnAlias]
- getRcvConn :: s -> SMPServer -> RecipientId -> m SomeConn
- deleteConn :: s -> ConnAlias -> m ()
- upgradeRcvConnToDuplex :: s -> ConnAlias -> SndQueue -> m ()
- upgradeSndConnToDuplex :: s -> ConnAlias -> RcvQueue -> m ()
- setRcvQueueStatus :: s -> RcvQueue -> QueueStatus -> m ()
- setRcvQueueActive :: s -> RcvQueue -> VerificationKey -> m ()
- setSndQueueStatus :: s -> SndQueue -> QueueStatus -> m ()
- updateRcvIds :: s -> RcvQueue -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
- createRcvMsg :: s -> RcvQueue -> RcvMsgData -> m ()
- updateSndIds :: s -> SndQueue -> m (InternalId, InternalSndId, PrevSndMsgHash)
- createSndMsg :: s -> SndQueue -> SndMsgData -> m ()
- getMsg :: s -> ConnAlias -> InternalId -> m Msg
- data RcvQueue = RcvQueue {}
- data SndQueue = SndQueue {}
- data ConnType
- data Connection (d :: ConnType) where
- RcvConnection :: ConnAlias -> RcvQueue -> Connection CRcv
- SndConnection :: ConnAlias -> SndQueue -> Connection CSnd
- DuplexConnection :: ConnAlias -> RcvQueue -> SndQueue -> Connection CDuplex
- data SConnType :: ConnType -> Type where
- connType :: SConnType c -> ConnType
- data SomeConn = forall d. SomeConn (SConnType d) (Connection d)
- type MsgHash = ByteString
- type PrevExternalSndId = Int64
- type PrevRcvMsgHash = MsgHash
- type PrevSndMsgHash = MsgHash
- data RcvMsgData = RcvMsgData {}
- data SndMsgData = SndMsgData {}
- data Msg
- data RcvMsg = RcvMsg {}
- newtype InternalRcvId = InternalRcvId {}
- type ExternalSndId = Int64
- type ExternalSndTs = UTCTime
- type BrokerId = MsgId
- type BrokerTs = UTCTime
- data RcvMsgStatus
- type AckBrokerTs = UTCTime
- type AckSenderTs = UTCTime
- data SndMsg = SndMsg {}
- newtype InternalSndId = InternalSndId {}
- data SndMsgStatus
- type SentTs = UTCTime
- type DeliveredTs = UTCTime
- data MsgBase = MsgBase {}
- newtype InternalId = InternalId {}
- type InternalTs = UTCTime
- data StoreError
Store management
class Monad m => MonadAgentStore s m where Source #
Store class type. Defines store access methods for implementations.
createRcvConn :: s -> RcvQueue -> m () Source #
createSndConn :: s -> SndQueue -> m () Source #
getConn :: s -> ConnAlias -> m SomeConn Source #
getAllConnAliases :: s -> m [ConnAlias] Source #
getRcvConn :: s -> SMPServer -> RecipientId -> m SomeConn Source #
deleteConn :: s -> ConnAlias -> m () Source #
upgradeRcvConnToDuplex :: s -> ConnAlias -> SndQueue -> m () Source #
upgradeSndConnToDuplex :: s -> ConnAlias -> RcvQueue -> m () Source #
setRcvQueueStatus :: s -> RcvQueue -> QueueStatus -> m () Source #
setRcvQueueActive :: s -> RcvQueue -> VerificationKey -> m () Source #
setSndQueueStatus :: s -> SndQueue -> QueueStatus -> m () Source #
updateRcvIds :: s -> RcvQueue -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash) Source #
createRcvMsg :: s -> RcvQueue -> RcvMsgData -> m () Source #
updateSndIds :: s -> SndQueue -> m (InternalId, InternalSndId, PrevSndMsgHash) Source #
createSndMsg :: s -> SndQueue -> SndMsgData -> m () Source #
Instances
Queue types
A receive queue. SMP queue through which the agent receives messages from a sender.
A send queue. SMP queue through which the agent sends messages to a recipient.
SndQueue | |
|
Connection types
Type of a connection.
data Connection (d :: ConnType) where Source #
Connection of a specific type.
- RcvConnection is a connection that only has a receive queue set up, typically created by a recipient initiating a duplex connection.
- SndConnection is a connection that only has a send queue set up, typically created by a sender joining a duplex connection through a recipient's invitation.
- DuplexConnection is a connection that has both receive and send queues set up, typically created by upgrading a receive or a send connection with a missing queue.
RcvConnection :: ConnAlias -> RcvQueue -> Connection CRcv | |
SndConnection :: ConnAlias -> SndQueue -> Connection CSnd | |
DuplexConnection :: ConnAlias -> RcvQueue -> SndQueue -> Connection CDuplex |
Instances
Eq (Connection d) Source # | |
Defined in Simplex.Messaging.Agent.Store (==) :: Connection d -> Connection d -> Bool # (/=) :: Connection d -> Connection d -> Bool # | |
Show (Connection d) Source # | |
Defined in Simplex.Messaging.Agent.Store showsPrec :: Int -> Connection d -> ShowS # show :: Connection d -> String # showList :: [Connection d] -> ShowS # |
Connection of an unknown type. Used to refer to an arbitrary connection when retrieving from store.
forall d. SomeConn (SConnType d) (Connection d) |
Message integrity validation types
type MsgHash = ByteString Source #
type PrevExternalSndId = Int64 Source #
Corresponds to last_external_snd_msg_id
in connections
table
type PrevRcvMsgHash = MsgHash Source #
Corresponds to last_rcv_msg_hash
in connections
table
type PrevSndMsgHash = MsgHash Source #
Corresponds to last_snd_msg_hash
in connections
table
Message data containers - used on Msg creation to reduce number of parameters
data RcvMsgData Source #
data SndMsgData Source #
Message types
A message in either direction that is stored by the agent.
A message received by the agent from a sender.
RcvMsg | |
|
newtype InternalRcvId Source #
Instances
Eq InternalRcvId Source # | |
Defined in Simplex.Messaging.Agent.Store (==) :: InternalRcvId -> InternalRcvId -> Bool # (/=) :: InternalRcvId -> InternalRcvId -> Bool # | |
Show InternalRcvId Source # | |
Defined in Simplex.Messaging.Agent.Store showsPrec :: Int -> InternalRcvId -> ShowS # show :: InternalRcvId -> String # showList :: [InternalRcvId] -> ShowS # | |
FromField InternalRcvId Source # | |
Defined in Simplex.Messaging.Agent.Store.SQLite | |
ToField InternalRcvId Source # | |
Defined in Simplex.Messaging.Agent.Store.SQLite toField :: InternalRcvId -> SQLData # |
type ExternalSndId = Int64 Source #
type ExternalSndTs = UTCTime Source #
data RcvMsgStatus Source #
Instances
Eq RcvMsgStatus Source # | |
Defined in Simplex.Messaging.Agent.Store (==) :: RcvMsgStatus -> RcvMsgStatus -> Bool # (/=) :: RcvMsgStatus -> RcvMsgStatus -> Bool # | |
Show RcvMsgStatus Source # | |
Defined in Simplex.Messaging.Agent.Store showsPrec :: Int -> RcvMsgStatus -> ShowS # show :: RcvMsgStatus -> String # showList :: [RcvMsgStatus] -> ShowS # | |
ToField RcvMsgStatus Source # | |
Defined in Simplex.Messaging.Agent.Store.SQLite toField :: RcvMsgStatus -> SQLData # |
type AckBrokerTs = UTCTime Source #
type AckSenderTs = UTCTime Source #
A message sent by the agent to a recipient.
SndMsg | |
|
newtype InternalSndId Source #
Instances
Eq InternalSndId Source # | |
Defined in Simplex.Messaging.Agent.Store (==) :: InternalSndId -> InternalSndId -> Bool # (/=) :: InternalSndId -> InternalSndId -> Bool # | |
Show InternalSndId Source # | |
Defined in Simplex.Messaging.Agent.Store showsPrec :: Int -> InternalSndId -> ShowS # show :: InternalSndId -> String # showList :: [InternalSndId] -> ShowS # | |
FromField InternalSndId Source # | |
Defined in Simplex.Messaging.Agent.Store.SQLite | |
ToField InternalSndId Source # | |
Defined in Simplex.Messaging.Agent.Store.SQLite toField :: InternalSndId -> SQLData # |
data SndMsgStatus Source #
Instances
Eq SndMsgStatus Source # | |
Defined in Simplex.Messaging.Agent.Store (==) :: SndMsgStatus -> SndMsgStatus -> Bool # (/=) :: SndMsgStatus -> SndMsgStatus -> Bool # | |
Show SndMsgStatus Source # | |
Defined in Simplex.Messaging.Agent.Store showsPrec :: Int -> SndMsgStatus -> ShowS # show :: SndMsgStatus -> String # showList :: [SndMsgStatus] -> ShowS # | |
ToField SndMsgStatus Source # | |
Defined in Simplex.Messaging.Agent.Store.SQLite toField :: SndMsgStatus -> SQLData # |
type DeliveredTs = UTCTime Source #
Base message data independent of direction.
MsgBase | |
|
Instances
newtype InternalId Source #
Instances
Eq InternalId Source # | |
Defined in Simplex.Messaging.Agent.Store (==) :: InternalId -> InternalId -> Bool # (/=) :: InternalId -> InternalId -> Bool # | |
Show InternalId Source # | |
Defined in Simplex.Messaging.Agent.Store showsPrec :: Int -> InternalId -> ShowS # show :: InternalId -> String # showList :: [InternalId] -> ShowS # | |
FromField InternalId Source # | |
Defined in Simplex.Messaging.Agent.Store.SQLite | |
ToField InternalId Source # | |
Defined in Simplex.Messaging.Agent.Store.SQLite toField :: InternalId -> SQLData # |
type InternalTs = UTCTime Source #
Store errors
data StoreError Source #
Agent store error.
SEInternal ByteString | IO exceptions in store actions. |
SEConnNotFound | Connection alias not found (or both queues absent). |
SEConnDuplicate | Connection alias already used. |
SEBadConnType ConnType | Wrong connection type, e.g. "send" connection when "receive" or "duplex" is expected, or vice versa.
|
SEBadQueueStatus | Currently not used. The intention was to pass current expected queue status in methods, as we always know what it should be at any stage of the protocol, and in case it does not match use this error. |
SENotImplemented | Used in |
Instances
Eq StoreError Source # | |
Defined in Simplex.Messaging.Agent.Store (==) :: StoreError -> StoreError -> Bool # (/=) :: StoreError -> StoreError -> Bool # | |
Show StoreError Source # | |
Defined in Simplex.Messaging.Agent.Store showsPrec :: Int -> StoreError -> ShowS # show :: StoreError -> String # showList :: [StoreError] -> ShowS # | |
Exception StoreError Source # | |
Defined in Simplex.Messaging.Agent.Store toException :: StoreError -> SomeException # fromException :: SomeException -> Maybe StoreError # displayException :: StoreError -> String # |