module Codec.Compression.SnappyC.Internal.FrameFormat
(
Frame(..)
, FrameIdentifier(..)
, Encoder(..)
, EncodeParams(..)
, FrameSize
, Threshold(..)
, EncodeState(..)
, EncodeResult(..)
, initializeEncoder
, defaultEncodeParams
, finalizeEncoder
, encodeBuffered
, customFrameSize
, unFrameSize
, defaultFrameSize
, Decoder(..)
, DecodeParams(..)
, DecodeState(..)
, DecodeResult(..)
, DecodeFailure(..)
, initializeDecoder
, defaultDecodeParams
, finalizeDecoder
, decodeBuffered
) where
import Codec.Compression.SnappyC.Internal.Buffer (Buffer)
import Codec.Compression.SnappyC.Internal.Buffer qualified as Buffer
import Codec.Compression.SnappyC.Internal.Checksum (Checksum)
import Codec.Compression.SnappyC.Internal.Checksum qualified as Checksum
import Codec.Compression.SnappyC.Raw qualified as Raw
import Control.Exception
import Control.Monad.Error.Class
import Data.Bits
import Data.ByteString qualified as Strict (ByteString)
import Data.ByteString qualified as BS.Strict
import Data.Default
import Data.Word
import Text.Printf
import Control.Monad
data Frame =
Frame
{ :: !FrameHeader
, Frame -> ByteString
framePayload :: !Strict.ByteString
}
deriving Int -> Frame -> ShowS
[Frame] -> ShowS
Frame -> [Char]
(Int -> Frame -> ShowS)
-> (Frame -> [Char]) -> ([Frame] -> ShowS) -> Show Frame
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Frame -> ShowS
showsPrec :: Int -> Frame -> ShowS
$cshow :: Frame -> [Char]
show :: Frame -> [Char]
$cshowList :: [Frame] -> ShowS
showList :: [Frame] -> ShowS
Show
data =
{ :: !FrameIdentifier
, :: !Int
}
deriving (Int -> FrameHeader -> ShowS
[FrameHeader] -> ShowS
FrameHeader -> [Char]
(Int -> FrameHeader -> ShowS)
-> (FrameHeader -> [Char])
-> ([FrameHeader] -> ShowS)
-> Show FrameHeader
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FrameHeader -> ShowS
showsPrec :: Int -> FrameHeader -> ShowS
$cshow :: FrameHeader -> [Char]
show :: FrameHeader -> [Char]
$cshowList :: [FrameHeader] -> ShowS
showList :: [FrameHeader] -> ShowS
Show, FrameHeader -> FrameHeader -> Bool
(FrameHeader -> FrameHeader -> Bool)
-> (FrameHeader -> FrameHeader -> Bool) -> Eq FrameHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FrameHeader -> FrameHeader -> Bool
== :: FrameHeader -> FrameHeader -> Bool
$c/= :: FrameHeader -> FrameHeader -> Bool
/= :: FrameHeader -> FrameHeader -> Bool
Eq)
data FrameIdentifier =
StreamId
| Compressed
| Uncompressed
| Padding
| ReservedUnskippable Word8
| ReservedSkippable Word8
deriving (Int -> FrameIdentifier -> ShowS
[FrameIdentifier] -> ShowS
FrameIdentifier -> [Char]
(Int -> FrameIdentifier -> ShowS)
-> (FrameIdentifier -> [Char])
-> ([FrameIdentifier] -> ShowS)
-> Show FrameIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FrameIdentifier -> ShowS
showsPrec :: Int -> FrameIdentifier -> ShowS
$cshow :: FrameIdentifier -> [Char]
show :: FrameIdentifier -> [Char]
$cshowList :: [FrameIdentifier] -> ShowS
showList :: [FrameIdentifier] -> ShowS
Show, FrameIdentifier -> FrameIdentifier -> Bool
(FrameIdentifier -> FrameIdentifier -> Bool)
-> (FrameIdentifier -> FrameIdentifier -> Bool)
-> Eq FrameIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FrameIdentifier -> FrameIdentifier -> Bool
== :: FrameIdentifier -> FrameIdentifier -> Bool
$c/= :: FrameIdentifier -> FrameIdentifier -> Bool
/= :: FrameIdentifier -> FrameIdentifier -> Bool
Eq)
encodeFrameIdentifier :: FrameIdentifier -> Word8
encodeFrameIdentifier :: FrameIdentifier -> Word8
encodeFrameIdentifier FrameIdentifier
StreamId = Word8
0xff
encodeFrameIdentifier FrameIdentifier
Compressed = Word8
0x00
encodeFrameIdentifier FrameIdentifier
Uncompressed = Word8
0x01
encodeFrameIdentifier FrameIdentifier
Padding = Word8
0xfd
encodeFrameIdentifier (ReservedUnskippable Word8
fid) = Word8
fid
encodeFrameIdentifier (ReservedSkippable Word8
fid) = Word8
fid
encodeFrameHeader :: FrameHeader -> Strict.ByteString
(FrameHeader FrameIdentifier
ident Int
size)=
[Word8] -> ByteString
BS.Strict.pack
[ FrameIdentifier -> Word8
encodeFrameIdentifier FrameIdentifier
ident
, Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w32Size Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x000000ff)
, Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word32
w32Size Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x0000ff00) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8
, Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word32
w32Size Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x00ff0000) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16
]
where
w32Size :: Word32
w32Size :: Word32
w32Size = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size
newtype Encoder = Encoder { Encoder -> Buffer
encoderBuffer :: Buffer }
deriving Int -> Encoder -> ShowS
[Encoder] -> ShowS
Encoder -> [Char]
(Int -> Encoder -> ShowS)
-> (Encoder -> [Char]) -> ([Encoder] -> ShowS) -> Show Encoder
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Encoder -> ShowS
showsPrec :: Int -> Encoder -> ShowS
$cshow :: Encoder -> [Char]
show :: Encoder -> [Char]
$cshowList :: [Encoder] -> ShowS
showList :: [Encoder] -> ShowS
Show
data EncodeParams =
EncodeParams
{
EncodeParams -> FrameSize
frameSize :: !FrameSize
, EncodeParams -> Threshold
threshold :: !Threshold
}
deriving (Int -> EncodeParams -> ShowS
[EncodeParams] -> ShowS
EncodeParams -> [Char]
(Int -> EncodeParams -> ShowS)
-> (EncodeParams -> [Char])
-> ([EncodeParams] -> ShowS)
-> Show EncodeParams
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncodeParams -> ShowS
showsPrec :: Int -> EncodeParams -> ShowS
$cshow :: EncodeParams -> [Char]
show :: EncodeParams -> [Char]
$cshowList :: [EncodeParams] -> ShowS
showList :: [EncodeParams] -> ShowS
Show, EncodeParams -> EncodeParams -> Bool
(EncodeParams -> EncodeParams -> Bool)
-> (EncodeParams -> EncodeParams -> Bool) -> Eq EncodeParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncodeParams -> EncodeParams -> Bool
== :: EncodeParams -> EncodeParams -> Bool
$c/= :: EncodeParams -> EncodeParams -> Bool
/= :: EncodeParams -> EncodeParams -> Bool
Eq)
instance Default EncodeParams where
def :: EncodeParams
def :: EncodeParams
def = EncodeParams
defaultEncodeParams
defaultEncodeParams :: EncodeParams
defaultEncodeParams :: EncodeParams
defaultEncodeParams = FrameSize -> Threshold -> EncodeParams
EncodeParams FrameSize
forall a. Default a => a
def Threshold
forall a. Default a => a
def
newtype FrameSize = FrameSize Int
deriving (Int -> FrameSize -> ShowS
[FrameSize] -> ShowS
FrameSize -> [Char]
(Int -> FrameSize -> ShowS)
-> (FrameSize -> [Char])
-> ([FrameSize] -> ShowS)
-> Show FrameSize
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FrameSize -> ShowS
showsPrec :: Int -> FrameSize -> ShowS
$cshow :: FrameSize -> [Char]
show :: FrameSize -> [Char]
$cshowList :: [FrameSize] -> ShowS
showList :: [FrameSize] -> ShowS
Show, FrameSize -> FrameSize -> Bool
(FrameSize -> FrameSize -> Bool)
-> (FrameSize -> FrameSize -> Bool) -> Eq FrameSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FrameSize -> FrameSize -> Bool
== :: FrameSize -> FrameSize -> Bool
$c/= :: FrameSize -> FrameSize -> Bool
/= :: FrameSize -> FrameSize -> Bool
Eq)
instance Default FrameSize where
def :: FrameSize
def :: FrameSize
def = FrameSize
defaultFrameSize
defaultFrameSize :: FrameSize
defaultFrameSize :: FrameSize
defaultFrameSize = Int -> FrameSize
FrameSize Int
snappySpecMaxChunkBytes
snappySpecMaxChunkBytes :: Int
snappySpecMaxChunkBytes :: Int
snappySpecMaxChunkBytes = Int
65536
customFrameSize :: Int -> FrameSize
customFrameSize :: Int -> FrameSize
customFrameSize Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
snappySpecMaxChunkBytes
= Int -> FrameSize
FrameSize Int
n
| Bool
otherwise
= [Char] -> FrameSize
forall a. HasCallStack => [Char] -> a
error [Char]
"customFrameSize: invalid frame size"
unFrameSize :: FrameSize -> Int
unFrameSize :: FrameSize -> Int
unFrameSize (FrameSize Int
n) = Int
n
data Threshold =
AlwaysCompress
| NeverCompress
| Ratio !Double
deriving (Int -> Threshold -> ShowS
[Threshold] -> ShowS
Threshold -> [Char]
(Int -> Threshold -> ShowS)
-> (Threshold -> [Char])
-> ([Threshold] -> ShowS)
-> Show Threshold
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Threshold -> ShowS
showsPrec :: Int -> Threshold -> ShowS
$cshow :: Threshold -> [Char]
show :: Threshold -> [Char]
$cshowList :: [Threshold] -> ShowS
showList :: [Threshold] -> ShowS
Show, Threshold -> Threshold -> Bool
(Threshold -> Threshold -> Bool)
-> (Threshold -> Threshold -> Bool) -> Eq Threshold
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Threshold -> Threshold -> Bool
== :: Threshold -> Threshold -> Bool
$c/= :: Threshold -> Threshold -> Bool
/= :: Threshold -> Threshold -> Bool
Eq)
instance Default Threshold where
def :: Threshold
def :: Threshold
def = Threshold
defaultThreshold
defaultThreshold :: Threshold
defaultThreshold :: Threshold
defaultThreshold = Double -> Threshold
Ratio (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.875)
newtype EncodeState =
EncodeState { EncodeState -> Int
encodeStateMaxChunkBytes :: Int }
deriving Int -> EncodeState -> ShowS
[EncodeState] -> ShowS
EncodeState -> [Char]
(Int -> EncodeState -> ShowS)
-> (EncodeState -> [Char])
-> ([EncodeState] -> ShowS)
-> Show EncodeState
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncodeState -> ShowS
showsPrec :: Int -> EncodeState -> ShowS
$cshow :: EncodeState -> [Char]
show :: EncodeState -> [Char]
$cshowList :: [EncodeState] -> ShowS
showList :: [EncodeState] -> ShowS
Show
data EncodeResult =
EncodeResult
{ EncodeResult -> [ByteString]
encodeResultEncoded :: [Strict.ByteString]
, EncodeResult -> Encoder
encodeResultEncoder :: !Encoder
}
deriving Int -> EncodeResult -> ShowS
[EncodeResult] -> ShowS
EncodeResult -> [Char]
(Int -> EncodeResult -> ShowS)
-> (EncodeResult -> [Char])
-> ([EncodeResult] -> ShowS)
-> Show EncodeResult
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncodeResult -> ShowS
showsPrec :: Int -> EncodeResult -> ShowS
$cshow :: EncodeResult -> [Char]
show :: EncodeResult -> [Char]
$cshowList :: [EncodeResult] -> ShowS
showList :: [EncodeResult] -> ShowS
Show
initializeEncoder :: (Strict.ByteString, Encoder)
initializeEncoder :: (ByteString, Encoder)
initializeEncoder =
( ByteString
"\xff\x06\x00\00sNaPpY"
, Encoder
{ encoderBuffer :: Buffer
encoderBuffer = Buffer
Buffer.empty
}
)
finalizeEncoder :: EncodeParams -> Encoder -> [Strict.ByteString]
finalizeEncoder :: EncodeParams -> Encoder -> [ByteString]
finalizeEncoder EncodeParams
ep (Encoder Buffer
b)
| Buffer -> Bool
Buffer.null Buffer
b
= []
| Bool
otherwise
= EncodeParams -> ByteString -> [ByteString]
encodeChunk EncodeParams
ep (Buffer -> ByteString
Buffer.toStrict Buffer
b)
encodeBuffered :: EncodeParams -> Encoder -> EncodeResult
encodeBuffered :: EncodeParams -> Encoder -> EncodeResult
encodeBuffered ep :: EncodeParams
ep@EncodeParams{Threshold
FrameSize
frameSize :: EncodeParams -> FrameSize
threshold :: EncodeParams -> Threshold
frameSize :: FrameSize
threshold :: Threshold
..} = \(Encoder Buffer
b) ->
[ByteString] -> Buffer -> EncodeResult
go [] Buffer
b
where
go :: [Strict.ByteString] -> Buffer -> EncodeResult
go :: [ByteString] -> Buffer -> EncodeResult
go [ByteString]
acc Buffer
b =
case Int -> Buffer -> Either Int (ByteString, Buffer)
Buffer.splitExactly (FrameSize -> Int
unFrameSize FrameSize
frameSize) Buffer
b of
Right (ByteString
chunk, Buffer
b') ->
[ByteString] -> Buffer -> EncodeResult
go ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse (EncodeParams -> ByteString -> [ByteString]
encodeChunk EncodeParams
ep ByteString
chunk) [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
acc) Buffer
b'
Left Int
_ ->
[ByteString] -> Encoder -> EncodeResult
EncodeResult
([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc)
(Buffer -> Encoder
Encoder Buffer
b)
encodeChunk ::
EncodeParams
-> Strict.ByteString
-> [Strict.ByteString]
encodeChunk :: EncodeParams -> ByteString -> [ByteString]
encodeChunk EncodeParams{Threshold
FrameSize
frameSize :: EncodeParams -> FrameSize
threshold :: EncodeParams -> Threshold
frameSize :: FrameSize
threshold :: Threshold
..} ByteString
uncompressed =
[ FrameHeader -> ByteString
encodeFrameHeader
(FrameIdentifier -> Int -> FrameHeader
FrameHeader FrameIdentifier
frameId (ByteString -> Int
BS.Strict.length ByteString
payloadData Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4))
, Checksum -> ByteString
Checksum.encode Checksum
maskedChecksum
, ByteString
payloadData
]
where
maskedChecksum :: Checksum
maskedChecksum :: Checksum
maskedChecksum = ByteString -> Checksum
Checksum.calculate ByteString
uncompressed
compressed :: Strict.ByteString
compressed :: ByteString
compressed = ByteString -> ByteString
Raw.compress ByteString
uncompressed
compressionRatio :: Double
compressionRatio :: Double
compressionRatio =
forall a. Fractional a => a -> a -> a
(/) @Double
(Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.Strict.length ByteString
uncompressed)
(Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.Strict.length ByteString
compressed)
(FrameIdentifier
frameId, ByteString
payloadData) =
if Bool
doCompress then
(FrameIdentifier
Compressed, ByteString
compressed)
else
(FrameIdentifier
Uncompressed, ByteString
uncompressed)
doCompress :: Bool
doCompress =
case Threshold
threshold of
Threshold
AlwaysCompress -> Bool
True
Threshold
NeverCompress -> Bool
False
Ratio Double
ratio -> Double
compressionRatio Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
ratio
data Decoder =
Decoder
{
Decoder -> Buffer
decoderBuffer :: !Buffer
, Decoder -> DecodeState
decoderState :: !DecodeState
}
deriving Int -> Decoder -> ShowS
[Decoder] -> ShowS
Decoder -> [Char]
(Int -> Decoder -> ShowS)
-> (Decoder -> [Char]) -> ([Decoder] -> ShowS) -> Show Decoder
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Decoder -> ShowS
showsPrec :: Int -> Decoder -> ShowS
$cshow :: Decoder -> [Char]
show :: Decoder -> [Char]
$cshowList :: [Decoder] -> ShowS
showList :: [Decoder] -> ShowS
Show
data DecodeState =
Initial
| !FrameHeader
deriving (Int -> DecodeState -> ShowS
[DecodeState] -> ShowS
DecodeState -> [Char]
(Int -> DecodeState -> ShowS)
-> (DecodeState -> [Char])
-> ([DecodeState] -> ShowS)
-> Show DecodeState
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeState -> ShowS
showsPrec :: Int -> DecodeState -> ShowS
$cshow :: DecodeState -> [Char]
show :: DecodeState -> [Char]
$cshowList :: [DecodeState] -> ShowS
showList :: [DecodeState] -> ShowS
Show, DecodeState -> DecodeState -> Bool
(DecodeState -> DecodeState -> Bool)
-> (DecodeState -> DecodeState -> Bool) -> Eq DecodeState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodeState -> DecodeState -> Bool
== :: DecodeState -> DecodeState -> Bool
$c/= :: DecodeState -> DecodeState -> Bool
/= :: DecodeState -> DecodeState -> Bool
Eq)
data DecodeResult =
DecodeResult
{ DecodeResult -> [ByteString]
decodeResultDecoded :: [Strict.ByteString]
, DecodeResult -> Decoder
decodeResultDecoder :: !Decoder
}
deriving Int -> DecodeResult -> ShowS
[DecodeResult] -> ShowS
DecodeResult -> [Char]
(Int -> DecodeResult -> ShowS)
-> (DecodeResult -> [Char])
-> ([DecodeResult] -> ShowS)
-> Show DecodeResult
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeResult -> ShowS
showsPrec :: Int -> DecodeResult -> ShowS
$cshow :: DecodeResult -> [Char]
show :: DecodeResult -> [Char]
$cshowList :: [DecodeResult] -> ShowS
showList :: [DecodeResult] -> ShowS
Show
data DecodeParams =
DecodeParams
{
DecodeParams -> Bool
verifyChecksum :: !Bool
}
deriving (Int -> DecodeParams -> ShowS
[DecodeParams] -> ShowS
DecodeParams -> [Char]
(Int -> DecodeParams -> ShowS)
-> (DecodeParams -> [Char])
-> ([DecodeParams] -> ShowS)
-> Show DecodeParams
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeParams -> ShowS
showsPrec :: Int -> DecodeParams -> ShowS
$cshow :: DecodeParams -> [Char]
show :: DecodeParams -> [Char]
$cshowList :: [DecodeParams] -> ShowS
showList :: [DecodeParams] -> ShowS
Show, DecodeParams -> DecodeParams -> Bool
(DecodeParams -> DecodeParams -> Bool)
-> (DecodeParams -> DecodeParams -> Bool) -> Eq DecodeParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodeParams -> DecodeParams -> Bool
== :: DecodeParams -> DecodeParams -> Bool
$c/= :: DecodeParams -> DecodeParams -> Bool
/= :: DecodeParams -> DecodeParams -> Bool
Eq)
instance Default DecodeParams where
def :: DecodeParams
def :: DecodeParams
def = DecodeParams
defaultDecodeParams
defaultDecodeParams :: DecodeParams
defaultDecodeParams :: DecodeParams
defaultDecodeParams = Bool -> DecodeParams
DecodeParams Bool
False
data DecodeFailure =
DecompressionError Strict.ByteString
| ReservedUnskippableFrameId Word8
| BadStreamId Strict.ByteString
| BadChecksum
Strict.ByteString
Checksum
Checksum
| NotDone
deriving Int -> DecodeFailure -> ShowS
[DecodeFailure] -> ShowS
DecodeFailure -> [Char]
(Int -> DecodeFailure -> ShowS)
-> (DecodeFailure -> [Char])
-> ([DecodeFailure] -> ShowS)
-> Show DecodeFailure
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeFailure -> ShowS
showsPrec :: Int -> DecodeFailure -> ShowS
$cshow :: DecodeFailure -> [Char]
show :: DecodeFailure -> [Char]
$cshowList :: [DecodeFailure] -> ShowS
showList :: [DecodeFailure] -> ShowS
Show
deriving anyclass Show DecodeFailure
Typeable DecodeFailure
(Typeable DecodeFailure, Show DecodeFailure) =>
(DecodeFailure -> SomeException)
-> (SomeException -> Maybe DecodeFailure)
-> (DecodeFailure -> [Char])
-> Exception DecodeFailure
SomeException -> Maybe DecodeFailure
DecodeFailure -> [Char]
DecodeFailure -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> [Char]) -> Exception e
$ctoException :: DecodeFailure -> SomeException
toException :: DecodeFailure -> SomeException
$cfromException :: SomeException -> Maybe DecodeFailure
fromException :: SomeException -> Maybe DecodeFailure
$cdisplayException :: DecodeFailure -> [Char]
displayException :: DecodeFailure -> [Char]
Exception
initializeDecoder :: Decoder
initializeDecoder :: Decoder
initializeDecoder =
Decoder
{ decoderBuffer :: Buffer
decoderBuffer = Buffer
Buffer.empty
, decoderState :: DecodeState
decoderState = DecodeState
Initial
}
finalizeDecoder :: Decoder -> Either DecodeFailure ()
finalizeDecoder :: Decoder -> Either DecodeFailure ()
finalizeDecoder Decoder{Buffer
DecodeState
decoderBuffer :: Decoder -> Buffer
decoderState :: Decoder -> DecodeState
decoderBuffer :: Buffer
decoderState :: DecodeState
..}
| DecodeState
decoderState DecodeState -> DecodeState -> Bool
forall a. Eq a => a -> a -> Bool
/= DecodeState
Initial Bool -> Bool -> Bool
|| Bool -> Bool
not (Buffer -> Bool
Buffer.null Buffer
decoderBuffer)
= DecodeFailure -> Either DecodeFailure ()
forall a. DecodeFailure -> Either DecodeFailure a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DecodeFailure
NotDone
| Bool
otherwise
= () -> Either DecodeFailure ()
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
decodeBuffered :: DecodeParams -> Decoder -> Either DecodeFailure DecodeResult
decodeBuffered :: DecodeParams -> Decoder -> Either DecodeFailure DecodeResult
decodeBuffered DecodeParams
dps =
[ByteString] -> Decoder -> Either DecodeFailure DecodeResult
go []
where
go :: [Strict.ByteString] -> Decoder -> Either DecodeFailure DecodeResult
go :: [ByteString] -> Decoder -> Either DecodeFailure DecodeResult
go [ByteString]
acc (Decoder Buffer
b state :: DecodeState
state@DecodeState
Initial) =
case Int -> Buffer -> Either Int (ByteString, Buffer)
Buffer.splitExactly Int
4 Buffer
b of
Right (ByteString
headerBs, Buffer
rest) -> do
FrameHeader
header <- ByteString -> Either DecodeFailure FrameHeader
decodeHeader ByteString
headerBs
[ByteString] -> Decoder -> Either DecodeFailure DecodeResult
go [ByteString]
acc (Buffer -> DecodeState -> Decoder
Decoder Buffer
rest (FrameHeader -> DecodeState
KnownHeader FrameHeader
header))
Left Int
_ ->
DecodeResult -> Either DecodeFailure DecodeResult
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> Either DecodeFailure DecodeResult)
-> DecodeResult -> Either DecodeFailure DecodeResult
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Decoder -> DecodeResult
DecodeResult ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc) (Decoder -> DecodeResult) -> Decoder -> DecodeResult
forall a b. (a -> b) -> a -> b
$ Buffer -> DecodeState -> Decoder
Decoder Buffer
b DecodeState
state
go [ByteString]
acc (Decoder Buffer
b state :: DecodeState
state@(KnownHeader FrameHeader
header)) =
case Int -> Buffer -> Either Int (ByteString, Buffer)
Buffer.splitExactly (FrameHeader -> Int
frameHeaderPayloadSize FrameHeader
header) Buffer
b of
Right (ByteString
payloadBs, Buffer
rest) -> do
Maybe ByteString
uncompressed <- DecodeParams
-> FrameHeader
-> ByteString
-> Either DecodeFailure (Maybe ByteString)
decodeFrame DecodeParams
dps FrameHeader
header ByteString
payloadBs
[ByteString] -> Decoder -> Either DecodeFailure DecodeResult
go ([ByteString]
-> (ByteString -> [ByteString]) -> Maybe ByteString -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ByteString]
acc (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
acc) Maybe ByteString
uncompressed) (Buffer -> DecodeState -> Decoder
Decoder Buffer
rest DecodeState
Initial)
Left Int
_ ->
DecodeResult -> Either DecodeFailure DecodeResult
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeResult -> Either DecodeFailure DecodeResult)
-> DecodeResult -> Either DecodeFailure DecodeResult
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Decoder -> DecodeResult
DecodeResult ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc) (Decoder -> DecodeResult) -> Decoder -> DecodeResult
forall a b. (a -> b) -> a -> b
$ Buffer -> DecodeState -> Decoder
Decoder Buffer
b DecodeState
state
decodeHeader :: Strict.ByteString -> Either DecodeFailure FrameHeader
ByteString
bs =
case ByteString -> [Word8]
BS.Strict.unpack ByteString
bs of
[Word8
bid, Word8
b1, Word8
b2, Word8
b3] ->
let
payloadLen :: Int
payloadLen = (Word8, Word8, Word8) -> Int
lEWord24BytesToInt (Word8
b1, Word8
b2, Word8
b3)
in
case Word8
bid of
Word8
0xff -> FrameHeader -> Either DecodeFailure FrameHeader
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return (FrameHeader -> Either DecodeFailure FrameHeader)
-> FrameHeader -> Either DecodeFailure FrameHeader
forall a b. (a -> b) -> a -> b
$ FrameIdentifier -> Int -> FrameHeader
FrameHeader FrameIdentifier
StreamId Int
payloadLen
Word8
0xfd -> FrameHeader -> Either DecodeFailure FrameHeader
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return (FrameHeader -> Either DecodeFailure FrameHeader)
-> FrameHeader -> Either DecodeFailure FrameHeader
forall a b. (a -> b) -> a -> b
$ FrameIdentifier -> Int -> FrameHeader
FrameHeader FrameIdentifier
Padding Int
payloadLen
Word8
0x00 -> FrameHeader -> Either DecodeFailure FrameHeader
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return (FrameHeader -> Either DecodeFailure FrameHeader)
-> FrameHeader -> Either DecodeFailure FrameHeader
forall a b. (a -> b) -> a -> b
$ FrameIdentifier -> Int -> FrameHeader
FrameHeader FrameIdentifier
Compressed Int
payloadLen
Word8
0x01 -> FrameHeader -> Either DecodeFailure FrameHeader
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return (FrameHeader -> Either DecodeFailure FrameHeader)
-> FrameHeader -> Either DecodeFailure FrameHeader
forall a b. (a -> b) -> a -> b
$ FrameIdentifier -> Int -> FrameHeader
FrameHeader FrameIdentifier
Uncompressed Int
payloadLen
Word8
fid
| Word8
fid Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Word8
0x02 .. Word8
0x7f ] ->
FrameHeader -> Either DecodeFailure FrameHeader
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return (FrameHeader -> Either DecodeFailure FrameHeader)
-> FrameHeader -> Either DecodeFailure FrameHeader
forall a b. (a -> b) -> a -> b
$ FrameIdentifier -> Int -> FrameHeader
FrameHeader (Word8 -> FrameIdentifier
ReservedUnskippable Word8
fid) Int
payloadLen
| Word8
fid Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Word8
0x80 .. Word8
0xfd ] ->
FrameHeader -> Either DecodeFailure FrameHeader
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return (FrameHeader -> Either DecodeFailure FrameHeader)
-> FrameHeader -> Either DecodeFailure FrameHeader
forall a b. (a -> b) -> a -> b
$ FrameIdentifier -> Int -> FrameHeader
FrameHeader (Word8 -> FrameIdentifier
ReservedSkippable Word8
fid) Int
payloadLen
| Bool
otherwise ->
[Char] -> Either DecodeFailure FrameHeader
forall a. HasCallStack => [Char] -> a
error ([Char] -> Either DecodeFailure FrameHeader)
-> [Char] -> Either DecodeFailure FrameHeader
forall a b. (a -> b) -> a -> b
$
[Char] -> Word8 -> [Char]
forall r. PrintfType r => [Char] -> r
printf
( [Char]
"FrameFormat.decodeHeader: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char]
"impossible frame identifier 0x%x"
)
Word8
fid
[Word8]
_ ->
[Char] -> Either DecodeFailure FrameHeader
forall a. HasCallStack => [Char] -> a
error [Char]
"FrameFormat.decodeHeader: precondition violated"
where
lEWord24BytesToInt :: (Word8, Word8, Word8) -> Int
lEWord24BytesToInt :: (Word8, Word8, Word8) -> Int
lEWord24BytesToInt (Word8
lsb, Word8
mid, Word8
msb) =
Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
msb Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
16
Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
mid Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8
Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
lsb
decodeFrame ::
DecodeParams
-> FrameHeader
-> Strict.ByteString
-> Either DecodeFailure (Maybe Strict.ByteString)
decodeFrame :: DecodeParams
-> FrameHeader
-> ByteString
-> Either DecodeFailure (Maybe ByteString)
decodeFrame DecodeParams
dps FrameHeader
header ByteString
bs =
case FrameHeader -> FrameIdentifier
frameHeaderIdentifier FrameHeader
header of
FrameIdentifier
StreamId ->
if ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"sNaPpY" then
Maybe ByteString -> Either DecodeFailure (Maybe ByteString)
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
else
DecodeFailure -> Either DecodeFailure (Maybe ByteString)
forall a. DecodeFailure -> Either DecodeFailure a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DecodeFailure -> Either DecodeFailure (Maybe ByteString))
-> DecodeFailure -> Either DecodeFailure (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> DecodeFailure
BadStreamId ByteString
bs
FrameIdentifier
Compressed -> do
let !(ByteString
checksumBs, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
BS.Strict.splitAt Int
4 ByteString
bs
ByteString
uncompressed <-
case ByteString -> Maybe ByteString
Raw.decompress ByteString
rest of
Maybe ByteString
Nothing -> DecodeFailure -> Either DecodeFailure ByteString
forall a. DecodeFailure -> Either DecodeFailure a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DecodeFailure -> Either DecodeFailure ByteString)
-> DecodeFailure -> Either DecodeFailure ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> DecodeFailure
DecompressionError ByteString
rest
Just ByteString
decompressed -> ByteString -> Either DecodeFailure ByteString
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
decompressed
ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Either DecodeFailure ByteString
-> Either DecodeFailure (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeParams
-> ByteString -> ByteString -> Either DecodeFailure ByteString
verifyPayload DecodeParams
dps ByteString
checksumBs ByteString
uncompressed
FrameIdentifier
Uncompressed -> do
let !(ByteString
checksumBs, ByteString
uncompressed) = Int -> ByteString -> (ByteString, ByteString)
BS.Strict.splitAt Int
4 ByteString
bs
ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Either DecodeFailure ByteString
-> Either DecodeFailure (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeParams
-> ByteString -> ByteString -> Either DecodeFailure ByteString
verifyPayload DecodeParams
dps ByteString
checksumBs ByteString
uncompressed
FrameIdentifier
Padding ->
Maybe ByteString -> Either DecodeFailure (Maybe ByteString)
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
ReservedUnskippable Word8
fid ->
DecodeFailure -> Either DecodeFailure (Maybe ByteString)
forall a. DecodeFailure -> Either DecodeFailure a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DecodeFailure -> Either DecodeFailure (Maybe ByteString))
-> DecodeFailure -> Either DecodeFailure (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Word8 -> DecodeFailure
ReservedUnskippableFrameId Word8
fid
ReservedSkippable Word8
_ ->
Maybe ByteString -> Either DecodeFailure (Maybe ByteString)
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
verifyPayload ::
DecodeParams
-> Strict.ByteString
-> Strict.ByteString
-> Either DecodeFailure Strict.ByteString
verifyPayload :: DecodeParams
-> ByteString -> ByteString -> Either DecodeFailure ByteString
verifyPayload DecodeParams
dps ByteString
checksumBs ByteString
uncompressed = do
Bool -> Either DecodeFailure () -> Either DecodeFailure ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DecodeParams -> Bool
verifyChecksum DecodeParams
dps) (Either DecodeFailure () -> Either DecodeFailure ())
-> Either DecodeFailure () -> Either DecodeFailure ()
forall a b. (a -> b) -> a -> b
$ do
let
decodedChecksum :: Checksum
decodedChecksum = ByteString -> Checksum
Checksum.decode ByteString
checksumBs
computedChecksum :: Checksum
computedChecksum = ByteString -> Checksum
Checksum.calculate ByteString
uncompressed
Bool -> Either DecodeFailure () -> Either DecodeFailure ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Checksum
computedChecksum Checksum -> Checksum -> Bool
forall a. Eq a => a -> a -> Bool
/= Checksum
decodedChecksum) (Either DecodeFailure () -> Either DecodeFailure ())
-> Either DecodeFailure () -> Either DecodeFailure ()
forall a b. (a -> b) -> a -> b
$
DecodeFailure -> Either DecodeFailure ()
forall a. DecodeFailure -> Either DecodeFailure a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DecodeFailure -> Either DecodeFailure ())
-> DecodeFailure -> Either DecodeFailure ()
forall a b. (a -> b) -> a -> b
$
ByteString -> Checksum -> Checksum -> DecodeFailure
BadChecksum ByteString
uncompressed Checksum
decodedChecksum Checksum
computedChecksum
ByteString -> Either DecodeFailure ByteString
forall a. a -> Either DecodeFailure a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
uncompressed