Binary.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Module contains helper functions when dealing with encoding
-- and decoding 'Binary'
module Util.Binary
  ( UnpackError (..)
  , ensureEnd
  , launchGet
  ) where

import Prelude hiding (EQ, Ordering(..), get)

import Data.Binary (Get)
import qualified Data.Binary.Get as Get
import qualified Data.ByteString.Lazy as LBS
import Fmt (Buildable, build, pretty, (+|), (+||), (|+), (||+))
import Text.Hex (encodeHex)

----------------------------------------------------------------------------
-- Helpers
----------------------------------------------------------------------------

-- | Any decoding error.
newtype UnpackError = UnpackError { unUnpackError :: Text }
  deriving stock (Show, Eq)

instance Buildable UnpackError where
  build (UnpackError msg) = build msg

instance Exception UnpackError where
  displayException = pretty

ensureEnd :: Get ()
ensureEnd =
  unlessM Get.isEmpty $ do
    remainder <- Get.getRemainingLazyByteString
    fail $ "Expected end of entry, unconsumed bytes \
           \(" +| length remainder |+ "): "
           +|| encodeHex (LBS.toStrict remainder) ||+ ""

launchGet :: Get a -> LByteString -> Either UnpackError a
launchGet decoder bs =
  case Get.runGetOrFail decoder bs of
    Left (_remainder, _offset, err) -> Left . UnpackError $ toText err
    Right (_remainder, _offset, res) -> Right res