dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-03-30 18:35:59 +00:00
Code Issues Packages Projects Releases Wiki Activity

MonadAgentStore class

Browse Source
This commit is contained in:
Evgeny Poberezkin
2020-12-26 12:55:23 +00:00
parent f7e0b26297
commit 027b91098d
2 changed files with 55 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
src/Simplex/Messaging/Agent/Command.hs
View File

@@ -40,7 +40,7 @@ data ACommand (a :: AParty) where
SUB :: ConnAlias -> SubMode -> ACommand User
END :: ConnAlias -> ACommand Agent
QST :: ConnAlias -> QueueDirection -> ACommand User
STAT :: ConnAlias -> QueueDirection -> Maybe QueueState -> Maybe SubMode -> ACommand Agent
STAT :: ConnAlias -> QueueDirection -> Maybe QueueStatus -> Maybe SubMode -> ACommand Agent
SEND :: ConnAlias -> MsgBody -> ACommand User
MSG :: ConnAlias -> AgentMsgId -> UTCTime -> UTCTime -> MsgStatus -> MsgBody -> ACommand Agent
ACK :: ConnAlias -> AgentMsgId -> ACommand User
@@ -55,9 +55,9 @@ deriving instance Show (ACommand a)
data AMessage where
HELLO :: VerificationKey -> AckMode -> AMessage
REPLY :: SMPQueueInfo -> AMessage
A_DEL :: AMessage
A_MSG :: AgentMsgId -> UTCTime -> MsgBody -> AMessage
A_MSG :: MsgBody -> AMessage
A_ACK :: AgentMsgId -> AckStatus -> AMessage
A_DEL :: AMessage
data SMPServer = SMPServer HostName ServiceName KeyFingerprint deriving (Show)
@@ -84,7 +84,7 @@ type VerificationKey = PublicKey
data QueueDirection = SND | RCV deriving (Show)
data QueueState = New | Confirmed | Secured | Active | Disabled
data QueueStatus = New | Confirmed | Secured | Active | Disabled
deriving (Show)
type AgentMsgId = Int

61
src/Simplex/Messaging/Agent/Store.hs
View File

@@ -1,7 +1,14 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
module Simplex.Messaging.Agent.ConnStore where
module Simplex.Messaging.Agent.Store where
import Data.Kind
import Data.Time.Clock (UTCTime)
import Simplex.Messaging.Agent.Command
import Simplex.Messaging.Server.Transmission (Encoded, PublicKey, QueueId)
@@ -14,8 +21,8 @@ data ReceiveQueue = ReceiveQueue
sndKey :: Maybe PublicKey,
decryptKey :: PrivateKey,
verifyKey :: Maybe PublicKey,
status :: QueueState,
ackMode :: AckMode
status :: QueueStatus,
ackMode :: AckMode -- whether acknowledgement will be sent (via SendQueue if present)
}
data SendQueue = SendQueue
@@ -24,14 +31,26 @@ data SendQueue = SendQueue
sndPrivateKey :: PrivateKey,
encryptKey :: PublicKey,
signKey :: PrivateKey,
status :: QueueState,
ackMode :: AckMode
status :: QueueStatus,
ackMode :: AckMode -- whether acknowledgement is expected (via ReceiveQueue if present)
}
data Connection
= ReceiveConnection {connAlias :: ConnAlias, rcvQueue :: ReceiveQueue}
| SendConnection {connAlias :: ConnAlias, sndQueue :: SendQueue}
| DuplexConnection {connAlias :: ConnAlias, rcvQueue :: ReceiveQueue, sndQueue :: SendQueue}
data ConnType = CSend | CReceive | CDuplex
data Connection (d :: ConnType) where
ReceiveConnection :: ConnAlias -> ReceiveQueue -> Connection CSend
SendConnection :: ConnAlias -> SendQueue -> Connection CReceive
DuplexConnection :: ConnAlias -> ReceiveQueue -> SendQueue -> Connection CDuplex
data SConnType :: ConnType -> Type where
SCSend :: SConnType CSend
SCReceive :: SConnType CReceive
SCDuplex :: SConnType CDuplex
deriving instance Show (SConnType d)
data SomeConn where
SomeConn :: SConnType d -> Connection d -> SomeConn
data MessageDelivery = MessageDelivery
{ connAlias :: ConnAlias,
@@ -47,4 +66,26 @@ type PrivateKey = Encoded
data DeliveryStatus
= MDTransmitted -- SMP: SEND sent / MSG received
| MDConfirmed -- SMP: OK received / ACK sent
| MDAcknowledged -- SAMP: RCVD sent to agent client / ACK received from agent client and sent to the server
| MDAcknowledged AckStatus -- SAMP: RCVD sent to agent client / ACK received from agent client and sent to the server
class MonadAgentStore s m where
createRcvConn :: s -> Maybe ConnAlias -> ReceiveQueue -> m (Either StoreError (Connection CReceive))
createSndConn :: s -> Maybe ConnAlias -> SendQueue -> m (Either StoreError (Connection CSend))
getConn :: s -> ConnAlias -> m (Either StoreError SomeConn)
deleteConn :: s -> ConnAlias -> m (Either StoreError ())
addSndQueue :: s -> ConnAlias -> SendQueue -> m (Either StoreError (Connection CDuplex))
addRcvQueue :: s -> ConnAlias -> SendQueue -> m (Either StoreError (Connection CDuplex))
removeSndAuth :: s -> ConnAlias -> m (Either StoreError ())
updateQueueStatus :: s -> ConnAlias -> QueueDirection -> QueueStatus -> m (Either StoreError ())
createMsg :: s -> ConnAlias -> QueueDirection -> AMessage -> m (Either StoreError MessageDelivery)
getLastMsg :: s -> ConnAlias -> QueueDirection -> m (Either StoreError MessageDelivery)
getMsg :: s -> ConnAlias -> QueueDirection -> AgentMsgId -> m (Either StoreError MessageDelivery)
updateMsgStatus :: s -> ConnAlias -> QueueDirection -> AgentMsgId -> m (Either StoreError ())
deleteMsg :: s -> ConnAlias -> QueueDirection -> AgentMsgId -> m (Either StoreError ())
data StoreError
= SEInternal
| SEConnNotFound
| SEMsgNotFound
| SEBadConnType ConnType
| SEBadQueueStatus