test: agent SQLite createRcvConnection

src/Simplex/Messaging/Agent/Store.hs

@@ -25,6 +25,7 @@ data ReceiveQueue = ReceiveQueue
     status :: QueueStatus,
     ackMode :: AckMode -- whether acknowledgement will be sent (via SendQueue if present)
   }
+  deriving (Eq, Show)
 
 data SendQueue = SendQueue
   { server :: SMPServer,
@@ -35,14 +36,19 @@ data SendQueue = SendQueue
     status :: QueueStatus,
     ackMode :: AckMode -- whether acknowledgement is expected (via ReceiveQueue if present)
   }
+  deriving (Eq, Show)
 
-data ConnType = CSend | CReceive | CDuplex
+data ConnType = CSend | CReceive | CDuplex deriving (Eq, Show)
 
 data Connection (d :: ConnType) where
   ReceiveConnection :: ConnAlias -> ReceiveQueue -> Connection CReceive
   SendConnection :: ConnAlias -> SendQueue -> Connection CSend
   DuplexConnection :: ConnAlias -> ReceiveQueue -> SendQueue -> Connection CDuplex
 
+deriving instance Show (Connection d)
+
+deriving instance Eq (Connection d)
+
 data SConnType :: ConnType -> Type where
   SCReceive :: SConnType CReceive
   SCSend :: SConnType CSend
@@ -93,3 +99,4 @@ data StoreError
   | SEMsgNotFound
   | SEBadConnType ConnType
   | SEBadQueueStatus
+  deriving (Eq, Show)

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

@@ -107,8 +107,8 @@ upsertServer SQLiteStore {conn} srv@SMPServer {host, port} = liftIO $ do
     conn
     [s|
       INSERT INTO servers (host, port, key_hash) VALUES (?, ?, ?)
-      ON CONFLICT (host_address, port) DO UPDATE SET
-        host_address=excluded.host_address,
+      ON CONFLICT (host, port) DO UPDATE SET
+        host=excluded.host,
         port=excluded.port,
         key_hash=excluded.key_hash;
       |]

src/Simplex/Messaging/Agent/Transmission.hs

@@ -101,7 +101,7 @@ data SMPServer = SMPServer
     port :: Maybe ServiceName,
     keyHash :: Maybe KeyHash
   }
-  deriving (Show)
+  deriving (Eq, Show)
 
 type KeyHash = Encoded
 
@@ -109,9 +109,9 @@ type ConnAlias = ByteString
 
 type OtherPartyId = Encoded
 
-data Mode = On | Off deriving (Show, Read)
+data Mode = On | Off deriving (Eq, Show, Read)
 
-newtype AckMode = AckMode Mode deriving (Show)
+newtype AckMode = AckMode Mode deriving (Eq, Show)
 
 newtype SubMode = SubMode Mode deriving (Show)
 
@@ -125,7 +125,7 @@ type VerificationKey = PublicKey
 data QueueDirection = SND | RCV deriving (Show)
 
 data QueueStatus = New | Confirmed | Secured | Active | Disabled
-  deriving (Show, Read)
+  deriving (Eq, Show, Read)
 
 type AgentMsgId = Int
 

tests/AgentTests.hs

@@ -0,0 +1,8 @@
+module AgentTests where
+
+import AgentTests.SQLite
+import Test.Hspec
+
+agentTests :: Spec
+agentTests = do
+  describe "SQLite store" storeTests

tests/AgentTests/SQLite.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module AgentTests.SQLite where
+
+import qualified Database.SQLite.Simple as DB
+import Simplex.Messaging.Agent.Store
+import Simplex.Messaging.Agent.Store.SQLite
+import Simplex.Messaging.Agent.Transmission
+import Test.Hspec
+import UnliftIO.Directory
+
+testDB :: String
+testDB = "smp-agent.test.db"
+
+withStore :: SpecWith SQLiteStore -> Spec
+withStore =
+  beforeAll (newSQLiteStore testDB)
+    . afterAll (\store -> DB.close (conn store) >> removeFile testDB)
+
+storeTests :: Spec
+storeTests = withStore do
+  describe "store methods" do
+    describe "createRcvConnection" testCreateRcvConnection
+
+testCreateRcvConnection :: SpecWith SQLiteStore
+testCreateRcvConnection = do
+  it "should create connection and return connection data type" $ \store -> do
+    let rcvQueue =
+          ReceiveQueue
+            { server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
+              rcvId = "1234",
+              rcvPrivateKey = "abcd",
+              sndId = Just "5678",
+              sndKey = Nothing,
+              decryptKey = "dcba",
+              verifyKey = Nothing,
+              status = New,
+              ackMode = AckMode On
+            }
+    createRcvConn store "1" rcvQueue
+      `shouldReturn` Right (ReceiveConnection "1" rcvQueue)

