mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-09-26 20:18:00 +00:00
change command names
This commit is contained in:
Evgeny Poberezkin
+14
-13
@@ -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
|
||||
|
||||
+35
-32
@@ -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
|
||||
|
||||
+4
-4
@@ -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 <$$>
|
||||
|
||||
Reference in New Issue
Block a user