diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 60a762f6d..c577da07f 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/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) diff --git a/src/Simplex/Messaging/Agent/Transmission.hs b/src/Simplex/Messaging/Agent/Transmission.hs index 1dd7416b6..310a193f1 100644 --- a/src/Simplex/Messaging/Agent/Transmission.hs +++ b/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 diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index 30aae9b98..23ff97b4e 100644 --- a/tests/AgentTests.hs +++ b/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") diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs new file mode 100644 index 000000000..ec441540d --- /dev/null +++ b/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"