resp 1.0.0 → 2.0.0
raw patch · 4 files changed
+55/−47 lines, 4 files
Files
- CHANGELOG.md +6/−1
- resp.cabal +1/−1
- src/Data/RESP.hs +35/−29
- test/Main.hs +13/−16
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Revision history for resp -## 1.0.0 -- YYYY-mm-dd+## 2.0.0 -- 2024-01-26++* Change name of type RespReply to RespMessage+* Change name of RespExpr data constructor to RespReply++## 1.0.0 -- 2024-01-23 * First version. Released on an unsuspecting world.
resp.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: resp-version: 1.0.0+version: 2.0.0 license: BSD-3-Clause license-file: LICENSE author: Owen Shepherd
src/Data/RESP.hs view
@@ -4,12 +4,23 @@ #endif {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric #-} +{-|+RESP is the wire protocol that Redis uses.+The latest version is RESP3, which at time of writing+seems relatively complete, but may still be evolving.++This module parses the entire RESP3 spec (as of 2024-01-26),+but also parses some invalid RESP forms that Redis may return,+eg `-nan`, and parses RESP2 forms that have been removed from+the spec (eg `$-1\r\n`).+-}+ module Data.RESP- ( RespReply(..)+ ( RespMessage(..) , RespExpr(..)- , parseReply+ , parseMessage , parseExpression ) where @@ -39,22 +50,20 @@ import Control.Monad (when, replicateM) import GHC.Generics (Generic) --- This type synonym was introduced in bytestring 0.11.2.0-type LazyByteString = BSL.ByteString- #if MIN_VERSION_bytestring(0,10,0)-lazyBsToStrict :: LazyByteString -> ByteString+lazyBsToStrict :: BSL.ByteString -> ByteString lazyBsToStrict = BSL.toStrict #else-lazyBsToStrict :: LazyByteString -> ByteString+lazyBsToStrict :: BSL.ByteString -> ByteString lazyBsToStrict = BS.concat . BSL.toChunks #endif --- | Top-level resp reply.--- Cannot be nested.-data RespReply+-- | A message from the server (eg. Redis) to the client.+-- This can be a push message (for pub/sub), or a reply to a command+-- issued by the client.+data RespMessage = RespPush !ByteString ![RespExpr]- | RespExpr !RespExpr+ | RespReply !RespExpr deriving (Show, Eq, Ord, Generic) -- | RESP3 Expression.@@ -69,22 +78,19 @@ -- previous versions of the RESP spec, and clients should treat the -- different encodings the same. ----- Why don't we parse `RespString` into `Text`? Well, the caller might+-- Why don't we parse `RespString` into `Data.Text.Text`? Well, the caller might -- not actually need to decode it into text, and so we let the caller -- decide. This way, we don't have to deal with encoding errors. ----- Similarly, we don't parse a `RespMap` into a `HashMap`, because--- that would involve imposing our choice of data structure on the caller.--- They might want to use `HashMap`, `Map`, or just use the `lookup`+-- Similarly, we don't parse a `RespMap` into a `Data.HashMap.HashMap`,+-- because that would involve imposing our choice of data structure on+-- the caller. The caller might want to use `Data.HashMap.HashMap`,+-- `Data.Map.Map`, iterate over the elements, or just use the `lookup` -- function.------ Given these choices, our purview is simple: Parse the text protocol--- into a Haskell datatype, maintaining all useful information, and not--- imposing our taste onto the caller. data RespExpr = RespString !ByteString | RespBlob !ByteString- | RespStreamingBlob !LazyByteString+ | RespStreamingBlob !BSL.ByteString | RespStringError !ByteString | RespBlobError !ByteString | RespArray ![RespExpr]@@ -109,19 +115,19 @@ | NMSMinusOne | NMSFixed Int --- Top level RESP item-parseReply :: Scanner RespReply-parseReply = do+-- | Parse a RESP3 message+parseMessage :: Scanner RespMessage+parseMessage = do c <- Scanner.anyChar8 case c of '>' -> parsePush- _ -> RespExpr <$> parseExpression' c+ _ -> RespReply <$> parseExpression' c --- Non-top-level resp item+-- | Parse a RESP3 expression parseExpression :: Scanner RespExpr parseExpression = Scanner.anyChar8 >>= parseExpression' --- Non-top-level resp item, taking its first char as a parameter+-- | Parse a RESP3 expression, taking its first char as a parameter parseExpression' :: Char -> Scanner RespExpr parseExpression' c = case c of '$' -> parseBlob@@ -140,7 +146,7 @@ '|' -> RespAttribute <$> parseMap <*> parseExpression _ -> fail $ "Unknown expression prefix: " <> show c -parsePush :: Scanner RespReply+parsePush :: Scanner RespMessage parsePush = do len <- parseMessageSize RespPush <$> parsePushType <*> replicateM (pred len) parseExpression@@ -300,7 +306,7 @@ -- general case for something that's pretty blobstring-like parseBlob' :: (ByteString -> a)- -> (LazyByteString -> a)+ -> (BSL.ByteString -> a) -> Scanner a -> Scanner a parseBlob' strictConstr lazyConstr nullConstr = do
test/Main.hs view
@@ -18,12 +18,9 @@ #endif import Data.ByteString (ByteString)-import Data.RESP (RespReply(..), RespExpr(..))+import Data.RESP (RespMessage(..), RespExpr(..)) import qualified Data.ByteString.UTF8 as BSU import qualified Data.RESP as R3--- import qualified Data.Text.Encoding as T--- import qualified Data.Text as T--- import Data.Text (Text) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as BSL@@ -111,14 +108,14 @@ RespNull -> [] RespAttribute a b -> RespAttribute <$> shrink a <*> shrink b -instance Arbitrary RespReply where+instance Arbitrary RespMessage where arbitrary = QC.oneof [ RespPush <$> arbBs <*> arbitrary- , RespExpr <$> arbitrary+ , RespReply <$> arbitrary ] shrink reply = case reply of RespPush a b -> RespPush <$> shrinkBs a <*> shrink b- RespExpr a -> RespExpr <$> shrink a+ RespReply a -> RespReply <$> shrink a showBs :: Show a => a -> ByteString showBs = BSU.fromString . show@@ -160,17 +157,17 @@ encodeTup :: (RespExpr, RespExpr) -> [ByteString] encodeTup (a, b) = concatMap encodeExpr' [a, b] -encodeReply :: RespReply -> ByteString-encodeReply repl = BS.concat $ case repl of+encodeMessage :: RespMessage -> ByteString+encodeMessage repl = BS.concat $ case repl of RespPush t msgs -> [">", showBs $ succ $ length msgs, eol, "$", showBs $ BS.length t, eol, t, eol] <> concatMap encodeExpr' msgs- RespExpr e -> encodeExpr' e+ RespReply e -> encodeExpr' e parseExpr :: ByteString -> Either String RespExpr parseExpr = scanOnly R3.parseExpression -parseReply :: ByteString -> Either String RespReply-parseReply = scanOnly R3.parseReply+parseMessage :: ByteString -> Either String RespMessage+parseMessage = scanOnly R3.parseMessage testStr :: ByteString -> ByteString -> Assertion testStr bs expected = parseExpr bs @?= Right (RespString expected)@@ -363,13 +360,13 @@ , testGroup "push" -- from markdown spec- [ testCase "empty" $ parseReply ">1\r\n+test\r\n\r\n" @?= Right (RespPush "test" [])- , testCase "simple message type" $ parseReply ">3\r\n+message\r\n+somechannel\r\n+this is the message\r\n"+ [ testCase "empty" $ parseMessage ">1\r\n+test\r\n\r\n" @?= Right (RespPush "test" [])+ , testCase "simple message type" $ parseMessage ">3\r\n+message\r\n+somechannel\r\n+this is the message\r\n" @?= Right (RespPush "message" [RespString "somechannel", RespString "this is the message"])- , testCase "blob string els" $ parseReply ">3\r\n$7\r\nmessage\r\n$6\r\nsecond\r\n$5\r\nHello\r\n"+ , testCase "blob string els" $ parseMessage ">3\r\n$7\r\nmessage\r\n$6\r\nsecond\r\n$5\r\nHello\r\n" @?= Right (RespPush "message" [RespBlob "second", RespBlob "Hello"]) ] , testProperty "roundtrip expr" $ \ex -> parseExpr (encodeExpr ex) === Right ex- , testProperty "roundtrip reply" $ \reply -> parseReply (encodeReply reply) === Right reply+ , testProperty "roundtrip reply" $ \reply -> parseMessage (encodeMessage reply) === Right reply ]