{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Cardano.Ledger.Binary.Decoding.Decoder (
  -- * Decoders
  Decoder,
  toPlainDecoder,
  fromPlainDecoder,
  withPlainDecoder,
  enforceDecoderVersion,
  getOriginalBytes,
  originalBytesExpectedFailureMessage,
  DecoderError (..),
  C.ByteOffset,
  ByteArray (..),
  C.DecodeAction (..),
  C.TokenType (..),

  -- ** Versioning
  getDecoderVersion,
  ifDecoderVersionAtLeast,
  whenDecoderVersionAtLeast,
  unlessDecoderVersionAtLeast,

  -- ** Error reporting
  cborError,
  toCborError,
  showDecoderError,
  invalidKey,
  assertTag,
  enforceSize,
  matchSize,

  -- ** Compatibility tools
  binaryGetDecoder,
  allowTag,

  -- ** Custom decoders
  decodeVersion,
  decodeRational,
  decodeRationalWithTag,
  decodeRecordNamed,
  decodeRecordNamedT,
  decodeRecordSum,
  decodeListLike,
  decodeListLikeT,
  decodeEnumBounded,
  decodeWithOrigin,

  -- *** Containers
  decodeMaybe,
  decodeNullMaybe,
  decodeStrictMaybe,
  decodeNullStrictMaybe,
  decodeEither,
  decodeList,
  decodeNonEmptyList,
  decodeVector,
  decodeSet,
  setTag,
  decodeIntMap,
  decodeMap,
  decodeMapByKey,
  decodeMapLikeEnforceNoDuplicates,
  decodeVMap,
  decodeSeq,
  decodeStrictSeq,
  decodeSetTag,
  decodeListLikeWithCount,
  decodeListLikeWithCountT,
  decodeSetLikeEnforceNoDuplicates,
  decodeListLikeEnforceNoDuplicates,
  decodeMapContents,

  -- **** Applicaitve
  decodeMapTraverse,
  decodeMapContentsTraverse,

  -- *** Time
  decodeUTCTime,

  -- *** Network
  decodeIPv4,
  decodeIPv6,

  -- ** Lifted @cborg@ decoders
  decodeBool,
  decodeBreakOr,
  decodeByteArray,
  decodeByteArrayCanonical,
  decodeBytes,
  decodeBytesCanonical,
  decodeBytesIndef,
  decodeDouble,
  decodeDoubleCanonical,
  decodeFloat,
  decodeFloat16Canonical,
  decodeFloatCanonical,
  decodeInt,
  decodeInt16,
  decodeInt16Canonical,
  decodeInt32,
  decodeInt32Canonical,
  decodeInt64,
  decodeInt64Canonical,
  decodeInt8,
  decodeInt8Canonical,
  decodeIntCanonical,
  decodeInteger,
  decodeIntegerCanonical,
  decodeNatural,
  decodeListLen,
  decodeListLenCanonical,
  decodeListLenCanonicalOf,
  decodeListLenIndef,
  decodeListLenOf,
  decodeListLenOrIndef,
  decodeMapLen,
  decodeMapLenCanonical,
  decodeMapLenIndef,
  decodeMapLenOrIndef,
  decodeNegWord,
  decodeNegWord64,
  decodeNegWord64Canonical,
  decodeNegWordCanonical,
  decodeNull,
  decodeSequenceLenIndef,
  decodeSequenceLenN,
  decodeSimple,
  decodeSimpleCanonical,
  decodeString,
  decodeStringCanonical,
  decodeStringIndef,
  decodeTag,
  decodeTag64,
  decodeTag64Canonical,
  decodeTagCanonical,
  decodeUtf8ByteArray,
  decodeUtf8ByteArrayCanonical,
  decodeWithByteSpan,
  decodeWord,
  decodeWord16,
  decodeWord16Canonical,
  decodeWord32,
  decodeWord32Canonical,
  decodeWord64,
  decodeWord64Canonical,
  decodeWord8,
  decodeWord8Canonical,
  decodeWordCanonical,
  decodeWordCanonicalOf,
  decodeWordOf,
  decodeTerm,
  peekAvailable,
  peekByteOffset,
  peekTokenType,
)
where

import Cardano.Ledger.Binary.Plain (
  DecoderError (..),
  cborError,
  invalidKey,
  showDecoderError,
  toCborError,
 )
import qualified Cardano.Ledger.Binary.Plain as Plain (assertTag, decodeTagMaybe)
import Cardano.Ledger.Binary.Version (Version, mkVersion64, natVersion)
import Cardano.Slotting.Slot (WithOrigin, withOriginFromMaybe)
import Codec.CBOR.ByteArray (ByteArray (..))
import qualified Codec.CBOR.Decoding as C (
  ByteOffset,
  DecodeAction (..),
  Decoder,
  TokenType (..),
  decodeBool,
  decodeBreakOr,
  decodeByteArray,
  decodeByteArrayCanonical,
  decodeBytes,
  decodeBytesCanonical,
  decodeBytesIndef,
  decodeDouble,
  decodeDoubleCanonical,
  decodeFloat,
  decodeFloat16Canonical,
  decodeFloatCanonical,
  decodeInt,
  decodeInt16,
  decodeInt16Canonical,
  decodeInt32,
  decodeInt32Canonical,
  decodeInt64,
  decodeInt64Canonical,
  decodeInt8,
  decodeInt8Canonical,
  decodeIntCanonical,
  decodeInteger,
  decodeIntegerCanonical,
  decodeListLen,
  decodeListLenCanonical,
  decodeListLenCanonicalOf,
  decodeListLenIndef,
  decodeListLenOf,
  decodeListLenOrIndef,
  decodeMapLen,
  decodeMapLenCanonical,
  decodeMapLenIndef,
  decodeMapLenOrIndef,
  decodeNegWord,
  decodeNegWord64,
  decodeNegWord64Canonical,
  decodeNegWordCanonical,
  decodeNull,
  decodeSequenceLenIndef,
  decodeSequenceLenN,
  decodeSimple,
  decodeSimpleCanonical,
  decodeString,
  decodeStringCanonical,
  decodeStringIndef,
  decodeTag,
  decodeTag64,
  decodeTag64Canonical,
  decodeTagCanonical,
  decodeUtf8ByteArray,
  decodeUtf8ByteArrayCanonical,
  decodeWithByteSpan,
  decodeWord,
  decodeWord16,
  decodeWord16Canonical,
  decodeWord32,
  decodeWord32Canonical,
  decodeWord64,
  decodeWord64Canonical,
  decodeWord8,
  decodeWord8Canonical,
  decodeWordCanonical,
  decodeWordCanonicalOf,
  decodeWordOf,
  peekAvailable,
  peekByteOffset,
  peekTokenType,
 )
import qualified Codec.CBOR.Term as C (Term (..), decodeTerm)
import Control.Monad
import Control.Monad.Trans (MonadTrans (..))
import Control.Monad.Trans.Identity (IdentityT (runIdentityT))
import Data.Binary.Get (Get, getWord32le, runGetOrFail)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Functor.Compose (Compose (..))
import Data.IP (IPv4, IPv6, fromHostAddress, fromHostAddress6)
import Data.Int (Int16, Int32, Int64, Int8)
import qualified Data.IntMap as IntMap
import qualified Data.List.NonEmpty as NE (NonEmpty, nonEmpty)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..), maybeToStrictMaybe)
import Data.Ratio ((%))
import qualified Data.Sequence as Seq
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import qualified Data.Text as Text
import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)
import Data.Time.Clock (UTCTime (..), picosecondsToDiffTime)
import Data.Typeable (Proxy (Proxy), Typeable, typeRep)
import qualified Data.VMap as VMap
import qualified Data.Vector.Generic as VG
import Data.Word (Word16, Word32, Word64, Word8)
import Network.Socket (HostAddress6)
import Numeric.Natural (Natural)
import Prelude hiding (decodeFloat)

--------------------------------------------------------------------------------
-- Versioned Decoder
--------------------------------------------------------------------------------

newtype Decoder s a = Decoder
  { forall s a.
Decoder s a -> Maybe ByteString -> Version -> Decoder s a
runDecoder :: Maybe BSL.ByteString -> Version -> C.Decoder s a
  }

instance Functor (Decoder s) where
  fmap :: forall a b. (a -> b) -> Decoder s a -> Decoder s b
