use base64 encoded IDs and bytestrings instead of strings

src/Server.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
@@ -16,8 +17,7 @@ import Control.Monad
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Crypto.Random
-import Data.ByteString (ByteString)
-import Data.ByteString.Base64
+import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.Map.Strict as M
 import Data.Singletons
@@ -79,7 +79,7 @@ receive h Client {rcvQ} = forever $ do
 send :: MonadUnliftIO m => Handle -> Client -> m ()
 send h Client {sndQ} = forever $ do
   signed <- atomically $ readTBQueue sndQ
-  tPut h ("", signed)
+  tPut h (B.empty, signed)
 
 verifyTransmission :: forall m. (MonadUnliftIO m, MonadReader Env m) => Signature -> ConnId -> Cmd -> m Signed
 verifyTransmission signature connId cmd = do
@@ -96,7 +96,7 @@ verifyTransmission signature connId cmd = do
       either (return . smpErr) f conn
     verifySend :: Maybe PublicKey -> m Cmd
     verifySend
-      | null signature = return . maybe cmd (const authErr)
+      | B.null signature = return . maybe cmd (const authErr)
       | otherwise = maybe (return authErr) verifySignature
     -- TODO stub
     verifySignature :: PublicKey -> m Cmd
@@ -134,7 +134,7 @@ client clnt@Client {connections, rcvQ, sndQ} Server {subscribedQ} =
         okResponse = mkSigned connId . either ERR (const OK)
 
         createConn :: MonadConnStore s m => s -> RecipientKey -> m Signed
-        createConn st rKey = mkSigned "" <$> addSubscribe
+        createConn st rKey = mkSigned B.empty <$> addSubscribe
           where
             addSubscribe = do
               addConn st getIds rKey >>= \case
@@ -210,7 +210,7 @@ client clnt@Client {connections, rcvQ, sndQ} Server {subscribedQ} =
 randomId :: (MonadUnliftIO m, MonadReader Env m) => Int -> m Encoded
 randomId n = do
   gVar <- asks idsDrg
-  B.unpack . encode <$> atomically (randomBytes n gVar)
+  atomically (randomBytes n gVar)
 
 randomBytes :: Int -> TVar ChaChaDRG -> STM ByteString
 randomBytes n gVar = do

src/Transmission.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -12,11 +13,13 @@
 
 module Transmission where
 
+import Data.ByteString.Base64
+import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Char (ord)
 import Data.Singletons.TH
 import Data.Time.Clock
 import Data.Time.ISO8601