tests/ServerTests.hs

@@ -17,7 +17,7 @@ import System.Timeout
 import Test.HUnit
 import Test.Hspec
 
-serverTests :: SpecWith ()
+serverTests :: Spec
 serverTests = do
   describe "SMP syntax" syntaxTests
   describe "SMP queues" do
@@ -39,7 +39,7 @@ commands >#> responses = smpServerTest commands `shouldReturn` responses
 (#==) :: (HasCallStack, Eq a, Show a) => (a, a) -> String -> Assertion
 (actual, expected) #== message = assertEqual message expected actual
 
-testCreateSecure :: SpecWith ()
+testCreateSecure :: Spec
 testCreateSecure =
   it "should create (NEW) and secure (KEY) queue" $
     smpTest \h -> do
@@ -88,7 +88,7 @@ testCreateSecure =
       Resp "dabc" _ err5 <- sendRecv h ("", "dabc", sId, "SEND :hello")
       (err5, ERR AUTH) #== "rejects unsigned SEND"
 
-testCreateDelete :: SpecWith ()
+testCreateDelete :: Spec
 testCreateDelete =
   it "should create (NEW), suspend (OFF) and delete (DEL) queue" $
     smpTest2 \rh sh -> do
@@ -154,7 +154,7 @@ testCreateDelete =
       Resp "cdab" _ err10 <- sendRecv rh ("1234", "cdab", rId, "SUB")
       (err10, ERR AUTH) #== "rejects SUB when deleted"
 
-testDuplex :: SpecWith ()
+testDuplex :: Spec
 testDuplex =
   it "should create 2 simplex connections and exchange messages" $
     smpTest2 \alice bob -> do
@@ -199,7 +199,7 @@ testDuplex =
       Resp "bcda" _ OK <- sendRecv bob ("abcd", "bcda", bRcv, "ACK")
       (msg5, "how are you bob") #== "message received from alice"
 
-testSwitchSub :: SpecWith ()
+testSwitchSub :: Spec
 testSwitchSub =
   it "should create simplex connections and switch subscription to another TCP connection" $
     smpTest3 \rh1 rh2 sh -> do
@@ -236,7 +236,7 @@ testSwitchSub =
         Nothing -> return ()
         Just _ -> error "nothing else is delivered to the 1st TCP connection"
 
-syntaxTests :: SpecWith ()
+syntaxTests :: Spec
 syntaxTests = do
   it "unknown command" $ [("", "abcd", "1234", "HELLO")] >#> [("", "abcd", "1234", "ERR UNKNOWN")]
   describe "NEW" do
@@ -265,7 +265,7 @@ syntaxTests = do
   describe "broker response not allowed" do
     it "OK" $ [("1234", "bcda", "12345678", "OK")] >#> [("", "bcda", "12345678", "ERR PROHIBITED")]
   where
-    noParamsSyntaxTest :: ByteString -> SpecWith ()
+    noParamsSyntaxTest :: ByteString -> Spec
     noParamsSyntaxTest cmd = describe (B.unpack cmd) do
       it "valid syntax" $ [("1234", "abcd", "12345678", cmd)] >#> [("", "abcd", "12345678", "ERR AUTH")]
       it "parameters" $ [("1234", "bcda", "12345678", cmd <> " 1")] >#> [("", "bcda", "12345678", "ERR SYNTAX 2")]

tests/Test.hs

@@ -1,8 +1,10 @@
 {-# LANGUAGE BlockArguments #-}
 
+import AgentTests
 import ServerTests
 import Test.Hspec
 
 main :: IO ()
 main = hspec do
-  describe "SMP Server" serverTests
+  describe "SMP server" serverTests
+  describe "SMP client agent" agentTests