fmap a -> b
f Decoder s a
d = forall s a.
(Maybe ByteString -> Version -> Decoder s a) -> Decoder s a
Decoder (\Maybe ByteString
bsl Version
v -> a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a.
Decoder s a -> Maybe ByteString -> Version -> Decoder s a
runDecoder Decoder s a
d Maybe ByteString
bsl Version
v)
  {-# INLINE fmap #-}

instance Applicative (Decoder s) where
  pure :: forall a. a -> Decoder s a
pure a
x = forall s a.
(Maybe ByteString -> Version -> Decoder s a) -> Decoder s a
Decoder (\Maybe ByteString
_ Version
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  {-# INLINE pure #-}
  Decoder Maybe ByteString -> Version -> Decoder s (a -> b)
f <*> :: forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
<*> Decoder Maybe ByteString -> Version -> Decoder s a
g = forall s a.
(Maybe ByteString -> Version -> Decoder s a) -> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
bsl Version
v -> Maybe ByteString -> Version -> Decoder s (a -> b)
f Maybe ByteString
bsl Version
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ByteString -> Version -> Decoder s a
g Maybe ByteString
bsl Version
v
  {-# INLINE (<*>) #-}
  Decoder Maybe ByteString -> Version -> Decoder s a
f *> :: forall a b. Decoder s a -> Decoder s b -> Decoder s b
*> Decoder Maybe ByteString -> Version -> Decoder s b
g = forall s a.
(Maybe ByteString -> Version -> Decoder s a) -> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
bsl Version
v -> Maybe ByteString -> Version -> Decoder s a
f Maybe ByteString
bsl Version
v forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe ByteString -> Version -> Decoder s b
g Maybe ByteString
bsl Version
v
  {-# INLINE (*>) #-}

instance Monad (Decoder s) where
  Decoder Maybe ByteString -> Version -> Decoder s a
f >>= :: forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
>>= a -> Decoder s b
g = forall s a.
(Maybe ByteString -> Version -> Decoder s a) -> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
bsl Version
v -> do
    a
x <- Maybe ByteString -> Version -> Decoder s a
f Maybe ByteString
bsl Version
v
    forall s a.
Decoder s a -> Maybe ByteString -> Version -> Decoder s a
runDecoder (a -> Decoder s b
g a
x) Maybe ByteString
bsl Version
v
  {-# INLINE (>>=) #-}

instance MonadFail (Decoder s) where
  fail :: forall a. String -> Decoder s a
fail String
msg = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
  {-# INLINE fail #-}

-- | Promote a regular `C.Decoder` to a versioned one. Which means it will work for all
-- versions.
fromPlainDecoder :: C.Decoder s a -> Decoder s a
fromPlainDecoder :: forall s a. Decoder s a -> Decoder s a
fromPlainDecoder Decoder s a
d = forall s a.
(Maybe ByteString -> Version -> Decoder s a) -> Decoder s a
Decoder (\Maybe ByteString
_ Version
_ -> Decoder s a
d)
{-# INLINE fromPlainDecoder #-}

-- | Extract the underlying `C.Decoder` by optionally supplying the original bytes and
-- specifying the concrete version to be used.
toPlainDecoder ::
  -- | Some decoders require the original bytes to be supplied as well. Such decoders will
  -- fail whenever `Nothing` is supplied.
  Maybe BSL.ByteString ->
  Version ->
  Decoder s a ->
  C.Decoder s a
toPlainDecoder :: forall s a.
Maybe ByteString -> Version -> Decoder s a -> Decoder s a
toPlainDecoder Maybe ByteString
bsl Version
v (Decoder Maybe ByteString -> Version -> Decoder s a
d) = Maybe ByteString -> Version -> Decoder s a
d Maybe ByteString
bsl Version
v
{-# INLINE toPlainDecoder #-}

-- | Use the supplied decoder as a plain decoder with current version.
withPlainDecoder :: Decoder s a -> (C.Decoder s a -> C.Decoder s b) -> Decoder s b
withPlainDecoder :: forall s a b.
Decoder s a -> (Decoder s a -> Decoder s b) -> Decoder s b
withPlainDecoder Decoder s a
vd Decoder s a -> Decoder s b
f = forall s a.
(Maybe ByteString -> Version -> Decoder s a) -> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
bsl -> Decoder s a -> Decoder s b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a.
Decoder s a -> Maybe ByteString -> Version -> Decoder s a
runDecoder Decoder s a
vd Maybe ByteString
bsl
{-# INLINE withPlainDecoder #-}

-- | Ignore the current version of the decoder and enforce the supplied one instead.
enforceDecoderVersion :: Version -> Decoder s a -> Decoder s a
enforceDecoderVersion :: forall s a. Version -> Decoder s a -> Decoder s a
enforceDecoderVersion Version
version Decoder s a
d = forall s a.
(Maybe ByteString -> Version -> Decoder s a) -> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
bsl Version
_ -> forall s a.
Decoder s a -> Maybe ByteString -> Version -> Decoder s a
runDecoder Decoder s a
d Maybe ByteString
bsl Version
version
{-# INLINE enforceDecoderVersion #-}

-- | Lookup the original bytes that are being used for deserialization. This action will
-- fail deserialization whenever original bytes are not available.
getOriginalBytes :: Decoder s BSL.ByteString
getOriginalBytes :: forall s. Decoder s ByteString
getOriginalBytes =
  forall s a.
(Maybe ByteString -> Version -> Decoder s a) -> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
maybeBytes Version
_ ->
    case Maybe ByteString
maybeBytes of
      Maybe ByteString
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
originalBytesExpectedFailureMessage
      Just ByteString
bsl -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bsl

-- | This is the message that will be reported by `getOriginalBytes` when original bytes are not
-- provided. It is defined as a separate biding for testing.
originalBytesExpectedFailureMessage :: String
originalBytesExpectedFailureMessage :: String
originalBytesExpectedFailureMessage =
  String
"Decoder was expected to provide the original ByteString"

--------------------------------------------------------------------------------
-- Working with current decoder version
--------------------------------------------------------------------------------

-- | Extract current version of the decoder
--
-- >>> import Cardano.Ledger.Decoding
-- >>> decodeFullDecoder 3 "Version" getDecoderVersion ""
-- Right 3
getDecoderVersion :: Decoder s Version
getDecoderVersion :: forall s. Decoder s Version
getDecoderVersion = forall s a.
(Maybe ByteString -> Version -> Decoder s a) -> Decoder s a
Decoder forall a b. (a -> b) -> a -> b
$ \Maybe ByteString
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE getDecoderVersion #-}

-- | Conditionally choose the newer or older decoder, depending on the current
-- version. Version in the context of encoders/decoders is the major protocol
-- version. Supplied version acts as a pivot.
--
-- =====__Example__
--
-- Let's say prior to the version 2 some type `Foo` was backed by `Word16`, but at the 2nd
-- version onwards it was switched to `Word32` instead. In order to support both versions,
-- we change the type, but we also use this condition to keep backwards compatibility of
-- the decoder:
--
-- >>> newtype Foo = Foo Word32
-- >>> decFoo = Foo <$> ifDecoderVersionAtLeast 2 decodeWord32 (fromIntegral <$> decodeWord16)
ifDecoderVersionAtLeast ::
  Version ->
  -- | Use this decoder if current decoder version is larger or equal to the supplied
  -- `Version`
  Decoder s a ->
  -- | Use this decoder if current decoder version is lower than the supplied `Version`
  Decoder s a ->
  Decoder s a
ifDecoderVersionAtLeast :: forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast Version
atLeast Decoder s a
newerDecoder Decoder s a
olderDecoder = do
  Version
cur <- forall s. Decoder s Version
getDecoderVersion
  if Version
cur forall a. Ord a => a -> a -> Bool
>= Version
atLeast
    then Decoder s a
newerDecoder
    else Decoder s a
olderDecoder
{-# INLINE ifDecoderVersionAtLeast #-}

-- | Optionally run a decoder depending on the current version and the supplied one.
whenDecoderVersionAtLeast ::
  Version ->
  -- | Run this decoder whenever current decoder version is larger or equal to the supplied
  -- `Version`
  Decoder s a ->
  Decoder s ()
whenDecoderVersionAtLeast :: forall s a. Version -> Decoder s a -> Decoder s ()
whenDecoderVersionAtLeast Version
atLeast Decoder s a
decoder = do
  Version
cur <- forall s. Decoder s Version
getDecoderVersion
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
cur forall a. Ord a => a -> a -> Bool
>= Version
atLeast) (forall (f :: * -> *) a. Functor f => f a -> f ()
void Decoder s a
decoder)
{-# INLINE whenDecoderVersionAtLeast #-}

-- | Optionally run a decoder depending on the current version and the supplied one.
unlessDecoderVersionAtLeast ::
  Version ->
  -- | Run this decoder whenever current decoder version is smaller to the supplied `Version`
  Decoder s a ->
  Decoder s ()
unlessDecoderVersionAtLeast :: forall s a. Version -> Decoder s a -> Decoder s ()
unlessDecoderVersionAtLeast Version
atLeast Decoder s a
decoder = do
  Version
cur <- forall s. Decoder s Version
getDecoderVersion
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Version
cur forall a. Ord a => a -> a -> Bool
>= Version
atLeast) (forall (f :: * -> *) a. Functor f => f a -> f ()
void Decoder s a
decoder)

--------------------------------------------------------------------------------
-- Error reporting
--------------------------------------------------------------------------------

decodeVersion :: Decoder s Version
decodeVersion :: forall s. Decoder s Version
decodeVersion = forall s. Decoder s Word64
decodeWord64 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFail m => Word64 -> m Version
mkVersion64
{-# INLINE decodeVersion #-}

-- | `Decoder` for `Rational`. Versions variance:
--
-- * [>= 9] - Allows variable as well as exact list length encoding. Consumes tag 30 if
--   one is present, but does not enforce it.
--
-- * [>= 2] - Allows variable as well as exact list length encoding.
--
-- * [== 1] - Expects exact list length encoding.
decodeRational :: Decoder s Rational
decodeRational :: forall s. Decoder s Rational
decodeRational =
  forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
    (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
    (forall s. Word -> Decoder s ()
allowTag Word
30 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. Decoder s Rational
decodeRationalWithoutTag)
    ( forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
        (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2)
        forall s. Decoder s Rational
decodeRationalWithoutTag
        forall s. Decoder s Rational
decodeRationalFixedSizeTuple
    )
  where
    decodeRationalFixedSizeTuple :: Decoder s Rational
decodeRationalFixedSizeTuple = do
      forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Rational" Int
2
      Integer
n <- forall s. Decoder s Integer
decodeInteger
      Integer
d <- forall s. Decoder s Integer
decodeInteger
      if Integer
d forall a. Ord a => a -> a -> Bool
<= Integer
0
        then forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"Rational" Text
"invalid denominator"
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Integer
n forall a. Integral a => a -> a -> Ratio a
% Integer
d
    {-# INLINE decodeRationalFixedSizeTuple #-}
{-# INLINE decodeRational #-}

-- | Future `Decoder` for `Rational` type. This decoder will be applied in future and is
-- prepared here as use case on how to do upgrades to serialization. Versions variance:
--
-- * [>= 10] - Enforces tag 30
--
-- * [>= 9] - Allows variable as well as exact list length encoding. Consumes tag 30 if
--   one is present, but does not enforce it.
--
-- * [>= 2] - Allows variable as well as exact list length encoding.
--
-- * [== 1] - Expects exact list length encoding.
_decodeRationalFuture :: Decoder s Rational
_decodeRationalFuture :: forall s. Decoder s Rational
_decodeRationalFuture = do
  -- We are not using `natVersion` because these versions aren't yet supported.
  Version
v9 <- forall (m :: * -> *). MonadFail m => Word64 -> m Version
mkVersion64 Word64
9
  Version
v10 <- forall (m :: * -> *). MonadFail m => Word64 -> m Version
mkVersion64 Word64
10
  forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
    Version
v10
    forall s. Decoder s Rational
decodeRationalWithTag
    ( forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
        Version
v9
        (forall s. Word -> Decoder s ()
allowTag Word
30 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. Decoder s Rational
decodeRational)
        forall s. Decoder s Rational
decodeRational
    )

-- | Enforces tag 30 to indicate a rational number, as per tag assignment:
-- <https://www.iana.org/assignments/cbor-tags/cbor-tags.xhtml>
--
-- <https://peteroupc.github.io/CBOR/rational.html>
decodeRationalWithTag :: Decoder s Rational
decodeRationalWithTag :: forall s. Decoder s Rational
decodeRationalWithTag = forall s. Word -> Decoder s ()
assertTag Word
30 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. Decoder s Rational
decodeRationalWithoutTag
{-# INLINE decodeRationalWithTag #-}

decodeRationalWithoutTag :: Decoder s Rational
decodeRationalWithoutTag :: forall s. Decoder s Rational
decodeRationalWithoutTag = do
  (Int
numValues, [Integer]
values) <- forall s v.
Decoder s (Maybe Int) -> Decoder s v -> Decoder s (Int, [v])
decodeCollectionWithLen forall s. Decoder s (Maybe Int)
decodeListLenOrIndef forall s. Decoder s Integer
decodeInteger
  case [Integer]
values of
    [Integer
n, Integer
d] -> do
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
d forall a. Eq a => a -> a -> Bool
== Integer
0) (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Denominator cannot be zero")
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Integer
n forall a. Integral a => a -> a -> Ratio a
% Integer
d
    [Integer]
_ -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Int -> Int -> DecoderError
DecoderErrorSizeMismatch Text
"Rational" Int
2 Int
numValues
{-# INLINE decodeRationalWithoutTag #-}

--------------------------------------------------------------------------------
-- Containers
--------------------------------------------------------------------------------

-- | @'Decoder'@ for list.
--
-- * [>= 2] - Allows variable as well as exact list length encoding.
--
-- * [< 2] - Expects variable list length encoding
decodeList :: Decoder s a -> Decoder s [a]
decodeList :: forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s a
decodeValue =
  forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
    (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2)
    (forall s a. Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection forall s. Decoder s (Maybe Int)
decodeListLenOrIndef Decoder s a
decodeValue)
    (forall s a. Decoder s a -> Decoder s [a]
decodeListWith Decoder s a
decodeValue)
{-# INLINE decodeList #-}

decodeNonEmptyList :: Decoder s a -> Decoder s (NE.NonEmpty a)
decodeNonEmptyList :: forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList Decoder s a
decodeValue = do
  [a]
xs <- forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s a
decodeValue
  case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
xs of
    Maybe (NonEmpty a)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty list found, expected non-empty"
    Just NonEmpty a
ne -> forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty a
ne
{-# INLINE decodeNonEmptyList #-}

-- | @'Decoder'@ for list.
decodeListWith :: Decoder s a -> Decoder s [a]
decodeListWith :: forall s a. Decoder s a -> Decoder s [a]
decodeListWith Decoder s a
decodeValue = do
  forall s. Decoder s ()
decodeListLenIndef
  forall r a b s.
(r -> a -> r) -> r -> (r -> b) -> Decoder s a -> Decoder s b
decodeSequenceLenIndef (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] forall a. [a] -> [a]
reverse Decoder s a
decodeValue
{-# INLINE decodeListWith #-}

-- | `Decoder` for `Maybe`. Versions variance:
--
-- * [>= 2] - Allows variable as well as exact list length encoding.
--
-- * [< 2] - Expects exact list length encoding
decodeMaybe :: Decoder s a -> Decoder s (Maybe a)
decodeMaybe :: forall s a. Decoder s a -> Decoder s (Maybe a)
decodeMaybe Decoder s a
decodeValue = do
  forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
    (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2)
    (forall s a. Decoder s a -> Decoder s (Maybe a)
decodeMaybeVarLen Decoder s a
decodeValue)
    (forall s a. Decoder s a -> Decoder s (Maybe a)
decodeMaybeExactLen Decoder s a
decodeValue)
{-# INLINE decodeMaybe #-}

decodeMaybeExactLen :: Decoder s a -> Decoder s (Maybe a)
decodeMaybeExactLen :: forall s a. Decoder s a -> Decoder s (Maybe a)
decodeMaybeExactLen Decoder s a
decodeValue = do
  Int
n <- forall s. Decoder s Int
decodeListLen
  case Int
n of
    Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Int
1 -> do
      !a
x <- Decoder s a
decodeValue
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)
    Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"too many elements while decoding Maybe."
{-# INLINE decodeMaybeExactLen #-}

decodeMaybeVarLen :: Decoder s a -> Decoder s (Maybe a)
decodeMaybeVarLen :: forall s a. Decoder s a -> Decoder s (Maybe a)
decodeMaybeVarLen Decoder s a
decodeValue = do
  Maybe Int
maybeLength <- forall s. Decoder s (Maybe Int)
decodeListLenOrIndef
  case Maybe Int
maybeLength of
    Just Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Just Int
1 -> forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Decoder s a
decodeValue
    Just Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"too many elements in length-style decoding of Maybe."
    Maybe Int
Nothing -> do
      Bool
isBreak <- forall s. Decoder s Bool
decodeBreakOr
      if Bool
isBreak
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        else do
          !a
x <- Decoder s a
decodeValue
          Bool
isBreak2 <- forall s. Decoder s Bool
decodeBreakOr
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBreak2 forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"too many elements in break-style decoding of Maybe."
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just a
x)
{-# INLINE decodeMaybeVarLen #-}

-- | Alternative way to decode a Maybe type.
--
-- /Note/ - this is not the default method for decoding `Maybe`, use `decodeMaybe` instead.
decodeNullMaybe :: Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe :: forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s a
decoder = do
  forall s. Decoder s TokenType
peekTokenType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    TokenType
C.TypeNull -> do
      forall s. Decoder s ()
decodeNull
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    TokenType
_ -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
decoder
{-# INLINE decodeNullMaybe #-}

-- | Unlike `decodeMaybe` this allows variable as well as exact list length encoding for
-- all versions, because Byron never used `StrictMaybe` type.
decodeStrictMaybe :: Decoder s a -> Decoder s (StrictMaybe a)
decodeStrictMaybe :: forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeStrictMaybe = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Decoder s a -> Decoder s (Maybe a)
decodeMaybeVarLen
{-# INLINE decodeStrictMaybe #-}

-- | Alternative way to decode a `StrictMaybe` type.
--
-- /Note/ - this is not the default method for decoding `StrictMaybe`, use
-- `decodeStrictMaybe` instead.
decodeNullStrictMaybe :: Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe :: forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s a
decoder = do
  forall s. Decoder s TokenType
peekTokenType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    TokenType
C.TypeNull -> do
      forall s. Decoder s ()
decodeNull
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. StrictMaybe a
SNothing
    TokenType
_ -> forall a. a -> StrictMaybe a
SJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
decoder
{-# INLINE decodeNullStrictMaybe #-}

decodeEither :: Decoder s a -> Decoder s b -> Decoder s (Either a b)
decodeEither :: forall s a b. Decoder s a -> Decoder s b -> Decoder s (Either a b)
decodeEither Decoder s a
decodeLeft Decoder s b
decodeRight = do
  forall s. Int -> Decoder s ()
decodeListLenOf Int
2
  Word
t <- forall s. Decoder s Word
decodeWord
  case Word
t of
    Word
0 -> forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
decodeLeft
    Word
1 -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s b
decodeRight
    Word
_ -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"Either" (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
t)
{-# INLINE decodeEither #-}

decodeRecordNamed :: Text.Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed :: forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
name a -> Int
getRecordSize Decoder s a
decoder = do
  forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT forall a b. (a -> b) -> a -> b
$ forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
name a -> Int
getRecordSize (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s a
decoder)
{-# INLINE decodeRecordNamed #-}

decodeRecordNamedT ::
  (MonadTrans m, Monad (m (Decoder s))) =>
  Text.Text ->
  (a -> Int) ->
  m (Decoder s) a ->
  m (Decoder s) a
decodeRecordNamedT :: forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
name a -> Int
getRecordSize m (Decoder s) a
decoder =
  forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text
-> m (Decoder s) a
-> (a -> Int -> m (Decoder s) ())
-> m (Decoder s) a
decodeListLikeT Text
name m (Decoder s) a
decoder forall a b. (a -> b) -> a -> b
$ \a
result Int
n ->
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s. Text -> Int -> Int -> Decoder s ()
matchSize (Text
"Record " forall a. Semigroup a => a -> a -> a
<> Text
name) Int
n (a -> Int
getRecordSize a
result)
{-# INLINE decodeRecordNamedT #-}

decodeRecordSum :: Text.Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum :: forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
name Word -> Decoder s (Int, a)
decoder =
  forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    forall s a.
Text -> Decoder s a -> (a -> Int -> Decoder s ()) -> Decoder s a
decodeListLike Text
name (forall s. Decoder s Word
decodeWord forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> Decoder s (Int, a)
decoder) forall a b. (a -> b) -> a -> b
$ \(Int
size, a
_) Int
n ->
      forall s. Text -> Int -> Int -> Decoder s ()
matchSize (String -> Text
Text.pack String
"Sum " forall a. Semigroup a => a -> a -> a
<> Text
name) Int
size Int
n
{-# INLINE decodeRecordSum #-}

-- | Use this decoder for any list like structure that accepts fixed or variable list
-- length encoding.
decodeListLike ::
  -- | Name for error reporting
  Text.Text ->
  -- | Decoder for the datastructure itself
  Decoder s a ->
  -- | In case when length was encoded, act upon it.
  (a -> Int -> Decoder s ()) ->
  Decoder s a
decodeListLike :: forall s a.
Text -> Decoder s a -> (a -> Int -> Decoder s ()) -> Decoder s a
decodeListLike Text
name Decoder s a
decoder a -> Int -> Decoder s ()
actOnLength =
  forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT forall a b. (a -> b) -> a -> b
$ forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text
-> m (Decoder s) a
-> (a -> Int -> m (Decoder s) ())
-> m (Decoder s) a
decodeListLikeT Text
name (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s a
decoder) (\a
r Int
i -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> Int -> Decoder s ()
actOnLength a
r Int
i))
{-# INLINE decodeListLike #-}

decodeListLikeT ::
  (MonadTrans m, Monad (m (Decoder s))) =>
  -- | Name for error reporting
  Text.Text ->
  -- | Decoder for the datastructure itself
  m (Decoder s) a ->
  -- | In case when length was encoded, act upon it.
  (a -> Int -> m (Decoder s) ()) ->
  m (Decoder s) a
decodeListLikeT :: forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text
-> m (Decoder s) a
-> (a -> Int -> m (Decoder s) ())
-> m (Decoder s) a
decodeListLikeT Text
name m (Decoder s) a
decoder a -> Int -> m (Decoder s) ()
actOnLength = do
  Maybe Int
lenOrIndef <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s. Decoder s (Maybe Int)
decodeListLenOrIndef
  a
result <- m (Decoder s) a
decoder
  case Maybe Int
lenOrIndef of
    Just Int
n -> a -> Int -> m (Decoder s) ()
actOnLength a
result Int
n
    Maybe Int
Nothing -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ do
      Bool
isBreak <- forall s. Decoder s Bool
decodeBreakOr
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBreak forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
name Text
"Excess terms in array"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
{-# INLINE decodeListLikeT #-}

decodeEnumBounded :: forall a s. (Enum a, Bounded a, Typeable a) => Decoder s a
decodeEnumBounded :: forall a s. (Enum a, Bounded a, Typeable a) => Decoder s a
decodeEnumBounded = do
  Int
n <- forall s. Decoder s Int
decodeInt
  if forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
minBound :: a) forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: a)
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
n
    else
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
        String
"Failed to decode an Enum: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n forall a. Semigroup a => a -> a -> a
<> String
" for TypeRep: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @a))
{-# INLINE decodeEnumBounded #-}

decodeWithOrigin :: Decoder s a -> Decoder s (WithOrigin a)
decodeWithOrigin :: forall s a. Decoder s a -> Decoder s (WithOrigin a)
decodeWithOrigin Decoder s a
f = forall t. Maybe t -> WithOrigin t
withOriginFromMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s (Maybe a)
decodeMaybe Decoder s a
f
{-# INLINE decodeWithOrigin #-}

--------------------------------------------------------------------------------
-- Decoder for Map
--------------------------------------------------------------------------------

-- | Checks canonicity by comparing the new key being decoded with
--   the previous one, to enfore these are sorted the correct way.
--   See: https://tools.ietf.org/html/rfc7049#section-3.9
--   "[..]The keys in every map must be sorted lowest value to highest.[...]"
--
-- In other words this decoder enforces strict monotonically increasing order on keys. It
-- also uses exact map length encoding.
decodeMapSkel ::
  forall k m v s.
  Ord k =>
  -- | Decoded list is guaranteed to be sorted on keys in descending order without any
  -- duplicate keys.
  ([(k, v)] -> m) ->
  -- | Decoder for keys and values
  Decoder s (k, v) ->
  Decoder s m
decodeMapSkel :: forall k m v s.
Ord k =>
([(k, v)] -> m) -> Decoder s (k, v) -> Decoder s m
decodeMapSkel [(k, v)] -> m
fromDistinctDescList Decoder s (k, v)
decodeKeyValue = do
  Int
n <- forall s. Decoder s Int
decodeMapLen
  [(k, v)] -> m
fromDistinctDescList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Int
n of
    Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    Int
_ -> do
      (k
firstKey, v
firstValue) <- Decoder s (k, v)
decodeKeyValue
      Int -> k -> [(k, v)] -> Decoder s [(k, v)]
decodeEntries (Int
n forall a. Num a => a -> a -> a
- Int
1) k
firstKey [(k
firstKey, v
firstValue)]
  where
    -- Decode all the entries, enforcing canonicity by ensuring that the
    -- previous key is smaller than the next one.
    decodeEntries :: Int -> k -> [(k, v)] -> Decoder s [(k, v)]
    decodeEntries :: Int -> k -> [(k, v)] -> Decoder s [(k, v)]
decodeEntries Int
0 k
_ [(k, v)]
acc = forall (f :: * -> *) a. Applicative f => a -> f a
pure [(k, v)]
acc
    decodeEntries !Int
remainingPairs k
previousKey ![(k, v)]
acc = do
      p :: (k, v)
p@(k
newKey, v
_) <- Decoder s (k, v)
decodeKeyValue
      -- Order of keys needs to be strictly increasing, because otherwise it's
      -- possible to supply lists with various amount of duplicate keys which
      -- will result in the same map as long as the last value of the given
      -- key on the list is the same in all of them.
      if k
newKey forall a. Ord a => a -> a -> Bool
> k
previousKey
        then Int -> k -> [(k, v)] -> Decoder s [(k, v)]
decodeEntries (Int
remainingPairs forall a. Num a => a -> a -> a
- Int
1) k
newKey ((k, v)
p forall a. a -> [a] -> [a]
: [(k, v)]
acc)
        else forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> DecoderError
DecoderErrorCanonicityViolation Text
"Map"
{-# INLINE decodeMapSkel #-}

decodeCollection :: Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection :: forall s a. Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection Decoder s (Maybe Int)
lenOrIndef Decoder s a
el = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s v.
Decoder s (Maybe Int) -> Decoder s v -> Decoder s (Int, [v])
decodeCollectionWithLen Decoder s (Maybe Int)
lenOrIndef Decoder s a
el
{-# INLINE decodeCollection #-}

decodeCollectionWithLen ::
  Decoder s (Maybe Int) ->
  Decoder s v ->
  Decoder s (Int, [v])
decodeCollectionWithLen :: forall s v.
Decoder s (Maybe Int) -> Decoder s v -> Decoder s (Int, [v])
decodeCollectionWithLen Decoder s (Maybe Int)
lenOrIndef Decoder s v
decodeElement =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a b.
Monoid b =>
Decoder s (Maybe Int)
-> (a -> b -> b) -> (b -> Decoder s a) -> Decoder s (Int, b)
decodeListLikeWithCount Decoder s (Maybe Int)
lenOrIndef (:) (forall a b. a -> b -> a
const Decoder s v
decodeElement)
{-# INLINE decodeCollectionWithLen #-}

-- | `Decoder` for `Map.Map`. Versions variance:
--
-- * [>= 9] - Allows variable as well as exact list length encoding. Duplicate keys will
--   result in a deserialization failure
--
-- * [>= 2] - Allows variable as well as exact list length encoding. Duplicate keys are
--   silently ignored
--
-- * [< 2] - Expects exact list length encoding and enforces strict order
--   without any duplicates.
--
-- An example of how to use versioning
--
-- >>> :set -XOverloadedStrings
-- >>> import Codec.CBOR.FlatTerm
-- >>> fromFlatTerm (toPlainDecoder 1 (decodeMap decodeInt decodeBytes)) [TkMapLen 2,TkInt 1,TkBytes "Foo",TkInt 2,TkBytes "Bar"]
-- Right (fromList [(1,"Foo"),(2,"Bar")])
-- >>> fromFlatTerm (toPlainDecoder 1 (decodeMap decodeInt decodeBytes)) [TkMapBegin,TkInt 1,TkBytes "Foo",TkInt 2,TkBytes "Bar"]
-- Left "decodeMapLen: unexpected token TkMapBegin"
-- >>> fromFlatTerm (toPlainDecoder 2 (decodeMap decodeInt decodeBytes)) [TkMapBegin,TkInt 1,TkBytes "Foo",TkInt 2,TkBytes "Bar",TkBreak]
-- Right (fromList [(1,"Foo"),(2,"Bar")])
decodeMap ::
  Ord k =>
  Decoder s k ->
  Decoder s v ->
  Decoder s (Map.Map k v)
decodeMap :: forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap Decoder s k
decodeKey Decoder s v
decodeValue = forall k s v.
Ord k =>
Decoder s k -> (k -> Decoder s v) -> Decoder s (Map k v)
decodeMapByKey Decoder s k
decodeKey (forall a b. a -> b -> a
const Decoder s v
decodeValue)
{-# INLINE decodeMap #-}

-- | Just like `decodeMap`, but also gives access to the key for the value decoder.
decodeMapByKey ::
  Ord k =>
  Decoder s k ->
  (k -> Decoder s v) ->
  Decoder s (Map.Map k v)
decodeMapByKey :: forall k s v.
Ord k =>
Decoder s k -> (k -> Decoder s v) -> Decoder s (Map k v)
decodeMapByKey Decoder s k
decodeKey k -> Decoder s v
decodeValue =
  forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
    (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2)
    ( forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
        (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
        (forall k s v.
Ord k =>
Decoder s (Maybe Int) -> Decoder s (k, v) -> Decoder s (Map k v)
decodeMapLikeEnforceNoDuplicates forall s. Decoder s (Maybe Int)
decodeMapLenOrIndef Decoder s (k, v)
decodeKeyValue)
        (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection forall s. Decoder s (Maybe Int)
decodeMapLenOrIndef Decoder s (k, v)
decodeKeyValue)
    )
    (forall k m v s.
Ord k =>
([(k, v)] -> m) -> Decoder s (k, v) -> Decoder s m
decodeMapSkel forall k a. [(k, a)] -> Map k a
Map.fromDistinctDescList Decoder s (k, v)
decodeKeyValue)
  where
    decodeKeyValue :: Decoder s (k, v)
decodeKeyValue = do
      !k
key <- Decoder s k
decodeKey
      !v
value <- k -> Decoder s v
decodeValue k
key
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (k
key, v
value)
    {-# INLINE decodeKeyValue #-}
{-# INLINE decodeMapByKey #-}

-- | Similar to `decodeMapByKey`, except it gives access to the key value
-- decoder as a pair and allows for different type of length encoding
decodeMapLikeEnforceNoDuplicates ::
  Ord k =>
  Decoder s (Maybe Int) ->
  Decoder s (k, v) ->
  Decoder s (Map.Map k v)
decodeMapLikeEnforceNoDuplicates :: forall k s v.
Ord k =>
Decoder s (Maybe Int) -> Decoder s (k, v) -> Decoder s (Map k v)
decodeMapLikeEnforceNoDuplicates =
  forall k v m s.
([(k, v)] -> m)
-> (m -> Int)
-> Decoder s (Maybe Int)
-> Decoder s (k, v)
-> Decoder s m
decodeMapLikeEnforceNoDuplicatesInternal forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall k a. Map k a -> Int
Map.size
{-# INLINE decodeMapLikeEnforceNoDuplicates #-}

decodeMapLikeEnforceNoDuplicatesInternal ::
  ([(k, v)] -> m) ->
  (m -> Int) ->
  Decoder s (Maybe Int) ->
  Decoder s (k, v) ->
  Decoder s m
decodeMapLikeEnforceNoDuplicatesInternal :: forall k v m s.
([(k, v)] -> m)
-> (m -> Int)
-> Decoder s (Maybe Int)
-> Decoder s (k, v)
-> Decoder s m
decodeMapLikeEnforceNoDuplicatesInternal [(k, v)] -> m
fromPairs m -> Int
size Decoder s (Maybe Int)
decodeLenOrIndef =
  -- We first decode into a list because most of the time the encoded Map will be in sorted
  -- order and there is a nice optimization on the `Map.fromList` that can take advantage of
  -- that fact. In case when encoded data is not sorted the penalty of going through a list
  -- is insignificant.
  forall s a b c.
Monoid b =>
Decoder s (Maybe Int)
-> (a -> b -> b) -> (b -> (Int, c)) -> Decoder s a -> Decoder s c
decodeListLikeEnforceNoDuplicates Decoder s (Maybe Int)
decodeLenOrIndef (:) forall a b. (a -> b) -> a -> b
$ \[(k, v)]
xs ->
    let result :: m
result = [(k, v)] -> m
fromPairs (forall a. [a] -> [a]
reverse [(k, v)]
xs)
     in (m -> Int
size m
result, m
result)

decodeIntMap :: Decoder s v -> Decoder s (IntMap.IntMap v)
decodeIntMap :: forall s v. Decoder s v -> Decoder s (IntMap v)
decodeIntMap Decoder s v
decodeValue =
  forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
    (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2)
    ( forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
        (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
        ( forall k v m s.
([(k, v)] -> m)
-> (m -> Int)
-> Decoder s (Maybe Int)
-> Decoder s (k, v)
-> Decoder s m
decodeMapLikeEnforceNoDuplicatesInternal
            forall a. [(Int, a)] -> IntMap a
IntMap.fromList
            forall a. IntMap a -> Int
IntMap.size
            forall s. Decoder s (Maybe Int)
decodeMapLenOrIndef
            Decoder s (Int, v)
decodeKeyValue
        )
        (forall a. [(Int, a)] -> IntMap a
IntMap.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection forall s. Decoder s (Maybe Int)
decodeMapLenOrIndef Decoder s (Int, v)
decodeKeyValue)
    )
    ( forall k m v s.
Ord k =>
([(k, v)] -> m) -> Decoder s (k, v) -> Decoder s m
decodeMapSkel
        (forall a. [(Int, a)] -> IntMap a
IntMap.fromDistinctAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse)
        Decoder s (Int, v)
decodeKeyValue
    )
  where
    decodeKeyValue :: Decoder s (Int, v)
decodeKeyValue = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Int
decodeInt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s v
decodeValue
{-# INLINE decodeIntMap #-}

-- | Decode `VMap`. Unlike `decodeMap` it does not behavee differently for
-- version prior to 2.
decodeVMap ::
  (VMap.Vector kv k, VMap.Vector vv v, Ord k) =>
  Decoder s k ->
  Decoder s v ->
  Decoder s (VMap.VMap kv vv k v)
decodeVMap :: forall (kv :: * -> *) k (vv :: * -> *) v s.
(Vector kv k, Vector vv v, Ord k) =>
Decoder s k -> Decoder s v -> Decoder s (VMap kv vv k v)
decodeVMap Decoder s k
decodeKey Decoder s v
decodeValue =
  forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k s v.
Ord k =>
Decoder s (Maybe Int) -> Decoder s (k, v) -> Decoder s (Map k v)
decodeMapLikeEnforceNoDuplicates
      forall s. Decoder s (Maybe Int)
decodeMapLenOrIndef
      ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s k
decodeKey forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s v
decodeValue)
{-# INLINE decodeVMap #-}

-- | We stitch a `258` in from of a (Hash)Set, so that tools which
-- programmatically check for canonicity can recognise it from a normal
-- array. Why 258? This will be formalised pretty soon, but IANA allocated
-- 256...18446744073709551615 to "First come, first served":
-- https://www.iana.org/assignments/cbor-tags/cbor-tags.xhtml Currently `258` is
-- the first unassigned tag and as it requires 2 bytes to be encoded, it sounds
-- like the best fit.
--
-- <https://github.com/input-output-hk/cbor-sets-spec/blob/master/CBOR_SETS.md>
setTag :: Word
setTag :: Word
setTag = Word
258

decodeSetTag :: Decoder s ()
decodeSetTag :: forall s. Decoder s ()
decodeSetTag = do
  Word
t <- forall s. Decoder s Word
decodeTag
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
t forall a. Eq a => a -> a -> Bool
/= Word
setTag) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"Set" (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
t)
{-# INLINE decodeSetTag #-}

decodeSetSkel ::
  forall a s c.
  Ord a =>
  -- | Decoded list is guaranteed to be sorted on keys in descending order without any
  -- duplicate keys.
  ([a] -> c) ->
  Decoder s a ->
  Decoder s c
decodeSetSkel :: forall a s c. Ord a => ([a] -> c) -> Decoder s a -> Decoder s c
decodeSetSkel [a] -> c
fromDistinctDescList Decoder s a
decodeValue = do
  forall s. Decoder s ()
decodeSetTag
  Int
n <- forall s. Decoder s Int
decodeListLen
  [a] -> c
fromDistinctDescList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Int
n of
    Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    Int
_ -> do
      a
firstValue <- Decoder s a
decodeValue
      Int -> a -> [a] -> Decoder s [a]
decodeEntries (Int
n forall a. Num a => a -> a -> a
- Int
1) a
firstValue [a
firstValue]
  where
    decodeEntries :: Int -> a -> [a] -> Decoder s [a]
    decodeEntries :: Int -> a -> [a] -> Decoder s [a]
decodeEntries Int
0 a
_ [a]
acc = forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
acc
    decodeEntries !Int
remainingEntries a
previousValue ![a]
acc = do
      a
newValue <- Decoder s a
decodeValue
      -- Order of values needs to be strictly increasing, because otherwise
      -- it's possible to supply lists with various amount of duplicates which
      -- will result in the same set.
      if a
newValue forall a. Ord a => a -> a -> Bool
> a
previousValue
        then Int -> a -> [a] -> Decoder s [a]
decodeEntries (Int
remainingEntries forall a. Num a => a -> a -> a
- Int
1) a
newValue (a
newValue forall a. a -> [a] -> [a]
: [a]
acc)
        else forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> DecoderError
DecoderErrorCanonicityViolation Text
"Set"
{-# INLINE decodeSetSkel #-}

-- | `Decoder` for `Set.Set`. Versions variance:
--
-- * [>= 9] - Allows variable as well as exact list length encoding. Duplicates are
--   not allowed. Set tag 258 is permitted, but not enforced.
--
-- * [>= 2, < 9] - Allows variable as well as exact list length encoding. Duplicates are
--   silently ignored, set tag 258 is not permitted.
--
-- * [< 2] - Expects exact list length encoding and enforces strict order
--   without any duplicates. Also enforces special set tag 258, which was
--   abandoned starting with version 2
decodeSet :: Ord a => Decoder s a -> Decoder s (Set.Set a)
decodeSet :: forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s a
valueDecoder =
  forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
    (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2)
    ( forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
        (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
        (forall s a. Ord a => Decoder s a -> Decoder s (Set a)
decodeSetEnforceNoDuplicates Decoder s a
valueDecoder)
        (forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection forall s. Decoder s (Maybe Int)
decodeListLenOrIndef Decoder s a
valueDecoder)
    )
    (forall a s c. Ord a => ([a] -> c) -> Decoder s a -> Decoder s c
decodeSetSkel forall a. [a] -> Set a
Set.fromDistinctDescList Decoder s a
valueDecoder)
{-# INLINE decodeSet #-}

decodeSetEnforceNoDuplicates ::
  forall s a.
  Ord a =>
  Decoder s a ->
  Decoder s (Set.Set a)
decodeSetEnforceNoDuplicates :: forall s a. Ord a => Decoder s a -> Decoder s (Set a)
decodeSetEnforceNoDuplicates = forall s a b c.
Monoid b =>
(a -> b -> b) -> (b -> (Int, c)) -> Decoder s a -> Decoder s c
decodeSetLikeEnforceNoDuplicates (:) forall a b. (a -> b) -> a -> b
$ \[a]
xs ->
  -- We first decode into a list because most of the time the encoded Set will be in sorted
  -- order and there is a nice optimization on the `Set.fromList` that can take advantage of
  -- that fact. In case when encoded data is not sorted the penalty of going through a list
  -- is insignificant.
  let result :: Set a
result = forall a. Ord a => [a] -> Set a
Set.fromList (forall a. [a] -> [a]
reverse [a]
xs)
   in (forall a. Set a -> Int
Set.size Set a
result, Set a
result)
{-# INLINE decodeSetEnforceNoDuplicates #-}

-- | Decode a collection of values with ability to supply length decoder. Number of
-- decoded elements will be returned together with the data structure
decodeListLikeWithCount ::
  forall s a b.
  Monoid b =>
  -- | Length decoder that produces the expected number of elements. When `Nothing` is
  -- decoded the `decodeBreakOr` will be used as termination indicator.
  Decoder s (Maybe Int) ->
  -- | Add an element into the decoded List like data structure
  (a -> b -> b) ->
  -- | Decoder for the values. Current accumulator is supplied as an argument
  (b -> Decoder s a) ->
  Decoder s (Int, b)
-- TODO: define as
-- decodeListLikeWithCount decodeLenOrIndef insert decodeElement =
--   runIndentityT $ decodeListLikeWithCountT (lift decodeLenOrIndef) insert (lift decodeElement)
-- and add a SPECIALIZE pragma
decodeListLikeWithCount :: forall s a b.
Monoid b =>
Decoder s (Maybe Int)
-> (a -> b -> b) -> (b -> Decoder s a) -> Decoder s (Int, b)
decodeListLikeWithCount Decoder s (Maybe Int)
decodeLenOrIndef a -> b -> b
insert b -> Decoder s a
decodeElement = do
  Decoder s (Maybe Int)
decodeLenOrIndef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Int
len -> (Int -> Decoder s Bool) -> Int -> b -> Decoder s (Int, b)
loop (\Int
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
x forall a. Ord a => a -> a -> Bool
>= Int
len)) Int
0 forall a. Monoid a => a
mempty
    Maybe Int
Nothing -> (Int -> Decoder s Bool) -> Int -> b -> Decoder s (Int, b)
loop (\Int
_ -> forall s. Decoder s Bool
decodeBreakOr) Int
0 forall a. Monoid a => a
mempty
  where
    loop :: (Int -> Decoder s Bool) -> Int -> b -> Decoder s (Int, b)
    loop :: (Int -> Decoder s Bool) -> Int -> b -> Decoder s (Int, b)
loop Int -> Decoder s Bool
condition = Int -> b -> Decoder s (Int, b)
go
      where
        go :: Int -> b -> Decoder s (Int, b)
go !Int
count !b
acc = do
          Bool
shouldStop <- Int -> Decoder s Bool
condition Int
count
          if Bool
shouldStop
            then forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
count, b
acc)
            else do
              a
element <- b -> Decoder s a
decodeElement b
acc
              Int -> b -> Decoder s (Int, b)
go (Int
count forall a. Num a => a -> a -> a
+ Int
1) (a -> b -> b
insert a
element b
acc)
    {-# INLINE loop #-}
{-# INLINE decodeListLikeWithCount #-}

decodeListLikeWithCountT ::
  forall t s a b.
  (MonadTrans t, Monad (t (Decoder s)), Monoid b) =>
  -- | Length decoder that produces the expected number of elements. When `Nothing` is
  -- decoded the `decodeBreakOr` will be used as termination indicator.
  t (Decoder s) (Maybe Int) ->
  -- | Add an element into the decoded List like data structure
  (a -> b -> b) ->
  -- | Decoder for the values. Current accumulator is supplied as an argument
  (b -> t (Decoder s) a) ->
  t (Decoder s) (Int, b)
decodeListLikeWithCountT :: forall (t :: (* -> *) -> * -> *) s a b.
(MonadTrans t, Monad (t (Decoder s)), Monoid b) =>
t (Decoder s) (Maybe Int)
-> (a -> b -> b)
-> (b -> t (Decoder s) a)
-> t (Decoder s) (Int, b)
decodeListLikeWithCountT t (Decoder s) (Maybe Int)
decodeLenOrIndef a -> b -> b
insert b -> t (Decoder s) a
decodeElement = do
  t (Decoder s) (Maybe Int)
decodeLenOrIndef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Int
len -> (Int -> t (Decoder s) Bool) -> Int -> b -> t (Decoder s) (Int, b)
loop (\Int
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
x forall a. Ord a => a -> a -> Bool
>= Int
len)) Int
0 forall a. Monoid a => a
mempty
    Maybe Int
Nothing -> (Int -> t (Decoder s) Bool) -> Int -> b -> t (Decoder s) (Int, b)
loop (\Int
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s. Decoder s Bool
decodeBreakOr) Int
0 forall a. Monoid a => a
mempty
  where
    loop :: (Int -> t (Decoder s) Bool) -> Int -> b -> t (Decoder s) (Int, b)
loop Int -> t (Decoder s) Bool
condition = Int -> b -> t (Decoder s) (Int, b)
go
      where
        go :: Int -> b -> t (Decoder s) (Int, b)
go !Int
count !b
acc = do
          Bool
shouldStop <- Int -> t (Decoder s) Bool
condition Int
count
          if Bool
shouldStop
            then forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
count, b
acc)
            else do
              a
element <- b -> t (Decoder s) a
decodeElement b
acc
              Int -> b -> t (Decoder s) (Int, b)
go (Int
count forall a. Num a => a -> a -> a
+ Int
1) (a -> b -> b
insert a
element b
acc)
    {-# INLINE loop #-}
{-# INLINE decodeListLikeWithCountT #-}

-- | Decode a collection of values with ability to supply length decoder. Duplicates are not
-- allowed.
decodeListLikeEnforceNoDuplicates ::
  forall s a b c.
  Monoid b =>
  Decoder s (Maybe Int) ->
  -- | Add an element into the decoded List like data structure
  (a -> b -> b) ->
  -- | Get the final data structure and the number of elements it has.
  (b -> (Int, c)) ->
  Decoder s a ->
  Decoder s c
decodeListLikeEnforceNoDuplicates :: forall s a b c.
Monoid b =>
Decoder s (Maybe Int)
-> (a -> b -> b) -> (b -> (Int, c)) -> Decoder s a -> Decoder s c
decodeListLikeEnforceNoDuplicates Decoder s (Maybe Int)
decodeLenOrIndef a -> b -> b
insert b -> (Int, c)
getFinalWithCount Decoder s a
decodeElement = do
  (Int
count, b
result) <- forall s a b.
Monoid b =>
Decoder s (Maybe Int)
-> (a -> b -> b) -> (b -> Decoder s a) -> Decoder s (Int, b)
decodeListLikeWithCount Decoder s (Maybe Int)
decodeLenOrIndef a -> b -> b
insert (forall a b. a -> b -> a
const Decoder s a
decodeElement)
  let (Int
len, c
finalResult) = b -> (Int, c)
getFinalWithCount b
result
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Eq a => a -> a -> Bool
/= Int
count) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
      String
"Final number of elements: "
        forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
len
        forall a. Semigroup a => a -> a -> a
<> String
" does not match the total count that was decoded: "
        forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
count
  forall (f :: * -> *) a. Applicative f => a -> f a
pure c
finalResult
{-# INLINE decodeListLikeEnforceNoDuplicates #-}

-- | Decode a Set as a either a definite or indefinite list. Duplicates are not
-- allowed. Set tag 258 is permitted, but not enforced.
decodeSetLikeEnforceNoDuplicates ::
  forall s a b c.
  Monoid b =>
  -- | Add an element into the decoded Set like data structure
  (a -> b -> b) ->
  -- | Get the final data structure from the decoded sequence of values and the number of
  -- elements it contains. This is useful when a sequence on the wire is represented by a
  -- @set@, namely no duplicates are allowed, while the Haskell representation uses some
  -- other data structure that enforces no duplicates by some other means. For example a
  -- `Map`, where keys are hashes of the values encoded on the wire. The size of the final
  -- data structure will be used to enforce the invariant that the number of elements
  -- decoded matches the final size of the Set like data structure, thus ensuring no
  -- duplicates were encountered.
  (b -> (Int, c)) ->
  Decoder s a ->
  Decoder s c
decodeSetLikeEnforceNoDuplicates :: forall s a b c.
Monoid b =>
(a -> b -> b) -> (b -> (Int, c)) -> Decoder s a -> Decoder s c
decodeSetLikeEnforceNoDuplicates a -> b -> b
insert b -> (Int, c)
getFinalWithLen Decoder s a
decodeElement = do
  forall s. Word -> Decoder s ()
allowTag Word
setTag
  forall s a b c.
Monoid b =>
Decoder s (Maybe Int)
-> (a -> b -> b) -> (b -> (Int, c)) -> Decoder s a -> Decoder s c
decodeListLikeEnforceNoDuplicates forall s. Decoder s (Maybe Int)
decodeListLenOrIndef a -> b -> b
insert b -> (Int, c)
getFinalWithLen Decoder s a
decodeElement
{-# INLINE decodeSetLikeEnforceNoDuplicates #-}

decodeContainerSkelWithReplicate ::
  -- | How to get the size of the container
  Decoder s Int ->
  -- | replicateM for the container
  (Int -> Decoder s c) ->
  -- | concat for the container
  ([c] -> c) ->
  Decoder s c
decodeContainerSkelWithReplicate :: forall s c.
Decoder s Int -> (Int -> Decoder s c) -> ([c] -> c) -> Decoder s c
decodeContainerSkelWithReplicate Decoder s Int
decodeLen Int -> Decoder s c
replicateFun [c] -> c
concatList = do
  -- Look at how much data we have at the moment and use it as the limit for
  -- the size of a single call to replicateFun. We don't want to use
  -- replicateFun directly on the result of decodeLen since this might lead to
  -- DOS attack (attacker providing a huge value for length). So if it's above
  -- our limit, we'll do manual chunking and then combine the containers into
  -- one.
  Int
sz <- Decoder s Int
decodeLen
  Int
limit <- forall s. Decoder s Int
peekAvailable
  if Int
sz forall a. Ord a => a -> a -> Bool
<= Int
limit
    then Int -> Decoder s c
replicateFun Int
sz
    else do
      -- Take the max of limit and a fixed chunk size (note: limit can be
      -- 0). This basically means that the attacker can make us allocate a
      -- container of size 128 even though there's no actual input.
      let chunkSize :: Int
chunkSize = forall a. Ord a => a -> a -> a
max Int
limit Int
128
          (Int
d, Int
m) = Int
sz forall a. Integral a => a -> a -> (a, a)
`divMod` Int
chunkSize
      [c]
containers <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ Int -> Decoder s c
replicateFun Int
m forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate Int
d (Int -> Decoder s c
replicateFun Int
chunkSize)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! [c] -> c
concatList [c]
containers
{-# INLINE decodeContainerSkelWithReplicate #-}

-- | Generic decoder for vectors. Its intended use is to allow easy
-- definition of 'Serialise' instances for custom vector
decodeVector :: VG.Vector vec a => Decoder s a -> Decoder s (vec a)
decodeVector :: forall (vec :: * -> *) a s.
Vector vec a =>
Decoder s a -> Decoder s (vec a)
decodeVector Decoder s a
decodeValue =
  forall s c.
Decoder s Int -> (Int -> Decoder s c) -> ([c] -> c) -> Decoder s c
decodeContainerSkelWithReplicate
    forall s. Decoder s Int
decodeListLen
    (forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> m a -> m (v a)
`VG.replicateM` Decoder s a
decodeValue)
    forall (v :: * -> *) a. Vector v a => [v a] -> v a
VG.concat
{-# INLINE decodeVector #-}

-- | Decoder for `Seq.Seq`. Same behavior for all versions, allows variable as
-- well as exact list length encoding
decodeSeq :: Decoder s a -> Decoder s (Seq.Seq a)
decodeSeq :: forall s a. Decoder s a -> Decoder s (Seq a)
decodeSeq Decoder s a
decoder = forall a. [a] -> Seq a
Seq.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection forall s. Decoder s (Maybe Int)
decodeListLenOrIndef Decoder s a
decoder
{-# INLINE decodeSeq #-}

-- | Decoder for `SSeq.StrictSeq`. Same behavior for all versions, allows variable as
-- well as exact list length encoding.
decodeStrictSeq :: Decoder s a -> Decoder s (SSeq.StrictSeq a)
decodeStrictSeq :: forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s a
decoder = forall a. [a] -> StrictSeq a
SSeq.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection forall s. Decoder s (Maybe Int)
decodeListLenOrIndef Decoder s a
decoder
{-# INLINE decodeStrictSeq #-}

decodeMapContents :: Decoder s a -> Decoder s [a]
decodeMapContents :: forall s a. Decoder s a -> Decoder s [a]
decodeMapContents = forall s a. Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection forall s. Decoder s (Maybe Int)
decodeMapLenOrIndef
{-# INLINE decodeMapContents #-}

decodeMapTraverse ::
  (Ord a, Applicative t) =>
  Decoder s (t a) ->
  Decoder s (t b) ->
  Decoder s (t (Map.Map a b))
decodeMapTraverse :: forall a (t :: * -> *) s b.
(Ord a, Applicative t) =>
Decoder s (t a) -> Decoder s (t b) -> Decoder s (t (Map a b))
decodeMapTraverse Decoder s (t a)
decodeKey Decoder s (t b)
decodeValue =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) s a b.
Applicative t =>
Decoder s (t a) -> Decoder s (t b) -> Decoder s (t [(a, b)])
decodeMapContentsTraverse Decoder s (t a)
decodeKey Decoder s (t b)
decodeValue
{-# INLINE decodeMapTraverse #-}

decodeMapContentsTraverse ::
  Applicative t =>
  Decoder s (t a) ->
  Decoder s (t b) ->
  Decoder s (t [(a, b)])
decodeMapContentsTraverse :: forall (t :: * -> *) s a b.
Applicative t =>
Decoder s (t a) -> Decoder s (t b) -> Decoder s (t [(a, b)])
decodeMapContentsTraverse Decoder s (t a)
decodeKey Decoder s (t b)
decodeValue =
  forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s [a]
decodeMapContents Decoder s (t (a, b))
decodeInlinedPair
  where
    decodeInlinedPair :: Decoder s (t (a, b))
decodeInlinedPair = forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Decoder s (t a)
decodeKey forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Decoder s (t b)
decodeValue
    {-# INLINE decodeInlinedPair #-}
{-# INLINE decodeMapContentsTraverse #-}

--------------------------------------------------------------------------------
-- Time
--------------------------------------------------------------------------------

-- | `Decoder` for `UTCTime`. Versions variance:
--
-- * [>= 2] - Allows variable list length encoding, but still expects number of
--   elements to be 3.
--
-- * [< 2] - Expects exact list length encoding to be 3
decodeUTCTime :: Decoder s UTCTime
decodeUTCTime :: forall s. Decoder s UTCTime
decodeUTCTime =
  forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
    (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2)
    (forall s. Text -> Int -> Decoder s ()
enforceSize Text
"UTCTime" Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. Decoder s UTCTime
timeDecoder)
    (forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"UTCTime" (forall a b. a -> b -> a
const Int
3) forall s. Decoder s UTCTime
timeDecoder)
  where
    timeDecoder :: Decoder s UTCTime
timeDecoder = do
      !Integer
year <- forall s. Decoder s Integer
decodeInteger
      !Int
dayOfYear <- forall s. Decoder s Int
decodeInt
      !Integer
timeOfDayPico <- forall s. Decoder s Integer
decodeInteger
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$!
        Day -> DiffTime -> UTCTime
UTCTime
          (Integer -> Int -> Day
fromOrdinalDate Integer
year Int
dayOfYear)
          (Integer -> DiffTime
picosecondsToDiffTime Integer
timeOfDayPico)
    {-# INLINE timeDecoder #-}
{-# INLINE decodeUTCTime #-}

--------------------------------------------------------------------------------
-- Network
--------------------------------------------------------------------------------

-- | Convert a `Get` monad from @binary@ package into a `Decoder`
binaryGetDecoder ::
  -- | Flag to allow left over at the end or not
  Bool ->
  -- | Name of the function or type for error reporting
  Text.Text ->
  -- | Deserializer for the @binary@ package
  Get a ->
  Decoder s a
binaryGetDecoder :: forall a s. Bool -> Text -> Get a -> Decoder s a
binaryGetDecoder Bool
allowLeftOver Text
name Get a
getter = do
  ByteString
bs <- forall s. Decoder s ByteString
decodeBytes
  case forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get a
getter (ByteString -> ByteString
BSL.fromStrict ByteString
bs) of
    Left (ByteString
_, ByteOffset
_, String
err) -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
name (String -> Text
Text.pack String
err)
    Right (ByteString
leftOver, ByteOffset
_, a
ha)
      | Bool
allowLeftOver Bool -> Bool -> Bool
|| ByteString -> Bool
BSL.null ByteString
leftOver -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
ha
      | Bool
otherwise ->
          forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> ByteString -> DecoderError
DecoderErrorLeftover Text
name (ByteString -> ByteString
BSL.toStrict ByteString
leftOver)
{-# INLINE binaryGetDecoder #-}

decodeIPv4 :: Decoder s IPv4
decodeIPv4 :: forall s. Decoder s IPv4
decodeIPv4 =
  HostAddress -> IPv4
fromHostAddress
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
      (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
      (forall a s. Bool -> Text -> Get a -> Decoder s a
binaryGetDecoder Bool
False Text
"decodeIPv4" Get HostAddress
getWord32le)
      (forall a s. Bool -> Text -> Get a -> Decoder s a
binaryGetDecoder Bool
True Text
"decodeIPv4" Get HostAddress
getWord32le)
{-# INLINE decodeIPv4 #-}

getHostAddress6 :: Get HostAddress6
getHostAddress6 :: Get HostAddress6
getHostAddress6 = do
  !HostAddress
w1 <- Get HostAddress
getWord32le
  !HostAddress
w2 <- Get HostAddress
getWord32le
  !HostAddress
w3 <- Get HostAddress
getWord32le
  !HostAddress
w4 <- Get HostAddress
getWord32le
  forall (m :: * -> *) a. Monad m => a -> m a
return (HostAddress
w1, HostAddress
w2, HostAddress
w3, HostAddress
w4)
{-# INLINE getHostAddress6 #-}

decodeIPv6 :: Decoder s IPv6
decodeIPv6 :: forall s. Decoder s IPv6
decodeIPv6 =
  HostAddress6 -> IPv6
fromHostAddress6
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
      (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
      (forall a s. Bool -> Text -> Get a -> Decoder s a
binaryGetDecoder Bool
False Text
"decodeIPv6" Get HostAddress6
getHostAddress6)
      (forall a s. Bool -> Text -> Get a -> Decoder s a
binaryGetDecoder Bool
True Text
"decodeIPv6" Get HostAddress6
getHostAddress6)
{-# INLINE decodeIPv6 #-}

--------------------------------------------------------------------------------
-- Wrapped CBORG decoders
--------------------------------------------------------------------------------

decodeTagMaybe :: Decoder s (Maybe Word64)
decodeTagMaybe :: forall s. Decoder s (Maybe Word64)
decodeTagMaybe = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s (Maybe Word64)
Plain.decodeTagMaybe
{-# INLINE decodeTagMaybe #-}

allowTag :: Word -> Decoder s ()
allowTag :: forall s. Word -> Decoder s ()
allowTag Word
tagExpected = do
  Maybe Word64
mTagReceived <- forall s. Decoder s (Maybe Word64)
decodeTagMaybe
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Word64
mTagReceived forall a b. (a -> b) -> a -> b
$ \Word64
tagReceived ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word64
tagReceived forall a. Eq a => a -> a -> Bool
== (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
tagExpected :: Word64)) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
        String
"Expecteg tag " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word
tagExpected forall a. Semigroup a => a -> a -> a
<> String
" but got tag " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word64
tagReceived
{-# INLINE allowTag #-}

assertTag :: Word -> Decoder s ()
assertTag :: forall s. Word -> Decoder s ()
assertTag = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Word -> Decoder s ()
Plain.assertTag
{-# INLINE assertTag #-}

-- | Enforces that the input size is the same as the decoded one, failing in
--   case it's not
enforceSize :: Text.Text -> Int -> Decoder s ()
enforceSize :: forall s. Text -> Int -> Decoder s ()
enforceSize Text
lbl Int
requestedSize = forall s. Decoder s Int
decodeListLen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
lbl Int
requestedSize
{-# INLINE enforceSize #-}

-- | Compare two sizes, failing if they are not equal
matchSize :: Text.Text -> Int -> Int -> Decoder s ()
matchSize :: forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
lbl Int
requestedSize Int
actualSize =
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
actualSize forall a. Eq a => a -> a -> Bool
/= Int
requestedSize) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$
      Text -> Int -> Int -> DecoderError
DecoderErrorSizeMismatch
        Text
lbl
        Int
requestedSize
        Int
actualSize
{-# INLINE matchSize #-}

decodeBool :: Decoder s Bool
decodeBool :: forall s. Decoder s Bool
decodeBool = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Bool
C.decodeBool
{-# INLINE decodeBool #-}

decodeBreakOr :: Decoder s Bool
decodeBreakOr :: forall s. Decoder s Bool
decodeBreakOr = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Bool
C.decodeBreakOr
{-# INLINE decodeBreakOr #-}

decodeByteArray :: Decoder s ByteArray
decodeByteArray :: forall s. Decoder s ByteArray
decodeByteArray = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ByteArray
C.decodeByteArray
{-# INLINE decodeByteArray #-}

decodeByteArrayCanonical :: Decoder s ByteArray
decodeByteArrayCanonical :: forall s. Decoder s ByteArray
decodeByteArrayCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ByteArray
C.decodeByteArrayCanonical
{-# INLINE decodeByteArrayCanonical #-}

decodeBytes :: Decoder s BS.ByteString
decodeBytes :: forall s. Decoder s ByteString
decodeBytes = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ByteString
C.decodeBytes
{-# INLINE decodeBytes #-}

decodeBytesCanonical :: Decoder s BS.ByteString
decodeBytesCanonical :: forall s. Decoder s ByteString
decodeBytesCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ByteString
C.decodeBytesCanonical
{-# INLINE decodeBytesCanonical #-}

decodeBytesIndef :: Decoder s ()
decodeBytesIndef :: forall s. Decoder s ()
decodeBytesIndef = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ()
C.decodeBytesIndef
{-# INLINE decodeBytesIndef #-}

decodeDouble :: Decoder s Double
decodeDouble :: forall s. Decoder s Double
decodeDouble = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Double
C.decodeDouble
{-# INLINE decodeDouble #-}

decodeDoubleCanonical :: Decoder s Double
decodeDoubleCanonical :: forall s. Decoder s Double
decodeDoubleCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Double
C.decodeDoubleCanonical
{-# INLINE decodeDoubleCanonical #-}

decodeFloat :: Decoder s Float
decodeFloat :: forall s. Decoder s Float
decodeFloat = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Float
C.decodeFloat
{-# INLINE decodeFloat #-}

decodeFloat16Canonical :: Decoder s Float
decodeFloat16Canonical :: forall s. Decoder s Float
decodeFloat16Canonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Float
C.decodeFloat16Canonical
{-# INLINE decodeFloat16Canonical #-}

decodeFloatCanonical :: Decoder s Float
decodeFloatCanonical :: forall s. Decoder s Float
decodeFloatCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Float
C.decodeFloatCanonical
{-# INLINE decodeFloatCanonical #-}

decodeInt :: Decoder s Int
decodeInt :: forall s. Decoder s Int
decodeInt = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int
C.decodeInt
{-# INLINE decodeInt #-}

decodeInt16 :: Decoder s Int16
decodeInt16 :: forall s. Decoder s Int16
decodeInt16 = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int16
C.decodeInt16
{-# INLINE decodeInt16 #-}

decodeInt16Canonical :: Decoder s Int16
decodeInt16Canonical :: forall s. Decoder s Int16
decodeInt16Canonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int16
C.decodeInt16Canonical
{-# INLINE decodeInt16Canonical #-}

decodeInt32 :: Decoder s Int32
decodeInt32 :: forall s. Decoder s Int32
decodeInt32 = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int32
C.decodeInt32
{-# INLINE decodeInt32 #-}

decodeInt32Canonical :: Decoder s Int32
decodeInt32Canonical :: forall s. Decoder s Int32
decodeInt32Canonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int32
C.decodeInt32Canonical
{-# INLINE decodeInt32Canonical #-}

decodeInt64 :: Decoder s Int64
decodeInt64 :: forall s. Decoder s ByteOffset
decodeInt64 = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ByteOffset
C.decodeInt64
{-# INLINE decodeInt64 #-}

decodeInt64Canonical :: Decoder s Int64
decodeInt64Canonical :: forall s. Decoder s ByteOffset
decodeInt64Canonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ByteOffset
C.decodeInt64Canonical
{-# INLINE decodeInt64Canonical #-}

decodeInt8 :: Decoder s Int8
decodeInt8 :: forall s. Decoder s Int8
decodeInt8 = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int8
C.decodeInt8
{-# INLINE decodeInt8 #-}

decodeInt8Canonical :: Decoder s Int8
decodeInt8Canonical :: forall s. Decoder s Int8
decodeInt8Canonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int8
C.decodeInt8Canonical
{-# INLINE decodeInt8Canonical #-}

decodeIntCanonical :: Decoder s Int
decodeIntCanonical :: forall s. Decoder s Int
decodeIntCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int
C.decodeIntCanonical
{-# INLINE decodeIntCanonical #-}

decodeInteger :: Decoder s Integer
decodeInteger :: forall s. Decoder s Integer
decodeInteger = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Integer
C.decodeInteger
{-# INLINE decodeInteger #-}

decodeNatural :: Decoder s Natural
decodeNatural :: forall s. Decoder s Natural
decodeNatural = do
  !Integer
n <- forall s. Decoder s Integer
decodeInteger
  if Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
0
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Num a => Integer -> a
fromInteger Integer
n
    else forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"Natural" Text
"got a negative number"
{-# INLINE decodeNatural #-}

decodeIntegerCanonical :: Decoder s Integer
decodeIntegerCanonical :: forall s. Decoder s Integer
decodeIntegerCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Integer
C.decodeIntegerCanonical
{-# INLINE decodeIntegerCanonical #-}

decodeListLen :: Decoder s Int
decodeListLen :: forall s. Decoder s Int
decodeListLen = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int
C.decodeListLen
{-# INLINE decodeListLen #-}

decodeListLenCanonical :: Decoder s Int
decodeListLenCanonical :: forall s. Decoder s Int
decodeListLenCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int
C.decodeListLenCanonical
{-# INLINE decodeListLenCanonical #-}

decodeListLenCanonicalOf :: Int -> Decoder s ()
decodeListLenCanonicalOf :: forall s. Int -> Decoder s ()
decodeListLenCanonicalOf = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Int -> Decoder s ()
C.decodeListLenCanonicalOf
{-# INLINE decodeListLenCanonicalOf #-}

decodeListLenIndef :: Decoder s ()
decodeListLenIndef :: forall s. Decoder s ()
decodeListLenIndef = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ()
C.decodeListLenIndef
{-# INLINE decodeListLenIndef #-}

decodeListLenOf :: Int -> Decoder s ()
decodeListLenOf :: forall s. Int -> Decoder s ()
decodeListLenOf = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Int -> Decoder s ()
C.decodeListLenOf
{-# INLINE decodeListLenOf #-}

decodeListLenOrIndef :: Decoder s (Maybe Int)
decodeListLenOrIndef :: forall s. Decoder s (Maybe Int)
decodeListLenOrIndef = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s (Maybe Int)
C.decodeListLenOrIndef
{-# INLINE decodeListLenOrIndef #-}

decodeMapLen :: Decoder s Int
decodeMapLen :: forall s. Decoder s Int
decodeMapLen = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int
C.decodeMapLen
{-# INLINE decodeMapLen #-}

decodeMapLenCanonical :: Decoder s Int
decodeMapLenCanonical :: forall s. Decoder s Int
decodeMapLenCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int
C.decodeMapLenCanonical
{-# INLINE decodeMapLenCanonical #-}

decodeMapLenIndef :: Decoder s ()
decodeMapLenIndef :: forall s. Decoder s ()
decodeMapLenIndef = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ()
C.decodeMapLenIndef
{-# INLINE decodeMapLenIndef #-}

decodeMapLenOrIndef :: Decoder s (Maybe Int)
decodeMapLenOrIndef :: forall s. Decoder s (Maybe Int)
decodeMapLenOrIndef = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s (Maybe Int)
C.decodeMapLenOrIndef
{-# INLINE decodeMapLenOrIndef #-}

decodeNegWord :: Decoder s Word
decodeNegWord :: forall s. Decoder s Word
decodeNegWord = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word
C.decodeNegWord
{-# INLINE decodeNegWord #-}

decodeNegWord64 :: Decoder s Word64
decodeNegWord64 :: forall s. Decoder s Word64
decodeNegWord64 = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word64
C.decodeNegWord64
{-# INLINE decodeNegWord64 #-}

decodeNegWord64Canonical :: Decoder s Word64
decodeNegWord64Canonical :: forall s. Decoder s Word64
decodeNegWord64Canonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word64
C.decodeNegWord64Canonical
{-# INLINE decodeNegWord64Canonical #-}

decodeNegWordCanonical :: Decoder s Word
decodeNegWordCanonical :: forall s. Decoder s Word
decodeNegWordCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word
C.decodeNegWordCanonical
{-# INLINE decodeNegWordCanonical #-}

decodeNull :: Decoder s ()
decodeNull :: forall s. Decoder s ()
decodeNull = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ()
C.decodeNull
{-# INLINE decodeNull #-}

decodeSequenceLenIndef :: (r -> a -> r) -> r -> (r -> b) -> Decoder s a -> Decoder s b
decodeSequenceLenIndef :: forall r a b s.
(r -> a -> r) -> r -> (r -> b) -> Decoder s a -> Decoder s b
decodeSequenceLenIndef r -> a -> r
a r
b r -> b
c Decoder s a
dec = forall s a b.
Decoder s a -> (Decoder s a -> Decoder s b) -> Decoder s b
withPlainDecoder Decoder s a
dec forall a b. (a -> b) -> a -> b
$ forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
C.decodeSequenceLenIndef r -> a -> r
a r
b r -> b
c
{-# INLINE decodeSequenceLenIndef #-}

decodeSequenceLenN :: (r -> a -> r) -> r -> (r -> b) -> Int -> Decoder s a -> Decoder s b
decodeSequenceLenN :: forall r a b s.
(r -> a -> r) -> r -> (r -> b) -> Int -> Decoder s a -> Decoder s b
decodeSequenceLenN r -> a -> r
a r
b r -> b
c Int
n Decoder s a
dec = forall s a b.
Decoder s a -> (Decoder s a -> Decoder s b) -> Decoder s b
withPlainDecoder Decoder s a
dec forall a b. (a -> b) -> a -> b
$ forall r a r' s.
(r -> a -> r)
-> r -> (r -> r') -> Int -> Decoder s a -> Decoder s r'
C.decodeSequenceLenN r -> a -> r
a r
b r -> b
c Int
n
{-# INLINE decodeSequenceLenN #-}

decodeSimple :: Decoder s Word8
decodeSimple :: forall s. Decoder s Word8
decodeSimple = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word8
C.decodeSimple
{-# INLINE decodeSimple #-}

decodeSimpleCanonical :: Decoder s Word8
decodeSimpleCanonical :: forall s. Decoder s Word8
decodeSimpleCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word8
C.decodeSimpleCanonical
{-# INLINE decodeSimpleCanonical #-}

decodeString :: Decoder s Text.Text
decodeString :: forall s. Decoder s Text
decodeString = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Text
C.decodeString
{-# INLINE decodeString #-}

decodeStringCanonical :: Decoder s Text.Text
decodeStringCanonical :: forall s. Decoder s Text
decodeStringCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Text
C.decodeStringCanonical
{-# INLINE decodeStringCanonical #-}

decodeStringIndef :: Decoder s ()
decodeStringIndef :: forall s. Decoder s ()
decodeStringIndef = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ()
C.decodeStringIndef
{-# INLINE decodeStringIndef #-}

decodeTag :: Decoder s Word
decodeTag :: forall s. Decoder s Word
decodeTag = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word
C.decodeTag
{-# INLINE decodeTag #-}

decodeTag64 :: Decoder s Word64
decodeTag64 :: forall s. Decoder s Word64
decodeTag64 = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word64
C.decodeTag64
{-# INLINE decodeTag64 #-}

decodeTag64Canonical :: Decoder s Word64
decodeTag64Canonical :: forall s. Decoder s Word64
decodeTag64Canonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word64
C.decodeTag64Canonical
{-# INLINE decodeTag64Canonical #-}

decodeTagCanonical :: Decoder s Word
decodeTagCanonical :: forall s. Decoder s Word
decodeTagCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word
C.decodeTagCanonical
{-# INLINE decodeTagCanonical #-}

decodeUtf8ByteArray :: Decoder s ByteArray
decodeUtf8ByteArray :: forall s. Decoder s ByteArray
decodeUtf8ByteArray = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ByteArray
C.decodeUtf8ByteArray
{-# INLINE decodeUtf8ByteArray #-}

decodeUtf8ByteArrayCanonical :: Decoder s ByteArray
decodeUtf8ByteArrayCanonical :: forall s. Decoder s ByteArray
decodeUtf8ByteArrayCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ByteArray
C.decodeUtf8ByteArrayCanonical
{-# INLINE decodeUtf8ByteArrayCanonical #-}

decodeWithByteSpan :: Decoder s a -> Decoder s (a, C.ByteOffset, C.ByteOffset)
decodeWithByteSpan :: forall s a. Decoder s a -> Decoder s (a, ByteOffset, ByteOffset)
decodeWithByteSpan Decoder s a
d = forall s a b.
Decoder s a -> (Decoder s a -> Decoder s b) -> Decoder s b
withPlainDecoder Decoder s a
d forall s a. Decoder s a -> Decoder s (a, ByteOffset, ByteOffset)
C.decodeWithByteSpan
{-# INLINE decodeWithByteSpan #-}

decodeWord :: Decoder s Word
decodeWord :: forall s. Decoder s Word
decodeWord = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word
C.decodeWord
{-# INLINE decodeWord #-}

decodeWord16 :: Decoder s Word16
decodeWord16 :: forall s. Decoder s Word16
decodeWord16 = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word16
C.decodeWord16
{-# INLINE decodeWord16 #-}

decodeWord16Canonical :: Decoder s Word16
decodeWord16Canonical :: forall s. Decoder s Word16
decodeWord16Canonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word16
C.decodeWord16Canonical
{-# INLINE decodeWord16Canonical #-}

decodeWord32 :: Decoder s Word32
decodeWord32 :: forall s. Decoder s HostAddress
decodeWord32 = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s HostAddress
C.decodeWord32
{-# INLINE decodeWord32 #-}

decodeWord32Canonical :: Decoder s Word32
decodeWord32Canonical :: forall s. Decoder s HostAddress
decodeWord32Canonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s HostAddress
C.decodeWord32Canonical
{-# INLINE decodeWord32Canonical #-}

decodeWord64 :: Decoder s Word64
decodeWord64 :: forall s. Decoder s Word64
decodeWord64 = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word64
C.decodeWord64
{-# INLINE decodeWord64 #-}

decodeWord64Canonical :: Decoder s Word64
decodeWord64Canonical :: forall s. Decoder s Word64
decodeWord64Canonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word64
C.decodeWord64Canonical
{-# INLINE decodeWord64Canonical #-}

decodeWord8 :: Decoder s Word8
decodeWord8 :: forall s. Decoder s Word8
decodeWord8 = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word8
C.decodeWord8
{-# INLINE decodeWord8 #-}

decodeWord8Canonical :: Decoder s Word8
decodeWord8Canonical :: forall s. Decoder s Word8
decodeWord8Canonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word8
C.decodeWord8Canonical
{-# INLINE decodeWord8Canonical #-}

decodeWordCanonical :: Decoder s Word
decodeWordCanonical :: forall s. Decoder s Word
decodeWordCanonical = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Word
C.decodeWordCanonical
{-# INLINE decodeWordCanonical #-}

decodeWordCanonicalOf :: Word -> Decoder s ()
decodeWordCanonicalOf :: forall s. Word -> Decoder s ()
decodeWordCanonicalOf = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Word -> Decoder s ()
C.decodeWordCanonicalOf
{-# INLINE decodeWordCanonicalOf #-}

decodeWordOf :: Word -> Decoder s ()
decodeWordOf :: forall s. Word -> Decoder s ()
decodeWordOf = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Word -> Decoder s ()
C.decodeWordOf
{-# INLINE decodeWordOf #-}

decodeTerm :: Decoder s C.Term
decodeTerm :: forall s. Decoder s Term
decodeTerm = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Term
C.decodeTerm
{-# INLINE decodeTerm #-}

peekAvailable :: Decoder s Int
peekAvailable :: forall s. Decoder s Int
peekAvailable = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s Int
C.peekAvailable
{-# INLINE peekAvailable #-}

peekByteOffset :: Decoder s C.ByteOffset
peekByteOffset :: forall s. Decoder s ByteOffset
peekByteOffset = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s ByteOffset
C.peekByteOffset
{-# INLINE peekByteOffset #-}

peekTokenType :: Decoder s C.TokenType
peekTokenType :: forall s. Decoder s TokenType
peekTokenType = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall s. Decoder s TokenType
C.peekTokenType
{-# INLINE peekTokenType #-}