From 027b91098dfc683895e6eebaee553cdcf6c1f583 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 26 Dec 2020 12:55:23 +0000
Subject: [PATCH] MonadAgentStore class

---
 src/Simplex/Messaging/Agent/Command.hs |  8 ++--
 src/Simplex/Messaging/Agent/Store.hs   | 61 +++++++++++++++++++++-----
 2 files changed, 55 insertions(+), 14 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Command.hs b/src/Simplex/Messaging/Agent/Command.hs
index a558ea71d..cd4645d35 100644
--- a/src/Simplex/Messaging/Agent/Command.hs
+++ b/src/Simplex/Messaging/Agent/Command.hs
@@ -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
diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs
index b465d1af6..c20a9efc6 100644
--- a/src/Simplex/Messaging/Agent/Store.hs
+++ b/src/Simplex/Messaging/Agent/Store.hs
@@ -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