-import Text.Read
 
 $( singletons
      [d|
@@ -38,7 +41,7 @@ type SignedOrError = (ConnId, Either ErrorType Cmd)
 
 type TransmissionOrError = (Signature, SignedOrError)
 
-type RawTransmission = (String, String, String)
+type RawTransmission = (ByteString, ByteString, ByteString)
 
 data Command (a :: Party) where
   CONN :: RecipientKey -> Command Recipient
@@ -58,26 +61,36 @@ deriving instance Show (Command a)
 
 deriving instance Eq (Command a)
 
-parseCommand :: String -> Either ErrorType Cmd
-parseCommand command = case words command of
-  ["CONN", recipientKey] -> rCmd $ CONN recipientKey
+parseCommand :: ByteString -> Either ErrorType Cmd
+parseCommand command = case B.words command of
+  ["CONN", rKeyStr] -> case decode rKeyStr of
+    Right rKey -> rCmd $ CONN rKey
+    _ -> errParams
   ["SUB"] -> rCmd SUB
-  ["KEY", senderKey] -> rCmd $ KEY senderKey
+  ["KEY", sKeyStr] -> case decode sKeyStr of
+    Right sKey -> rCmd $ KEY sKey
+    _ -> errParams
   ["ACK"] -> rCmd ACK
   ["OFF"] -> rCmd OFF
   ["DEL"] -> rCmd DEL
   ["SEND"] -> errParams
-  "SEND" : msgBody -> Right . Cmd SSender . SEND . B.pack $ unwords msgBody
-  ["IDS", rId, sId] -> bCmd $ IDS rId sId
-  ["MSG", msgId, ts, msgBody] -> case parseISO8601 ts of
-    Just utc -> bCmd $ MSG msgId utc (B.pack msgBody)
+  "SEND" : msgBody -> Right . Cmd SSender . SEND $ B.unwords msgBody
+  ["IDS", rIdStr, sIdStr] -> case decode rIdStr of
+    Right rId -> case decode sIdStr of
+      Right sId -> bCmd $ IDS rId sId
+      _ -> errParams
+    _ -> errParams
+  ["MSG", msgIdStr, ts, msgBody] -> case decode msgIdStr of
+    Right msgId -> case parseISO8601 $ B.unpack ts of
+      Just utc -> bCmd $ MSG msgId utc msgBody
+      _ -> errParams
     _ -> errParams
   ["END"] -> bCmd END
   ["OK"] -> bCmd OK
   "ERR" : err -> case err of
     ["UNKNOWN"] -> bErr UNKNOWN
     ["PROHIBITED"] -> bErr PROHIBITED
-    ["SYNTAX", errCode] -> maybe errParams (bErr . SYNTAX) $ readMaybe errCode
+    ["SYNTAX", errCode] -> maybe errParams (bErr . SYNTAX) $ digitToInt $ B.unpack errCode
     ["SIZE"] -> bErr SIZE
     ["AUTH"] -> bErr AUTH
     ["INTERNAL"] -> bErr INTERNAL
@@ -99,21 +112,30 @@ parseCommand command = case words command of
     bCmd = Right . Cmd SBroker
     bErr = bCmd . ERR
 
-serializeCommand :: Cmd -> String
-serializeCommand = \case
-  Cmd SRecipient (CONN rKey) -> "CONN " ++ rKey
-  Cmd SRecipient (KEY sKey) -> "KEY " ++ sKey
-  Cmd SRecipient cmd -> show cmd
-  Cmd SSender (SEND msgBody) -> "SEND" ++ serializeMsg msgBody
-  Cmd SBroker (MSG msgId ts msgBody) ->
-    unwords ["MSG", msgId, formatISO8601Millis ts] ++ serializeMsg msgBody
-  Cmd SBroker (IDS rId sId) -> unwords ["IDS", rId, sId]
-  Cmd SBroker (ERR err) -> "ERR " ++ show err
-  Cmd SBroker resp -> show resp
-  where
-    serializeMsg msgBody = " " ++ show (B.length msgBody) ++ "\n" ++ B.unpack msgBody
+digitToInt :: String -> Maybe Int
+digitToInt [c] =
+  let i = ord c - zero
+   in if i >= 0 && i <= 9 then Just i else Nothing
+digitToInt _ = Nothing
 
-type Encoded = String
+zero :: Int
+zero = ord '0'
+
+serializeCommand :: Cmd -> ByteString
+serializeCommand = \case
+  Cmd SRecipient (CONN rKey) -> "CONN " <> encode rKey
+  Cmd SRecipient (KEY sKey) -> "KEY " <> encode sKey
+  Cmd SRecipient cmd -> B.pack $ show cmd
+  Cmd SSender (SEND msgBody) -> "SEND" <> serializeMsg msgBody
+  Cmd SBroker (MSG msgId ts msgBody) ->
+    B.unwords ["MSG", encode msgId, B.pack $ formatISO8601Millis ts] <> serializeMsg msgBody
+  Cmd SBroker (IDS rId sId) -> B.unwords ["IDS", encode rId, encode sId]
+  Cmd SBroker (ERR err) -> "ERR " <> B.pack (show err)
+  Cmd SBroker resp -> B.pack $ show resp
+  where
+    serializeMsg msgBody = " " <> B.pack (show $ B.length msgBody) <> "\n" <> msgBody
+
+type Encoded = ByteString
 
 type PublicKey = Encoded
 
@@ -131,10 +153,13 @@ type ConnId = Encoded
 
 type MsgId = Encoded
 
-type MsgBody = B.ByteString
+type MsgBody = ByteString
 
 data ErrorType = UNKNOWN | PROHIBITED | SYNTAX Int | SIZE | AUTH | INTERNAL deriving (Show, Eq)
 
+errBadTransmission :: Int
+errBadTransmission = 1
+
 errBadParameters :: Int
 errBadParameters = 2
 

src/Transport.hs

@@ -10,6 +10,8 @@ module Transport where
 import Control.Monad.IO.Class
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
+import Data.ByteString.Base64
+import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Network.Socket
 import System.IO
@@ -67,27 +69,29 @@ getSocketHandle conn = liftIO $ do
   hSetBuffering h LineBuffering
   return h
 
-putLn :: MonadIO m => Handle -> String -> m ()
-putLn h = liftIO . hPutStrLn h
+putLn :: MonadIO m => Handle -> ByteString -> m ()
+putLn h = liftIO . hPutStrLn h . B.unpack
 
-getLn :: MonadIO m => Handle -> m String
-getLn = liftIO . hGetLine
+getLn :: MonadIO m => Handle -> m ByteString
+getLn h = B.pack <$> liftIO (hGetLine h)
 
-getBytes :: MonadIO m => Handle -> Int -> m B.ByteString
+getBytes :: MonadIO m => Handle -> Int -> m ByteString
 getBytes h = liftIO . B.hGet h
 
 tPutRaw :: MonadIO m => Handle -> RawTransmission -> m ()
 tPutRaw h (signature, connId, command) = do
-  putLn h signature
-  putLn h connId
+  putLn h (encode signature)
+  putLn h (encode connId)
   putLn h command
 
-tGetRaw :: MonadIO m => Handle -> m RawTransmission
-tGetRaw h = do
-  signature <- getLn h
-  connId <- getLn h
-  command <- getLn h
-  return (signature, connId, command)
+tGetRaw :: MonadIO m => Handle -> m (Maybe RawTransmission)
+tGetRaw h =
+  getDecodedLn $ \signature ->
+    getDecodedLn $ \connId -> do
+      command <- getLn h
+      return $ Just (signature, connId, command)
+  where
+    getDecodedLn f = getLn h >>= either (\_ -> return Nothing) f . decode
 
 tPut :: MonadIO m => Handle -> Transmission -> m ()
 tPut h (signature, (connId, command)) = tPutRaw h (signature, connId, serializeCommand command)
@@ -105,12 +109,17 @@ fromServer = \case
 -- | get client and server transmissions
 -- `fromParty` is used to limit allowed senders - `fromClient` or `fromServer` should be used
 tGet :: forall m. MonadIO m => (Cmd -> Either ErrorType Cmd) -> Handle -> m TransmissionOrError
-tGet fromParty h = do
-  t@(signature, connId, command) <- tGetRaw h
-  let cmd = (parseCommand >=> fromParty) command >>= tCredentials t
-  fullCmd <- either (return . Left) cmdWithMsgBody cmd
-  return (signature, (connId, fullCmd))
+tGet fromParty h = tGetRaw h >>= maybe badTransmission tParseComplete
   where
+    badTransmission :: m TransmissionOrError
+    badTransmission = return (B.empty, (B.empty, Left $ SYNTAX errBadTransmission))
+
+    tParseComplete :: RawTransmission -> m TransmissionOrError
+    tParseComplete t@(signature, connId, command) = do
+      let cmd = parseCommand command >>= fromParty >>= tCredentials t
+      fullCmd <- either (return . Left) cmdWithMsgBody cmd
+      return (signature, (connId, fullCmd))
+
     tCredentials :: RawTransmission -> Cmd -> Either ErrorType Cmd
     tCredentials (signature, connId, _) cmd = case cmd of
       -- IDS response should not have connection ID
@@ -119,19 +128,19 @@ tGet fromParty h = do
       Cmd SBroker (ERR _) -> Right cmd
       -- other responses must have connection ID
       Cmd SBroker _
-        | null connId -> Left $ SYNTAX errNoConnectionId
+        | B.null connId -> Left $ SYNTAX errNoConnectionId
         | otherwise -> Right cmd
       -- CREATE must NOT have signature or connection ID
       Cmd SRecipient (CONN _)
-        | null signature && null connId -> Right cmd
+        | B.null signature && B.null connId -> Right cmd
         | otherwise -> Left $ SYNTAX errHasCredentials
       -- SEND must have connection ID, signature is not always required
       Cmd SSender (SEND _)
-        | null connId -> Left $ SYNTAX errNoConnectionId
+        | B.null connId -> Left $ SYNTAX errNoConnectionId
         | otherwise -> Right cmd
       -- other client commands must have both signature and connection ID
       Cmd SRecipient _
-        | null signature || null connId -> Left $ SYNTAX errNoCredentials
+        | B.null signature || B.null connId -> Left $ SYNTAX errNoCredentials
         | otherwise -> Right cmd
 
     cmdWithMsgBody :: Cmd -> m (Either ErrorType Cmd)
@@ -154,5 +163,5 @@ tGet fromParty h = do
           Just size -> do
             body <- getBytes h size
             s <- getLn h
-            return if null s then Right body else Left SIZE
+            return if B.null s then Right body else Left SIZE
           Nothing -> return . Left $ SYNTAX errMessageBody

tests/SMPClient.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module SMPClient where
 
 import Control.Monad.IO.Unlift
 import Crypto.Random
+import Data.Maybe
 import Network.Socket
 import Numeric.Natural
 import Server
@@ -31,8 +33,6 @@ testHost = "localhost"
 queueSize :: Natural
 queueSize = 2
 
-type TestTransmission = (Signature, ConnId, String)
-
 runSmpTest :: (MonadUnliftIO m, MonadRandom m) => (Handle -> m a) -> m a
 runSmpTest test =
   E.bracket
@@ -40,8 +40,8 @@ runSmpTest test =
     (liftIO . killThread)
     \_ -> testSMPClient "localhost" testPort test
 
-smpServerTest :: [TestTransmission] -> IO [TestTransmission]
+smpServerTest :: [RawTransmission] -> IO [RawTransmission]
 smpServerTest commands = runSmpTest \h -> mapM (sendReceive h) commands
   where
-    sendReceive :: Handle -> TestTransmission -> IO TestTransmission
-    sendReceive h t = tPutRaw h t >> tGetRaw h
+    sendReceive :: Handle -> RawTransmission -> IO RawTransmission
+    sendReceive h t = tPutRaw h t >> fromJust <$> tGetRaw h

tests/Test.hs

@@ -4,6 +4,10 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 
+import Data.ByteString.Base64
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Either
 import SMPClient
 import System.IO (Handle)
 import Test.HUnit
@@ -11,7 +15,7 @@ import Test.Hspec
 import Transmission
 import Transport
 
-(>#>) :: [TestTransmission] -> [TestTransmission] -> Expectation
+(>#>) :: [RawTransmission] -> [RawTransmission] -> Expectation
 commands >#> responses = smpServerTest commands `shouldReturn` responses
 
 main :: IO ()
@@ -28,16 +32,16 @@ smpTest :: (Handle -> IO ()) -> Expectation
 smpTest test' = runSmpTest test' `shouldReturn` ()
 
 sendRecv :: Handle -> RawTransmission -> IO TransmissionOrError
-sendRecv h t = tPutRaw h t >> tGet fromServer h
+sendRecv h (sgn, cId, cmd) = tPutRaw h (fromRight "" $ decode sgn, cId, cmd) >> tGet fromServer h
 
 (#==) :: (HasCallStack, Eq a, Show a) => (a, a) -> String -> Assertion
 (actual, expected) #== message = assertEqual message expected actual
 
 testCreateSecure :: SpecWith ()
 testCreateSecure = do
-  it "CONN and KEY commands, SEND messages (no delivery yet)" $
+  it "CONN and KEY commands, SEND messages" $
     smpTest \h -> do
-      Resp rId1 (IDS rId sId) <- sendRecv h ("", "", "CONN 123")
+      Resp rId1 (IDS rId sId) <- sendRecv h ("", "", "CONN 1234")
       (rId1, "") #== "creates connection"
 
       Resp sId1 ok1 <- sendRecv h ("", sId, "SEND :hello")
@@ -47,33 +51,33 @@ testCreateSecure = do
       Resp _ (MSG _ _ msg1) <- tGet fromServer h
       (msg1, "hello") #== "delivers message"
 
-      Resp _ ok4 <- sendRecv h ("123", rId, "ACK")
+      Resp _ ok4 <- sendRecv h ("1234", rId, "ACK")
       (ok4, OK) #== "replies OK when message acknowledged if no more messages"
 
-      Resp sId2 err1 <- sendRecv h ("456", sId, "SEND :hello")
+      Resp sId2 err1 <- sendRecv h ("4567", sId, "SEND :hello")
       (err1, ERR AUTH) #== "rejects signed SEND"
       (sId2, sId) #== "same connection ID in response 2"
 
-      Resp _ err2 <- sendRecv h ("1234", rId, "KEY 456")
+      Resp _ err2 <- sendRecv h ("12345678", rId, "KEY 4567")
       (err2, ERR AUTH) #== "rejects KEY with wrong signature (password atm)"
 
-      Resp _ err3 <- sendRecv h ("123", sId, "KEY 456")
+      Resp _ err3 <- sendRecv h ("1234", sId, "KEY 4567")
       (err3, ERR AUTH) #== "rejects KEY with sender's ID"
 
-      Resp rId2 ok2 <- sendRecv h ("123", rId, "KEY 456")
+      Resp rId2 ok2 <- sendRecv h ("1234", rId, "KEY 4567")
       (ok2, OK) #== "secures connection"
       (rId2, rId) #== "same connection ID in response 3"
 
-      Resp _ err4 <- sendRecv h ("123", rId, "KEY 456")
+      Resp _ err4 <- sendRecv h ("1234", rId, "KEY 4567")
       (err4, ERR AUTH) #== "rejects KEY if already secured"
 
-      Resp _ ok3 <- sendRecv h ("456", sId, "SEND 11\nhello again")
+      Resp _ ok3 <- sendRecv h ("4567", sId, "SEND 11\nhello again")
       (ok3, OK) #== "accepts signed SEND"
 
       Resp _ (MSG _ _ msg) <- tGet fromServer h
       (msg, "hello again") #== "delivers message 2"
 
-      Resp _ ok5 <- sendRecv h ("123", rId, "ACK")
+      Resp _ ok5 <- sendRecv h ("1234", rId, "ACK")
       (ok5, OK) #== "replies OK when message acknowledged 2"
 
       Resp _ err5 <- sendRecv h ("", sId, "SEND :hello")
@@ -81,96 +85,96 @@ testCreateSecure = do
 
 testCreateDelete :: SpecWith ()
 testCreateDelete = do
-  it "CONN, OFF and DEL commands, SEND messages (no delivery yet)" $
+  it "CONN, OFF and DEL commands, SEND messages" $
     smpTest \h -> do
-      Resp rId1 (IDS rId sId) <- sendRecv h ("", "", "CONN 123")
+      Resp rId1 (IDS rId sId) <- sendRecv h ("", "", "CONN 1234")
       (rId1, "") #== "creates connection"
 
-      Resp _ ok1 <- sendRecv h ("123", rId, "KEY 456")
+      Resp _ ok1 <- sendRecv h ("1234", rId, "KEY 4567")
       (ok1, OK) #== "secures connection"
 
-      Resp _ ok2 <- sendRecv h ("456", sId, "SEND :hello")
+      Resp _ ok2 <- sendRecv h ("4567", sId, "SEND :hello")
       (ok2, OK) #== "accepts signed SEND"
 
       Resp _ (MSG _ _ msg1) <- tGet fromServer h
       (msg1, "hello") #== "delivers message"
 
-      Resp _ err1 <- sendRecv h ("1234", rId, "OFF")
+      Resp _ err1 <- sendRecv h ("12345678", rId, "OFF")
       (err1, ERR AUTH) #== "rejects OFF with wrong signature (password atm)"
 
-      Resp _ err2 <- sendRecv h ("123", sId, "OFF")
+      Resp _ err2 <- sendRecv h ("1234", sId, "OFF")
       (err2, ERR AUTH) #== "rejects OFF with sender's ID"
 
-      Resp rId2 ok3 <- sendRecv h ("123", rId, "OFF")
+      Resp rId2 ok3 <- sendRecv h ("1234", rId, "OFF")
       (ok3, OK) #== "suspends connection"
       (rId2, rId) #== "same connection ID in response 2"
 
-      Resp _ err3 <- sendRecv h ("456", sId, "SEND :hello")
+      Resp _ err3 <- sendRecv h ("4567", sId, "SEND :hello")
       (err3, ERR AUTH) #== "rejects signed SEND"
 
       Resp _ err4 <- sendRecv h ("", sId, "SEND :hello")
       (err4, ERR AUTH) #== "reject unsigned SEND too"
 
-      Resp _ ok4 <- sendRecv h ("123", rId, "OFF")
+      Resp _ ok4 <- sendRecv h ("1234", rId, "OFF")
       (ok4, OK) #== "accepts OFF when suspended"
 
-      Resp _ (MSG _ _ msg) <- sendRecv h ("123", rId, "SUB")
+      Resp _ (MSG _ _ msg) <- sendRecv h ("1234", rId, "SUB")
       (msg, "hello") #== "accepts SUB when suspended and delivers the message again (because was not ACKed)"
 
-      Resp _ err5 <- sendRecv h ("1234", rId, "DEL")
+      Resp _ err5 <- sendRecv h ("12345678", rId, "DEL")
       (err5, ERR AUTH) #== "rejects DEL with wrong signature (password atm)"
 
-      Resp _ err6 <- sendRecv h ("123", sId, "DEL")
+      Resp _ err6 <- sendRecv h ("1234", sId, "DEL")
       (err6, ERR AUTH) #== "rejects DEL with sender's ID"
 
-      Resp rId3 ok6 <- sendRecv h ("123", rId, "DEL")
+      Resp rId3 ok6 <- sendRecv h ("1234", rId, "DEL")
       (ok6, OK) #== "deletes connection"
       (rId3, rId) #== "same connection ID in response 3"
 
-      Resp _ err7 <- sendRecv h ("456", sId, "SEND :hello")
+      Resp _ err7 <- sendRecv h ("4567", sId, "SEND :hello")
       (err7, ERR AUTH) #== "rejects signed SEND when deleted"
 
       Resp _ err8 <- sendRecv h ("", sId, "SEND :hello")
       (err8, ERR AUTH) #== "rejects unsigned SEND too when deleted"
 
-      Resp _ err9 <- sendRecv h ("123", rId, "OFF")
+      Resp _ err9 <- sendRecv h ("1234", rId, "OFF")
       (err9, ERR AUTH) #== "rejects OFF when deleted"
 
-      Resp _ err10 <- sendRecv h ("123", rId, "SUB")
+      Resp _ err10 <- sendRecv h ("1234", rId, "SUB")
       (err10, ERR AUTH) #== "rejects SUB when deleted"
 
 syntaxTests :: SpecWith ()
 syntaxTests = do
-  it "unknown command" $ [("", "123", "HELLO")] >#> [("", "123", "ERR UNKNOWN")]
+  it "unknown command" $ [("", "1234", "HELLO")] >#> [("", "1234", "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")]
+    it "has signature" $ [("1234", "", "CONN 1234")] >#> [("", "", "ERR SYNTAX 4")]
+    it "connection ID" $ [("", "1", "CONN 1234")] >#> [("", "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")]
+    it "valid syntax" $ [("1234", "1", "KEY 4567")] >#> [("", "1", "ERR AUTH")]
+    it "no parameters" $ [("1234", "1", "KEY")] >#> [("", "1", "ERR SYNTAX 2")]
+    it "many parameters" $ [("1234", "1", "KEY 1 2")] >#> [("", "1", "ERR SYNTAX 2")]
+    it "no signature" $ [("", "1", "KEY 4567")] >#> [("", "1", "ERR SYNTAX 3")]
+    it "no connection ID" $ [("1234", "", "KEY 4567")] >#> [("", "", "ERR SYNTAX 3")]
   noParamsSyntaxTest "SUB"
   noParamsSyntaxTest "ACK"
   noParamsSyntaxTest "OFF"
   noParamsSyntaxTest "DEL"
   describe "SEND" do
-    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 "no connection ID" $ [("123", "", "SEND :hello")] >#> [("", "", "ERR SYNTAX 5")]
-    it "bad message body 1" $ [("123", "1", "SEND 11 hello")] >#> [("", "1", "ERR SYNTAX 6")]
-    it "bad message body 2" $ [("123", "1", "SEND hello")] >#> [("", "1", "ERR SYNTAX 6")]
-    it "bigger body" $ [("123", "1", "SEND 4\nhello\n")] >#> [("", "1", "ERR SIZE")]
+    it "valid syntax 1" $ [("1234", "1", "SEND :hello")] >#> [("", "1", "ERR AUTH")]
+    it "valid syntax 2" $ [("1234", "1", "SEND 11\nhello there\n")] >#> [("", "1", "ERR AUTH")]
+    it "no parameters" $ [("1234", "1", "SEND")] >#> [("", "1", "ERR SYNTAX 2")]
+    it "no connection ID" $ [("1234", "", "SEND :hello")] >#> [("", "", "ERR SYNTAX 5")]
+    it "bad message body 1" $ [("1234", "1", "SEND 11 hello")] >#> [("", "1", "ERR SYNTAX 6")]
+    it "bad message body 2" $ [("1234", "1", "SEND hello")] >#> [("", "1", "ERR SYNTAX 6")]
+    it "bigger body" $ [("1234", "1", "SEND 4\nhello\n")] >#> [("", "1", "ERR SIZE")]
   describe "broker response not allowed" do
-    it "OK" $ [("123", "1", "OK")] >#> [("", "1", "ERR PROHIBITED")]
+    it "OK" $ [("1234", "1", "OK")] >#> [("", "1", "ERR PROHIBITED")]
   where
-    noParamsSyntaxTest :: String -> SpecWith ()
-    noParamsSyntaxTest cmd = describe cmd do
-      it "valid syntax" $ [("123", "1", cmd)] >#> [("", "1", "ERR AUTH")]
-      it "parameters" $ [("123", "1", cmd ++ " 1")] >#> [("", "1", "ERR SYNTAX 2")]
+    noParamsSyntaxTest :: ByteString -> SpecWith ()
+    noParamsSyntaxTest cmd = describe (B.unpack cmd) do
+      it "valid syntax" $ [("1234", "1", cmd)] >#> [("", "1", "ERR AUTH")]
+      it "parameters" $ [("1234", "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")]
+      it "no connection ID" $ [("1234", "", cmd)] >#> [("", "", "ERR SYNTAX 3")]