{- This file is part of Vervis. - - Written in 2016 by fr33domlover <fr33domlover@riseup.net>. - - ♡ 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 - <http://creativecommons.org/publicdomain/zero/1.0/>. -} -- | 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 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