From 693d9c529d413a33338ad2b216453e4aa1dffbfc Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Thu, 15 Oct 2020 15:47:18 +0100 Subject: [PATCH] change command names --- src/Server.hs | 27 +++++----- src/Transmission.hs | 67 ++++++++++++------------ src/Transport.hs | 8 +-- tests/Test.hs | 123 +++++++++++++++++++++----------------------- 4 files changed, 113 insertions(+), 112 deletions(-) diff --git a/src/Server.hs b/src/Server.hs index 71c5df9b7..61d28d4b7 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -42,7 +42,7 @@ receive h Client {queue} = forever $ do -- TODO maybe send Either to queue? cmd <- either - (return . (connId,) . Cmd SBroker . ERROR) + (return . (connId,) . Cmd SBroker . ERR) (verifyTransmission signature connId) cmdOrError atomically $ writeTBQueue queue cmd @@ -51,7 +51,7 @@ verifyTransmission :: forall m. (MonadUnliftIO m, MonadReader Env m) => Signatur verifyTransmission signature connId cmd = do (connId,) <$> case cmd of Cmd SBroker _ -> return $ smpErr INTERNAL -- it can only be client command, because `fromClient` was used - Cmd SRecipient (CREATE _) -> return cmd + Cmd SRecipient (CONN _) -> return cmd Cmd SRecipient _ -> withConnection SRecipient $ verifySignature . recipientKey Cmd SSender (SEND _) -> withConnection SSender $ verifySend . senderKey where @@ -68,7 +68,7 @@ verifyTransmission signature connId cmd = do verifySignature :: PublicKey -> m Cmd verifySignature key = return $ if signature == key then cmd else authErr - smpErr e = Cmd SBroker $ ERROR e + smpErr e = Cmd SBroker $ ERR e authErr = smpErr AUTH client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Handle -> Client -> m () @@ -83,18 +83,18 @@ client h Client {queue} = loop processCommand connId cmd = do st <- asks connStore case cmd of - Cmd SRecipient (CREATE rKey) -> - either (mkSigned "" . ERROR) connResponce + Cmd SRecipient (CONN rKey) -> + either (mkSigned "" . ERR) idsResponce <$> createConn st rKey Cmd SRecipient SUB -> do -- TODO message subscription return ok - Cmd SRecipient (SECURE sKey) -> okResponse <$> secureConn st connId sKey - Cmd SRecipient SUSPEND -> okResponse <$> suspendConn st connId - Cmd SRecipient DELETE -> okResponse <$> deleteConn st connId + Cmd SRecipient (KEY sKey) -> okResponse <$> secureConn st connId sKey + Cmd SRecipient HOLD -> okResponse <$> suspendConn st connId + Cmd SRecipient DEL -> okResponse <$> deleteConn st connId Cmd SSender (SEND msgBody) -> do -- TODO message delivery - mkSigned connId . either ERROR (deliverTo msgBody) + mkSigned connId . either ERR (deliverTo msgBody) <$> getConn st SSender connId Cmd SBroker _ -> return (connId, cmd) Cmd _ _ -> return ok @@ -105,14 +105,15 @@ client h Client {queue} = loop mkSigned :: ConnId -> Command 'Broker -> Signed mkSigned cId command = (cId, Cmd SBroker command) - connResponce :: Connection -> Signed - connResponce Connection {recipientId = rId, senderId = sId} = mkSigned rId $ CONN rId sId + idsResponce :: Connection -> Signed + idsResponce Connection {recipientId, senderId} = + mkSigned recipientId $ IDS recipientId senderId okResponse :: Either ErrorType () -> Signed - okResponse = mkSigned connId . either ERROR (const OK) + okResponse = mkSigned connId . either ERR (const OK) -- TODO stub deliverTo :: MsgBody -> Connection -> Command 'Broker deliverTo _msgBody conn = case status conn of ConnActive -> OK - ConnSuspended -> ERROR AUTH + ConnSuspended -> ERR AUTH diff --git a/src/Transmission.hs b/src/Transmission.hs index fa1e9c3fb..63a7b170b 100644 --- a/src/Transmission.hs +++ b/src/Transmission.hs @@ -39,17 +39,17 @@ type TransmissionOrError = (Signature, SignedOrError) type RawTransmission = (String, String, String) data Command (a :: Party) where - CREATE :: RecipientKey -> Command Recipient - SECURE :: SenderKey -> Command Recipient - DELMSG :: MsgId -> Command Recipient + CONN :: RecipientKey -> Command Recipient SUB :: Command Recipient - SUSPEND :: Command Recipient - DELETE :: Command Recipient + KEY :: SenderKey -> Command Recipient + ACK :: Command Recipient + HOLD :: Command Recipient + DEL :: Command Recipient SEND :: MsgBody -> Command Sender - MSG :: MsgId -> Timestamp -> MsgBody -> Command Broker - CONN :: SenderId -> RecipientId -> Command Broker - ERROR :: ErrorType -> Command Broker + MSG :: Timestamp -> MsgBody -> Command Broker + IDS :: RecipientId -> SenderId -> Command Broker OK :: Command Broker + ERR :: ErrorType -> Command Broker deriving instance Show (Command a) @@ -57,48 +57,51 @@ deriving instance Eq (Command a) parseCommand :: String -> Either ErrorType Cmd parseCommand command = case words command of - ["CREATE", recipientKey] -> rCmd $ CREATE recipientKey + ["CONN", recipientKey] -> rCmd $ CONN recipientKey ["SUB"] -> rCmd SUB - ["SECURE", senderKey] -> rCmd $ SECURE senderKey - ["DELMSG", msgId] -> rCmd $ DELMSG msgId - ["SUSPEND"] -> rCmd SUSPEND - ["DELETE"] -> rCmd DELETE + ["KEY", senderKey] -> rCmd $ KEY senderKey + ["ACK"] -> rCmd ACK + ["HOLD"] -> rCmd HOLD + ["DEL"] -> rCmd DEL ["SEND", msgBody] -> Right . Cmd SSender . SEND $ B.pack msgBody - ["MSG", msgId, timestamp, msgBody] -> bCmd $ MSG msgId timestamp (B.pack msgBody) - ["CONN", rId, sId] -> bCmd $ CONN rId sId + ["MSG", timestamp, msgBody] -> bCmd $ MSG timestamp (B.pack msgBody) + ["IDS", rId, sId] -> bCmd $ IDS rId sId ["OK"] -> bCmd OK - "ERROR" : err -> case err of - ["SYNTAX", errCode] -> maybe errParams (bCmd . ERROR . SYNTAX) $ readMaybe errCode - ["AUTH"] -> bCmd $ ERROR AUTH - ["INTERNAL"] -> bCmd $ ERROR INTERNAL + "ERR" : err -> case err of + ["UNKNOWN"] -> bErr UNKNOWN + ["PROHIBITED"] -> bErr PROHIBITED + ["SYNTAX", errCode] -> maybe errParams (bErr . SYNTAX) $ readMaybe errCode + ["SIZE"] -> bErr SIZE + ["AUTH"] -> bErr AUTH + ["INTERNAL"] -> bErr INTERNAL _ -> errParams - "CREATE" : _ -> errParams + "CONN" : _ -> errParams "SUB" : _ -> errParams - "SECURE" : _ -> errParams - "DELMSG" : _ -> errParams - "SUSPEND" : _ -> errParams - "DELETE" : _ -> errParams + "KEY" : _ -> errParams + "ACK" : _ -> errParams + "HOLD" : _ -> errParams + "DEL" : _ -> errParams "SEND" : _ -> errParams "MSG" : _ -> errParams - "CONN" : _ -> errParams + "IDS" : _ -> errParams "OK" : _ -> errParams _ -> Left UNKNOWN where errParams = Left $ SYNTAX errBadParameters rCmd = Right . Cmd SRecipient bCmd = Right . Cmd SBroker + bErr = bCmd . ERR serializeCommand :: Cmd -> String serializeCommand = \case - Cmd SRecipient (CREATE rKey) -> "CREATE " ++ rKey - Cmd SRecipient (SECURE sKey) -> "SECURE " ++ sKey - Cmd SRecipient (DELMSG msgId) -> "DELMSG " ++ msgId + Cmd SRecipient (CONN rKey) -> "CONN " ++ rKey + Cmd SRecipient (KEY sKey) -> "KEY " ++ sKey Cmd SRecipient cmd -> show cmd Cmd SSender (SEND msgBody) -> "SEND " ++ show (B.length msgBody) ++ "\n" ++ B.unpack msgBody - Cmd SBroker (MSG msgId timestamp msgBody) -> - "MSG " ++ msgId ++ " " ++ timestamp ++ " " ++ show (B.length msgBody) ++ "\n" ++ B.unpack msgBody - Cmd SBroker (CONN rId sId) -> "CONN " ++ rId ++ " " ++ sId - Cmd SBroker (ERROR err) -> "ERROR " ++ show err + Cmd SBroker (MSG timestamp msgBody) -> + "MSG " ++ timestamp ++ " " ++ show (B.length msgBody) ++ "\n" ++ B.unpack msgBody + Cmd SBroker (IDS rId sId) -> "IDS " ++ rId ++ " " ++ sId + Cmd SBroker (ERR err) -> "ERR " ++ show err Cmd SBroker OK -> "OK" type Encoded = String diff --git a/src/Transport.hs b/src/Transport.hs index 4c49c5937..f7cc44155 100644 --- a/src/Transport.hs +++ b/src/Transport.hs @@ -114,13 +114,13 @@ tGet fromParty h = do tCredentials :: RawTransmission -> Cmd -> Either ErrorType Cmd tCredentials (signature, connId, _) cmd = case cmd of -- ERROR response does not always have connection ID - Cmd SBroker (ERROR _) -> Right cmd + Cmd SBroker (ERR _) -> Right cmd -- other responses must have connection ID Cmd SBroker _ | null connId -> Left $ SYNTAX errNoConnectionId | otherwise -> Right cmd -- CREATE must NOT have signature or connection ID - Cmd SRecipient (CREATE _) + Cmd SRecipient (CONN _) | null signature && null connId -> Right cmd | otherwise -> Left $ SYNTAX errHasCredentials -- SEND must have connection ID, signature is not always required @@ -136,8 +136,8 @@ tGet fromParty h = do cmdWithMsgBody = \case Cmd SSender (SEND body) -> Cmd SSender . SEND <$$> getMsgBody body - Cmd SBroker (MSG msgId ts body) -> - Cmd SBroker . MSG msgId ts <$$> getMsgBody body + Cmd SBroker (MSG ts body) -> + Cmd SBroker . MSG ts <$$> getMsgBody body cmd -> return $ Right cmd infixl 4 <$$> diff --git a/tests/Test.hs b/tests/Test.hs index f5aca4a7b..32188d6b5 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -34,9 +34,9 @@ sendRecv h t = tPutRaw h t >> tGet fromServer h testCreateSecure :: SpecWith () testCreateSecure = do - it "CREATE and SECURE connection, SEND messages (no delivery yet)" $ + it "CONN and KEY connection, SEND messages (no delivery yet)" $ smpTest \h -> do - Resp rId (CONN rId1 sId) <- sendRecv h ("", "", "CREATE 123") + Resp rId (IDS rId1 sId) <- sendRecv h ("", "", "CONN 123") (rId1, rId) #== "creates connection" Resp sId1 ok1 <- sendRecv h ("", sId, "SEND :hello") @@ -44,120 +44,117 @@ testCreateSecure = do (sId1, sId) #== "same connection ID in response 1" Resp sId2 err1 <- sendRecv h ("456", sId, "SEND :hello") - (err1, ERROR AUTH) #== "rejects signed SEND" + (err1, ERR AUTH) #== "rejects signed SEND" (sId2, sId) #== "same connection ID in response 2" - Resp _ err2 <- sendRecv h ("1234", rId, "SECURE 456") - (err2, ERROR AUTH) #== "rejects SECURE with wrong signature (password atm)" + Resp _ err2 <- sendRecv h ("1234", rId, "KEY 456") + (err2, ERR AUTH) #== "rejects KEY with wrong signature (password atm)" - Resp _ err3 <- sendRecv h ("123", sId, "SECURE 456") - (err3, ERROR AUTH) #== "rejects SECURE with sender's ID" + Resp _ err3 <- sendRecv h ("123", sId, "KEY 456") + (err3, ERR AUTH) #== "rejects KEY with sender's ID" - Resp rId2 ok2 <- sendRecv h ("123", rId, "SECURE 456") + Resp rId2 ok2 <- sendRecv h ("123", rId, "KEY 456") (ok2, OK) #== "secures connection" (rId2, rId) #== "same connection ID in response 3" - Resp _ err4 <- sendRecv h ("123", rId, "SECURE 456") - (err4, ERROR AUTH) #== "rejects SECURE if already secured" + Resp _ err4 <- sendRecv h ("123", rId, "KEY 456") + (err4, ERR AUTH) #== "rejects KEY if already secured" Resp _ ok3 <- sendRecv h ("456", sId, "SEND :hello") (ok3, OK) #== "accepts signed SEND" Resp _ err5 <- sendRecv h ("", sId, "SEND :hello") - (err5, ERROR AUTH) #== "rejects unsigned SEND" + (err5, ERR AUTH) #== "rejects unsigned SEND" testCreateDelete :: SpecWith () testCreateDelete = do - it "CREATE, SUSPEND and DELETE connection, SEND messages (no delivery yet)" $ + it "CONN, HOLD and DEL connection, SEND messages (no delivery yet)" $ smpTest \h -> do - Resp rId (CONN rId1 sId) <- sendRecv h ("", "", "CREATE 123") + Resp rId (IDS rId1 sId) <- sendRecv h ("", "", "CONN 123") (rId1, rId) #== "creates connection" - Resp _ ok1 <- sendRecv h ("123", rId, "SECURE 456") + Resp _ ok1 <- sendRecv h ("123", rId, "KEY 456") (ok1, OK) #== "secures connection" Resp _ ok2 <- sendRecv h ("456", sId, "SEND :hello") (ok2, OK) #== "accepts signed SEND" - Resp _ err1 <- sendRecv h ("1234", rId, "SUSPEND") - (err1, ERROR AUTH) #== "rejects SUSPEND with wrong signature (password atm)" + Resp _ err1 <- sendRecv h ("1234", rId, "HOLD") + (err1, ERR AUTH) #== "rejects HOLD with wrong signature (password atm)" - Resp _ err2 <- sendRecv h ("123", sId, "SUSPEND") - (err2, ERROR AUTH) #== "rejects SUSPEND with sender's ID" + Resp _ err2 <- sendRecv h ("123", sId, "HOLD") + (err2, ERR AUTH) #== "rejects HOLD with sender's ID" - Resp rId2 ok3 <- sendRecv h ("123", rId, "SUSPEND") + Resp rId2 ok3 <- sendRecv h ("123", rId, "HOLD") (ok3, OK) #== "suspends connection" (rId2, rId) #== "same connection ID in response 2" Resp _ err3 <- sendRecv h ("456", sId, "SEND :hello") - (err3, ERROR AUTH) #== "rejects signed SEND" + (err3, ERR AUTH) #== "rejects signed SEND" Resp _ err4 <- sendRecv h ("", sId, "SEND :hello") - (err4, ERROR AUTH) #== "reject unsigned SEND too" + (err4, ERR AUTH) #== "reject unsigned SEND too" - Resp _ ok4 <- sendRecv h ("123", rId, "SUSPEND") - (ok4, OK) #== "accepts SUSPEND when suspended" + Resp _ ok4 <- sendRecv h ("123", rId, "HOLD") + (ok4, OK) #== "accepts HOLD when suspended" Resp _ ok5 <- sendRecv h ("123", rId, "SUB") (ok5, OK) #== "accepts SUB when suspended" - Resp _ err5 <- sendRecv h ("1234", rId, "DELETE") - (err5, ERROR AUTH) #== "rejects DELETE with wrong signature (password atm)" + Resp _ err5 <- sendRecv h ("1234", rId, "DEL") + (err5, ERR AUTH) #== "rejects DEL with wrong signature (password atm)" - Resp _ err6 <- sendRecv h ("123", sId, "DELETE") - (err6, ERROR AUTH) #== "rejects DELETE with sender's ID" + Resp _ err6 <- sendRecv h ("123", sId, "DEL") + (err6, ERR AUTH) #== "rejects DEL with sender's ID" - Resp rId3 ok6 <- sendRecv h ("123", rId, "DELETE") + Resp rId3 ok6 <- sendRecv h ("123", rId, "DEL") (ok6, OK) #== "deletes connection" (rId3, rId) #== "same connection ID in response 3" Resp _ err7 <- sendRecv h ("456", sId, "SEND :hello") - (err7, ERROR AUTH) #== "rejects signed SEND when deleted" + (err7, ERR AUTH) #== "rejects signed SEND when deleted" Resp _ err8 <- sendRecv h ("", sId, "SEND :hello") - (err8, ERROR AUTH) #== "rejects unsigned SEND too when deleted" + (err8, ERR AUTH) #== "rejects unsigned SEND too when deleted" - Resp _ err9 <- sendRecv h ("123", rId, "SUSPEND") - (err9, ERROR AUTH) #== "rejects SUSPEND when deleted" + Resp _ err9 <- sendRecv h ("123", rId, "HOLD") + (err9, ERR AUTH) #== "rejects HOLD when deleted" Resp _ err10 <- sendRecv h ("123", rId, "SUB") - (err10, ERROR AUTH) #== "rejects SUB when deleted" + (err10, ERR AUTH) #== "rejects SUB when deleted" syntaxTests :: SpecWith () syntaxTests = do - it "unknown command" $ [("", "123", "HELLO")] >#> [("", "123", "ERROR UNKNOWN")] - describe "CREATE" do - it "no parameters" $ [("", "", "CREATE")] >#> [("", "", "ERROR SYNTAX 2")] - it "many parameters" $ [("", "", "CREATE 1 2")] >#> [("", "", "ERROR SYNTAX 2")] - it "has signature" $ [("123", "", "CREATE 123")] >#> [("", "", "ERROR SYNTAX 4")] - it "connection ID" $ [("", "1", "CREATE 123")] >#> [("", "1", "ERROR SYNTAX 4")] + it "unknown command" $ [("", "123", "HELLO")] >#> [("", "123", "ERR UNKNOWN")] + describe "CONN" do + it "no parameters" $ [("", "", "CONN")] >#> [("", "", "ERR SYNTAX 2")] + it "many parameters" $ [("", "", "CONN 1 2")] >#> [("", "", "ERR SYNTAX 2")] + it "has signature" $ [("123", "", "CONN 123")] >#> [("", "", "ERR SYNTAX 4")] + it "connection ID" $ [("", "1", "CONN 123")] >#> [("", "1", "ERR SYNTAX 4")] + describe "KEY" do + it "valid syntax" $ [("123", "1", "KEY 456")] >#> [("", "1", "ERR AUTH")] + it "no parameters" $ [("123", "1", "KEY")] >#> [("", "1", "ERR SYNTAX 2")] + it "many parameters" $ [("123", "1", "KEY 1 2")] >#> [("", "1", "ERR SYNTAX 2")] + it "no signature" $ [("", "1", "KEY 456")] >#> [("", "1", "ERR SYNTAX 3")] + it "no connection ID" $ [("123", "", "KEY 456")] >#> [("", "", "ERR SYNTAX 3")] noParamsSyntaxTest "SUB" - oneParamSyntaxTest "SECURE" - oneParamSyntaxTest "DELMSG" - noParamsSyntaxTest "SUSPEND" - noParamsSyntaxTest "DELETE" + noParamsSyntaxTest "ACK" + noParamsSyntaxTest "HOLD" + noParamsSyntaxTest "DEL" describe "SEND" do - it "valid syntax 1" $ [("123", "1", "SEND :hello")] >#> [("", "1", "ERROR AUTH")] - it "valid syntax 2" $ [("123", "1", "SEND 11\nhello there\n")] >#> [("", "1", "ERROR AUTH")] - it "no parameters" $ [("123", "1", "SEND")] >#> [("", "1", "ERROR SYNTAX 2")] - it "many parameters" $ [("123", "1", "SEND 11 hello")] >#> [("", "1", "ERROR SYNTAX 2")] - it "no connection ID" $ [("123", "", "SEND :hello")] >#> [("", "", "ERROR SYNTAX 5")] - it "bad message body" $ [("123", "1", "SEND hello")] >#> [("", "1", "ERROR SYNTAX 6")] - it "bigger body" $ [("123", "1", "SEND 4\nhello\n")] >#> [("", "1", "ERROR SIZE")] + it "valid syntax 1" $ [("123", "1", "SEND :hello")] >#> [("", "1", "ERR AUTH")] + it "valid syntax 2" $ [("123", "1", "SEND 11\nhello there\n")] >#> [("", "1", "ERR AUTH")] + it "no parameters" $ [("123", "1", "SEND")] >#> [("", "1", "ERR SYNTAX 2")] + it "many parameters" $ [("123", "1", "SEND 11 hello")] >#> [("", "1", "ERR SYNTAX 2")] + it "no connection ID" $ [("123", "", "SEND :hello")] >#> [("", "", "ERR SYNTAX 5")] + it "bad message body" $ [("123", "1", "SEND hello")] >#> [("", "1", "ERR SYNTAX 6")] + it "bigger body" $ [("123", "1", "SEND 4\nhello\n")] >#> [("", "1", "ERR SIZE")] describe "broker response not allowed" do - it "OK" $ [("123", "1", "OK")] >#> [("", "1", "ERROR PROHIBITED")] + it "OK" $ [("123", "1", "OK")] >#> [("", "1", "ERR PROHIBITED")] where noParamsSyntaxTest :: String -> SpecWith () noParamsSyntaxTest cmd = describe cmd do - it "valid syntax" $ [("123", "1", cmd)] >#> [("", "1", "ERROR AUTH")] - it "parameters" $ [("123", "1", cmd ++ " 1")] >#> [("", "1", "ERROR SYNTAX 2")] - it "no signature" $ [("", "1", cmd)] >#> [("", "1", "ERROR SYNTAX 3")] - it "no connection ID" $ [("123", "", cmd)] >#> [("", "", "ERROR SYNTAX 3")] - - oneParamSyntaxTest :: String -> SpecWith () - oneParamSyntaxTest cmd = describe cmd do - it "valid syntax" $ [("123", "1", cmd ++ " 456")] >#> [("", "1", "ERROR AUTH")] - it "no parameters" $ [("123", "1", cmd)] >#> [("", "1", "ERROR SYNTAX 2")] - it "many parameters" $ [("123", "1", cmd ++ " 1 2")] >#> [("", "1", "ERROR SYNTAX 2")] - it "no signature" $ [("", "1", cmd ++ " 456")] >#> [("", "1", "ERROR SYNTAX 3")] - it "no connection ID" $ [("123", "", cmd ++ " 456")] >#> [("", "", "ERROR SYNTAX 3")] + it "valid syntax" $ [("123", "1", cmd)] >#> [("", "1", "ERR AUTH")] + it "parameters" $ [("123", "1", cmd ++ " 1")] >#> [("", "1", "ERR SYNTAX 2")] + it "no signature" $ [("", "1", cmd)] >#> [("", "1", "ERR SYNTAX 3")] + it "no connection ID" $ [("123", "", cmd)] >#> [("", "", "ERR SYNTAX 3")]