agent store: getConn with tests

src/Simplex/Messaging/Agent/Store.hs

@@ -11,6 +11,7 @@ module Simplex.Messaging.Agent.Store where
 import Data.Int (Int64)
 import Data.Kind
 import Data.Time.Clock (UTCTime)
+import Data.Type.Equality
 import Simplex.Messaging.Agent.Transmission
 import Simplex.Messaging.Server.Transmission (Encoded, PublicKey, QueueId)
 
@@ -54,11 +55,26 @@ data SConnType :: ConnType -> Type where
   SCSend :: SConnType CSend
   SCDuplex :: SConnType CDuplex
 
+deriving instance Eq (SConnType d)
+
 deriving instance Show (SConnType d)
 
+instance TestEquality SConnType where
+  testEquality SCReceive SCReceive = Just Refl
+  testEquality SCSend SCSend = Just Refl
+  testEquality SCDuplex SCDuplex = Just Refl
+  testEquality _ _ = Nothing
+
 data SomeConn where
   SomeConn :: SConnType d -> Connection d -> SomeConn
 
+instance Eq SomeConn where
+  SomeConn d c == SomeConn d' c' = case testEquality d d' of
+    Just Refl -> c == c'
+    _ -> False
+
+deriving instance Show SomeConn
+
 data MessageDelivery = MessageDelivery
   { connAlias :: ConnAlias,
     agentMsgId :: Int,
@@ -96,6 +112,7 @@ class Monad m => MonadAgentStore s m where
 data StoreError
   = SEInternal
   | SENotFound
+  | SEBadConn
   | SEBadConnType ConnType
   | SEBadQueueStatus
   deriving (Eq, Show)

src/Simplex/Messaging/Agent/Store/SQLite.hs

@@ -227,18 +227,16 @@ insertSndConnection store connAlias sndQueueId =
     "INSERT INTO connections (conn_alias, receive_queue_id, send_queue_id) VALUES (?,NULL,?);"
     (Only connAlias :. Only sndQueueId)
 
--- instance FromRow SomeConn where
---   fromRow =
-
--- selectConnection :: MonadUnliftIO m => SQLiteStore -> ConnAlias -> m (Either StoreError SomeConn)
--- selectConnection SQLiteStore {conn} connAlias = liftIO $ do
---   DB.query
---     conn
---     "SELECT * FROM connections WHERE conn_alias = ?"
---     connAlias
---     >>= \case
---       [Only someConn] -> return (Right someConn)
---       _ -> return (Left SEInternal)
+getConnection :: MonadUnliftIO m => SQLiteStore -> ConnAlias -> m (Either StoreError (Maybe QueueRowId, Maybe QueueRowId))
+getConnection SQLiteStore {conn} connAlias = liftIO $ do
+  r <-
+    DB.queryNamed
+      conn
+      "SELECT receive_queue_id, send_queue_id FROM connections WHERE conn_alias = :conn_alias"
+      [":conn_alias" := connAlias]
+  return $ case r of
+    [queueIds] -> Right queueIds
+    _ -> Left SEInternal
 
 instance MonadUnliftIO m => MonadAgentStore SQLiteStore m where
   addServer store smpServer = upsertServer store smpServer
@@ -262,3 +260,19 @@ instance MonadUnliftIO m => MonadAgentStore SQLiteStore m where
         qId <- insertSndQueue st serverId sndQueue -- TODO test for duplicate connAlias
         insertSndConnection st connAlias qId
         return $ SendConnection connAlias sndQueue
+
+  getConn :: SQLiteStore -> ConnAlias -> m (Either StoreError SomeConn)
+  getConn st connAlias =
+    getConnection st connAlias >>= \case
+      Left e -> return $ Left e
+      Right (Just rcvQId, Just sndQId) -> do
+        rcvQ <- getRcvQueue st rcvQId
+        sndQ <- getSndQueue st sndQId
+        return $ SomeConn SCDuplex <$> (DuplexConnection connAlias <$> rcvQ <*> sndQ)
+      Right (Just rcvQId, _) ->
+        getRcvQueue st rcvQId
+          >>= return . fmap (SomeConn SCReceive . ReceiveConnection connAlias)
+      Right (_, Just sndQId) ->
+        getSndQueue st sndQId
+          >>= return . fmap (SomeConn SCSend . SendConnection connAlias)
+      Right (_, _) -> return $ Left SEBadConn

tests/AgentTests/SQLite.hs

@@ -27,7 +27,7 @@ storeTests = withStore do
 
 testCreateRcvConn :: SpecWith SQLiteStore
 testCreateRcvConn = do
-  it "should create receiver connection and return receiver connection data type" $ \store -> do
+  it "should create and get receive connection" $ \store -> do
     let rcvQueue =
           ReceiveQueue
             { server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
@@ -42,10 +42,12 @@ testCreateRcvConn = do
             }
     createRcvConn store "1" rcvQueue
       `shouldReturn` Right (ReceiveConnection "1" rcvQueue)
+    getConn store "1"
+      `shouldReturn` Right (SomeConn SCReceive $ ReceiveConnection "1" rcvQueue)
 
 testCreateSndConn :: SpecWith SQLiteStore
 testCreateSndConn = do
-  it "should create sender connection and return sender connection data type" $ \store -> do
+  it "should create and get send connection" $ \store -> do
     let sndQueue =
           SendQueue
             { server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
@@ -58,3 +60,5 @@ testCreateSndConn = do
             }
     createSndConn store "2" sndQueue
       `shouldReturn` Right (SendConnection "2" sndQueue)
+    getConn store "2"
+      `shouldReturn` Right (SomeConn SCSend $ SendConnection "2" sndQueue)