diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index db268d1bf..71e5b318f 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/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) diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index cc4b46458..269b8b587 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/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; |] diff --git a/src/Simplex/Messaging/Agent/Transmission.hs b/src/Simplex/Messaging/Agent/Transmission.hs index 81fb754c0..222a89aa0 100644 --- a/src/Simplex/Messaging/Agent/Transmission.hs +++ b/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 diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs new file mode 100644 index 000000000..30aae9b98 --- /dev/null +++ b/tests/AgentTests.hs @@ -0,0 +1,8 @@ +module AgentTests where + +import AgentTests.SQLite +import Test.Hspec + +agentTests :: Spec +agentTests = do + describe "SQLite store" storeTests diff --git a/tests/AgentTests/SQLite.hs b/tests/AgentTests/SQLite.hs new file mode 100644 index 000000000..fe395c138 --- /dev/null +++ b/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) diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index f741462b2..cf86f583b 100644 --- a/tests/ServerTests.hs +++ b/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")] diff --git a/tests/Test.hs b/tests/Test.hs index 301d5ceec..3b2e915c8 100644 --- a/tests/Test.hs +++ b/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