diff --git a/src/Data/Binary/Local.hs b/src/Data/Binary/Local.hs new file mode 100644 index 0000000..a903672 --- /dev/null +++ b/src/Data/Binary/Local.hs @@ -0,0 +1,109 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +-- | This module provides incremental binary data decoding. The data stream +-- from which bytes are read is represented as a monadic action which returns a +-- strict ByteString. If the ByteString returned is empty, it means there is no +-- more input. The intention is that the ByteStrings returned are of constant +-- size, e.g. the lazy ByteString chunk size, or some network-specific chunk or +-- packet size. +module Data.Binary.Local + ( DecodeFail (..) + , DecodeBuffer + , decodeIncremental + ) +where + +import Prelude + +import Control.Monad.Logger +import Data.Binary.Get +import Data.ByteString (ByteString) +import Data.Foldable (for_) +import Data.Int (Int64) +import Data.Monoid ((<>)) +import Formatting + +import qualified Data.ByteString as B (null) +import qualified Data.Text as T (pack) +import qualified Data.Text.Encoding as TE (decodeLatin1) + +-- | Description of decoding error. +data DecodeFail = DecodeFail + { -- | Unused bytes left in the buffer. + dfRemainder :: ByteString + -- | Number of bytes consumed before the error. + , dfConsumed :: Int64 + -- | Error description. + , dfReason :: String + } + deriving Show + +-- | A buffer used during the decoding process. +type DecodeBuffer = Maybe ByteString + +-- | Read bytes from a stream until a single value is successfuly decoded from +-- it (or until decoding fails). +decodeIncremental + :: MonadLogger m + => LogSource + -- ^ Log source name for logging via 'MonadLogger'. If you don't want to + -- specify a source, pass empty text here. + -> m ByteString + -- ^ The stream reader action. Reads a chunk of bytes and returns it. If + -- there are no more bytes to read, returns an empty bytestring. + -> DecodeBuffer + -- ^ Decoder buffer. If you're starting to decode, pass 'Nothing' here. If + -- you already decode a value and want to continue, pass here the buffer + -- you got from the previous call to this function. + -> Get a + -- ^ Decoder definition. + -> m (Either DecodeFail (DecodeBuffer, a)) + -- ^ If decoding fails, 'Left' an error is returned. If it succeeds, you + -- get the buffer state and the decoded value. If you intend to decode a + -- value again from the same stream, pass the buffer to the next call of + -- this function. +decodeIncremental src readBytes buf decode = go buf $ runGetIncremental decode + --readBytes <- requestBody <$> waiRequest + where + go _ (Fail remains consumed err) = do + let df = DecodeFail + { dfRemainder = remains + , dfConsumed = consumed + , dfReason = err + } + $logErrorS src $ T.pack $ show df + return $ Left df + go mbuffer (Done unused consumed result) = do + $logDebugS src $ sformat + ("Decoding done, consumed " % int % " bytes") consumed + for_ mbuffer $ \ b -> $logWarnS src $ + "Done decoding with nonempty buffer: " <> (TE.decodeLatin1 b) + let mbuffer' = if B.null unused + then mbuffer + else Just $ maybe unused (<> unused) mbuffer + return $ Right (mbuffer', result) + go mbuffer (Partial k) = do + chunk <- case mbuffer of + Nothing -> do + bytes <- readBytes + $logDebugS src $ "Received " <> TE.decodeLatin1 bytes + return bytes + Just b -> do + $logDebugS src $ "Reading buffer: " <> TE.decodeLatin1 b + return b + if B.null chunk + then go Nothing $ k Nothing + else go Nothing $ k $ Just chunk diff --git a/vervis.cabal b/vervis.cabal index 5424202..01f8677 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -34,7 +34,8 @@ flag library-only default: False library - exposed-modules: Data.ByteString.Char8.Local + exposed-modules: Data.Binary.Local + Data.ByteString.Char8.Local Data.ByteString.Local Data.Char.Local Data.List.Local @@ -91,6 +92,8 @@ library build-depends: aeson , attoparsec , base + -- for Data.Binary.Local + , binary , base64-bytestring , blaze-html , byteable