agent tests (#8)

src/Simplex/Messaging/Agent.hs

@@ -40,7 +40,7 @@ runSMPAgent cfg@AgentConfig {tcpPort} = do
   where
     smpAgent :: (MonadUnliftIO m', MonadReader Env m') => m' ()
     smpAgent = runTCPServer tcpPort $ \h -> do
-      putLn h "Welcome to SMP Agent v0.1"
+      putLn h "Welcome to SMP v0.2.0 agent"
       q <- asks $ tbqSize . config
       c <- atomically $ newAgentClient q
       race_ (connectClient h c) (runClient c)

src/Simplex/Messaging/Agent/Transmission.hs

@@ -158,11 +158,14 @@ data AckStatus = AckOk | AckError AckErrorType
 data AckErrorType = AckUnknown | AckProhibited | AckSyntax Int -- etc.
   deriving (Show)
 
+errBadEncoding :: Int
+errBadEncoding = 10
+
 errBadInvitation :: Int
-errBadInvitation = 10
+errBadInvitation = 12
 
 errNoConnAlias :: Int
-errNoConnAlias = 11
+errNoConnAlias = 13
 
 smpErrTCPConnection :: Natural
 smpErrTCPConnection = 1
@@ -211,10 +214,12 @@ parseCommand command = case B.words command of
     smpQueueInfo :: ByteString -> Either ErrorType SMPQueueInfo
     smpQueueInfo qInfo = case splitOn "::" $ B.unpack qInfo of
       ["smp", srv, qId, ek] -> liftM3 SMPQueueInfo (smpServer $ B.pack srv) (dec64 qId) (dec64 ek)
-      _ -> errInv
+      _ -> Left $ SYNTAX errBadInvitation
 
     dec64 :: String -> Either ErrorType ByteString
-    dec64 s = either (const errInv) Right . decode $ B.pack s
+    dec64 s = case decode $ B.pack s of
+      Left _ -> Left $ SYNTAX errBadEncoding
+      Right b -> Right b
 
     srvPart :: String -> Maybe String
     srvPart s = if length s > 1 then Just $ tail s else Nothing
@@ -233,9 +238,6 @@ parseCommand command = case B.words command of
     errParams :: Either ErrorType a
     errParams = Left $ SYNTAX errBadParameters
 
-    errInv :: Either ErrorType a
-    errInv = Left $ SYNTAX errBadInvitation
-
 serializeCommand :: ACommand p -> ByteString
 serializeCommand = \case
   NEW srv -> "NEW " <> server srv
@@ -246,6 +248,7 @@ serializeCommand = \case
         ReplyOff -> "NO_REPLY"
         ReplyOn srv -> server srv
   CON -> "CON"
+  ERR e -> "ERR " <> B.pack (show e)
   c -> B.pack $ show c
   where
     server :: SMPServer -> ByteString
@@ -287,8 +290,9 @@ tGet party h = tGetRaw h >>= tParseLoadBody
 
     tConnAlias :: ARawTransmission -> ACommand p -> Either ErrorType (ACommand p)
     tConnAlias (_, connAlias, _) cmd = case cmd of
-      -- NEW has optional connAlias
+      -- NEW and JOIN have optional connAlias
       NEW _ -> Right cmd
+      JOIN _ _ -> Right cmd
       -- ERROR response does not always have connAlias
       ERR _ -> Right cmd
       -- other responses must have connAlias

tests/AgentTests.hs

@@ -1,8 +1,51 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module AgentTests where
 
 import AgentTests.SQLite
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import SMPAgentClient
+import Simplex.Messaging.Agent.Transmission
 import Test.Hspec
 
 agentTests :: Spec
 agentTests = do
   describe "SQLite store" storeTests
+  fdescribe "SMP agent protocol syntax" syntaxTests
+
+(>#>) :: ARawTransmission -> ARawTransmission -> Expectation
+command >#> response = smpAgentTest command `shouldReturn` response
+
+(>#>=) :: ARawTransmission -> ((ByteString, ByteString, [ByteString]) -> Bool) -> Expectation
+command >#>= p = smpAgentTest command >>= (`shouldSatisfy` p . \(cId, cAlias, cmd) -> (cId, cAlias, B.words cmd))
+
+syntaxTests :: Spec
+syntaxTests = do
+  it "unknown command" $ ("1", "5678", "HELLO") >#> ("1", "5678", "ERR UNKNOWN")
+  describe "NEW" do
+    describe "valid" do
+      -- TODO: ERROR no connection alias in the response (it does not generate it yet if not provided)
+      -- TODO: add tests with defined connection alias
+      xit "only server" $ ("211", "", "NEW localhost") >#>= \case ("211", "", "INV" : _) -> True; _ -> False
+      it "with port" $ ("212", "", "NEW localhost:5000") >#>= \case ("212", "", "INV" : _) -> True; _ -> False
+      xit "with keyHash" $ ("213", "", "NEW localhost#1234") >#>= \case ("213", "", "INV" : _) -> True; _ -> False
+      it "with port and keyHash" $ ("214", "", "NEW localhost:5000#1234") >#>= \case ("214", "", "INV" : _) -> True; _ -> False
+    describe "invalid" do
+      -- TODO: add tests with defined connection alias
+      it "no parameters" $ ("221", "", "NEW") >#> ("221", "", "ERR SYNTAX 2")
+      it "many parameters" $ ("222", "", "NEW localhost:5000 hi") >#> ("222", "", "ERR SYNTAX 2")
+      it "invalid server keyHash" $ ("223", "", "NEW localhost:5000#1") >#> ("223", "", "ERR SYNTAX 10")
+
+  describe "JOIN" do
+    describe "valid" do
+      -- TODO: ERROR no connection alias in the response (it does not generate it yet if not provided)
+      -- TODO: add tests with defined connection alias
+      -- TODO: JOIN is not merged yet - to be added
+      it "using same server as in invitation" $
+        ("311", "", "JOIN smp::localhost:5000::1234::5678") >#> ("311", "", "ERR SMP AUTH")
+    describe "invalid" do
+      -- TODO: JOIN is not merged yet - to be added
+      it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR SYNTAX 2")

tests/SMPAgentClient.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module SMPAgentClient where
+
+import Control.Monad
+import Control.Monad.IO.Unlift
+import Crypto.Random
+import Network.Socket
+import SMPClient (testPort, withSmpServer)
+import Simplex.Messaging.Agent
+import Simplex.Messaging.Agent.Env.SQLite
+import Simplex.Messaging.Agent.ServerClient
+import Simplex.Messaging.Agent.Transmission
+import Simplex.Messaging.Transport
+import UnliftIO.Concurrent
+import UnliftIO.Directory
+import qualified UnliftIO.Exception as E
+import UnliftIO.IO
+
+agentTestHost :: HostName
+agentTestHost = "localhost"
+
+agentTestPort :: ServiceName
+agentTestPort = "5001"
+
+testDB :: String
+testDB = "smp-agent.test.protocol.db"
+
+smpAgentTest :: ARawTransmission -> IO ARawTransmission
+smpAgentTest cmd = runSmpAgentTest $ \h -> tPutRaw h cmd >> tGetRaw h
+
+runSmpAgentTest :: (MonadUnliftIO m, MonadRandom m) => (Handle -> m a) -> m a
+runSmpAgentTest test = withSmpServer . withSmpAgent $ testSMPAgentClient test
+
+cfg :: AgentConfig
+cfg =
+  AgentConfig
+    { tcpPort = agentTestPort,
+      tbqSize = 1,
+      connIdBytes = 12,
+      dbFile = testDB,
+      smpTcpPort = testPort,
+      smpConfig =
+        ServerClientConfig
+          { tbqSize = 1,
+            corrIdBytes = 4
+          }
+    }
+
+withSmpAgent :: (MonadUnliftIO m, MonadRandom m) => m a -> m a
+withSmpAgent =
+  E.bracket
+    (forkIO $ runSMPAgent cfg)
+    (liftIO . killThread >=> const (removeFile testDB))
+    . const
+
+testSMPAgentClient :: MonadUnliftIO m => (Handle -> m a) -> m a
+testSMPAgentClient client = do
+  threadDelay 25000 -- TODO hack: thread delay for SMP agent to start
+  runTCPClient agentTestHost agentTestPort $ \h -> do
+    line <- getLn h
+    if line == "Welcome to SMP v0.2.0 agent"
+      then client h
+      else error "not connected"