{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Ledger.Binary.Decoding.Annotated (
  Annotated (..),
  decodeAnnotated,
  ByteSpan (..),
  Decoded (..),
  annotationBytes,
  annotatedDecoder,
  slice,
  decCBORAnnotated,
  reAnnotate,
  Annotator (..),
  annotatorSlice,
  withSlice,
  FullByteString (..),
  decodeAnnSet,
  decodeNonEmptySetLikeEnforceNoDuplicatesAnn,
) where

import Cardano.Ledger.Binary.Decoding.DecCBOR (DecCBOR (..))
import Cardano.Ledger.Binary.Decoding.Decoder (
  Decoder,
  DecoderError (..),
  allowTag,
  decodeList,
  decodeNonEmptyList,
  decodeWithByteSpan,
  fromPlainDecoder,
  getDecoderVersion,
  getOriginalBytes,
  setTag,
  whenDecoderVersionAtLeast,
 )
import Cardano.Ledger.Binary.Encoding (EncCBOR, Version, serialize')
import Cardano.Ledger.Binary.Version (natVersion)
import Codec.CBOR.Read (ByteOffset)
import qualified Codec.Serialise as Serialise (decode)
import Control.DeepSeq (NFData)
import Control.Monad
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Bifunctor (Bifunctor (first, second))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Function (on)
import Data.Functor ((<&>))
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Set as Set
import qualified Data.Text as T
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import qualified PlutusLedgerApi.V1 as PV1

-------------------------------------------------------------------------
-- ByteSpan
-------------------------------------------------------------------------

-- | Extract a substring of a given ByteString corresponding to the offsets.
slice :: BSL.ByteString -> ByteSpan -> BSL.ByteString
slice :: ByteString -> ByteSpan -> ByteString
slice ByteString
bytes (ByteSpan Int64
start Int64
end) =
  Int64 -> ByteString -> ByteString
BSL.take (Int64
end Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
start) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop Int64
start ByteString
bytes
{-# INLINE slice #-}

-- | A pair of offsets delimiting the beginning and end of a substring of a ByteString
data ByteSpan = ByteSpan !ByteOffset !ByteOffset
  deriving ((forall x. ByteSpan -> Rep ByteSpan x)
-> (forall x. Rep ByteSpan x -> ByteSpan) -> Generic ByteSpan
forall x. Rep ByteSpan x -> ByteSpan
forall x. ByteSpan -> Rep ByteSpan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ByteSpan -> Rep ByteSpan x
from :: forall x. ByteSpan -> Rep ByteSpan x
$cto :: forall x. Rep ByteSpan x -> ByteSpan
to :: forall x. Rep ByteSpan x -> ByteSpan
Generic, Int -> ByteSpan -> ShowS
[ByteSpan] -> ShowS
ByteSpan -> String
(Int -> ByteSpan -> ShowS)
-> (ByteSpan -> String) -> ([ByteSpan] -> ShowS) -> Show ByteSpan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByteSpan -> ShowS
showsPrec :: Int -> ByteSpan -> ShowS
$cshow :: ByteSpan -> String
show :: ByteSpan -> String
$cshowList :: [ByteSpan] -> ShowS
showList :: [ByteSpan] -> ShowS
Show)

-- Used for debugging purposes only.
instance ToJSON ByteSpan

-------------------------------------------------------------------------
-- Annotator
-------------------------------------------------------------------------

data Annotated b a = Annotated {forall b a. Annotated b a -> b
unAnnotated :: !b, forall b a. Annotated b a -> a
annotation :: !a}
  deriving (Annotated b a -> Annotated b a -> Bool
(Annotated b a -> Annotated b a -> Bool)
-> (Annotated b a -> Annotated b a -> Bool) -> Eq (Annotated b a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall b a. (Eq b, Eq a) => Annotated b a -> Annotated b a -> Bool
$c== :: forall b a. (Eq b, Eq a) => Annotated b a -> Annotated b a -> Bool
== :: Annotated b a -> Annotated b a -> Bool
$c/= :: forall b a. (Eq b, Eq a) => Annotated b a -> Annotated b a -> Bool
/= :: Annotated b a -> Annotated b a -> Bool
Eq, Int -> Annotated b a -> ShowS
[Annotated b a] -> ShowS
Annotated b a -> String
(Int -> Annotated b a -> ShowS)
-> (Annotated b a -> String)
-> ([Annotated b a] -> ShowS)
-> Show (Annotated b a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall b a. (Show b, Show a) => Int -> Annotated b a -> ShowS
forall b a. (Show b, Show a) => [Annotated b a] -> ShowS
forall b a. (Show b, Show a) => Annotated b a -> String
$cshowsPrec :: forall b a. (Show b, Show a) => Int -> Annotated b a -> ShowS
showsPrec :: Int -> Annotated b a -> ShowS
$cshow :: forall b a. (Show b, Show a) => Annotated b a -> String
show :: Annotated b a -> String
$cshowList :: forall b a. (Show b, Show a) => [Annotated b a] -> ShowS
showList :: [Annotated b a] -> ShowS
Show, (forall a b. (a -> b) -> Annotated b a -> Annotated b b)
-> (forall a b. a -> Annotated b b -> Annotated b a)
-> Functor (Annotated b)
forall a b. a -> Annotated b b -> Annotated b a
forall a b. (a -> b) -> Annotated b a -> Annotated b b
forall b a b. a -> Annotated b b -> Annotated b a
forall b a b. (a -> b) -> Annotated b a -> Annotated b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall b a b. (a -> b) -> Annotated b a -> Annotated b b
fmap :: forall a b. (a -> b) -> Annotated b a -> Annotated b b
$c<$ :: forall b a b. a -> Annotated b b -> Annotated b a
<$ :: forall a b. a -> Annotated b b -> Annotated b a
Functor, (forall x. Annotated b a -> Rep (Annotated b a) x)
-> (forall x. Rep (Annotated b a) x -> Annotated b a)
-> Generic (Annotated b a)
forall x. Rep (Annotated b a) x -> Annotated b a
forall x. Annotated b a -> Rep (Annotated b a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall b a x. Rep (Annotated b a) x -> Annotated b a
forall b a x. Annotated b a -> Rep (Annotated b a) x
$cfrom :: forall b a x. Annotated b a -> Rep (Annotated b a) x
from :: forall x. Annotated b a -> Rep (Annotated b a) x
$cto :: forall b a x. Rep (Annotated b a) x -> Annotated b a
to :: forall x. Rep (Annotated b a) x -> Annotated b a
Generic)
  deriving anyclass (Annotated b a -> ()
(Annotated b a -> ()) -> NFData (Annotated b a)
forall a. (a -> ()) -> NFData a
forall b a. (NFData b, NFData a) => Annotated b a -> ()
$crnf :: forall b a. (NFData b, NFData a) => Annotated b a -> ()
rnf :: Annotated b a -> ()
NFData, Context -> Annotated b a -> IO (Maybe ThunkInfo)
Proxy (Annotated b a) -> String
(Context -> Annotated b a -> IO (Maybe ThunkInfo))
-> (Context -> Annotated b a -> IO (Maybe ThunkInfo))
-> (Proxy (Annotated b a) -> String)
-> NoThunks (Annotated b a)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall b a.
(NoThunks b, NoThunks a) =>
Context -> Annotated b a -> IO (Maybe ThunkInfo)
forall b a.
(NoThunks b, NoThunks a) =>
Proxy (Annotated b a) -> String
$cnoThunks :: forall b a.
(NoThunks b, NoThunks a) =>
Context -> Annotated b a -> IO (Maybe ThunkInfo)
noThunks :: Context -> Annotated b a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall b a.
(NoThunks b, NoThunks a) =>
Context -> Annotated b a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Annotated b a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall b a.
(NoThunks b, NoThunks a) =>
Proxy (Annotated b a) -> String
showTypeOf :: Proxy (Annotated b a) -> String
NoThunks)

instance Bifunctor Annotated where
  first :: forall a b c. (a -> b) -> Annotated a c -> Annotated b c
first a -> b
f (Annotated a
b c
a) = b -> c -> Annotated b c
forall b a. b -> a -> Annotated b a
Annotated (a -> b
f a
b) c
a
  second :: forall b c a. (b -> c) -> Annotated a b -> Annotated a c
second = (b -> c) -> Annotated a b -> Annotated a c
forall a b. (a -> b) -> Annotated a a -> Annotated a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance (Eq a, Ord b) => Ord (Annotated b a) where
  compare :: Annotated b a -> Annotated b a -> Ordering
compare = b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering)
-> (Annotated b a -> b)
-> Annotated b a
-> Annotated b a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Annotated b a -> b
forall b a. Annotated b a -> b
unAnnotated

instance ToJSON b => ToJSON (Annotated b a) where
  toJSON :: Annotated b a -> Value
toJSON = b -> Value
forall a. ToJSON a => a -> Value
toJSON (b -> Value) -> (Annotated b a -> b) -> Annotated b a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated b a -> b
forall b a. Annotated b a -> b
unAnnotated
  toEncoding :: Annotated b a -> Encoding
toEncoding = b -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (b -> Encoding)
-> (Annotated b a -> b) -> Annotated b a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated b a -> b
forall b a. Annotated b a -> b
unAnnotated

instance FromJSON b => FromJSON (Annotated b ()) where
  parseJSON :: Value -> Parser (Annotated b ())
parseJSON Value
j = (b -> () -> Annotated b ()) -> () -> b -> Annotated b ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> () -> Annotated b ()
forall b a. b -> a -> Annotated b a
Annotated () (b -> Annotated b ()) -> Parser b -> Parser (Annotated b ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j

instance DecCBOR a => DecCBOR (Annotated a BSL.ByteString) where
  decCBOR :: forall s. Decoder s (Annotated a ByteString)
decCBOR = Decoder s a -> Decoder s (Annotated a ByteString)
forall s a. Decoder s a -> Decoder s (Annotated a ByteString)
decodeAnnotated Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR

-- | A decoder for a value paired with an annotation specifying the start and end
-- of the consumed bytes.
annotatedDecoder :: Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder :: forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder Decoder s a
vd =
  Decoder s a -> Decoder s (a, Int64, Int64)
forall s a. Decoder s a -> Decoder s (a, Int64, Int64)
decodeWithByteSpan Decoder s a
vd Decoder s (a, Int64, Int64)
-> ((a, Int64, Int64) -> Annotated a ByteSpan)
-> Decoder s (Annotated a ByteSpan)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(a
x, Int64
start, Int64
end) -> a -> ByteSpan -> Annotated a ByteSpan
forall b a. b -> a -> Annotated b a
Annotated a
x (Int64 -> Int64 -> ByteSpan
ByteSpan Int64
start Int64
end)
{-# INLINE annotatedDecoder #-}

-- | A decoder for a value paired with an annotation specifying the start and end
-- of the consumed bytes.
decCBORAnnotated :: DecCBOR a => Decoder s (Annotated a ByteSpan)
decCBORAnnotated :: forall a s. DecCBOR a => Decoder s (Annotated a ByteSpan)
decCBORAnnotated = Decoder s a -> Decoder s (Annotated a ByteSpan)
forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR
{-# INLINE decCBORAnnotated #-}

annotationBytes :: Functor f => BSL.ByteString -> f ByteSpan -> f BS.ByteString
annotationBytes :: forall (f :: * -> *).
Functor f =>
ByteString -> f ByteSpan -> f ByteString
annotationBytes ByteString
bytes = (ByteSpan -> ByteString) -> f ByteSpan -> f ByteString
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (ByteSpan -> ByteString) -> ByteSpan -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteSpan -> ByteString
slice ByteString
bytes)

-- | Reconstruct an annotation by re-serialising the payload to a ByteString.
reAnnotate :: EncCBOR a => Version -> Annotated a b -> Annotated a BS.ByteString
reAnnotate :: forall a b.
EncCBOR a =>
Version -> Annotated a b -> Annotated a ByteString
reAnnotate Version
version (Annotated a
x b
_) = a -> ByteString -> Annotated a ByteString
forall b a. b -> a -> Annotated b a
Annotated a
x (Version -> a -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
version a
x)

decodeAnnotated :: Decoder s a -> Decoder s (Annotated a BSL.ByteString)
decodeAnnotated :: forall s a. Decoder s a -> Decoder s (Annotated a ByteString)
decodeAnnotated Decoder s a
decoder = do
  bsl <- Decoder s ByteString
forall s. Decoder s ByteString
getOriginalBytes
  fmap (slice bsl) <$> annotatedDecoder decoder
{-# INLINE decodeAnnotated #-}

class Decoded t where
  type BaseType t :: Type
  recoverBytes :: t -> BS.ByteString

instance Decoded (Annotated b BS.ByteString) where
  type BaseType (Annotated b BS.ByteString) = b
  recoverBytes :: Annotated b ByteString -> ByteString
recoverBytes = Annotated b ByteString -> ByteString
forall b a. Annotated b a -> a
annotation

-------------------------------------------------------------------------
-- Annotator
-------------------------------------------------------------------------

-- | This marks the entire bytestring used during decoding, rather than the
--   piece we need to finish constructing our value.
newtype FullByteString = Full BSL.ByteString

-- | A value of type @(Annotator a)@ is one that needs access to the entire bytestring
--   used during decoding to finish construction of a vaue of type @a@. A typical use is
--   some type that stores the bytes that were used to deserialize it.  For example the
--   type @Inner@ below is constructed using the helper function @makeInner@ which
--   serializes and stores its bytes (using 'serialize').  Note how we build the
--   'Annotator' by abstracting over the full bytes, and using those original bytes to
--   fill the bytes field of the constructor @Inner@.  The 'EncCBOR' instance just reuses
--   the stored bytes to produce an encoding (using 'encodePreEncoded').
--
-- @
-- data Inner = Inner Int Bool LByteString
--
-- makeInner :: Int -> Bool -> Inner
-- makeInner i b = Inner i b (serialize (encCBOR i <> encCBOR b))
--
-- instance EncCBOR Inner where
--   encCBOR (Inner _ _ bytes) = encodePreEncoded bytes
--
-- instance DecCBOR (Annotator Inner) where
--   decCBOR = do
--      int <- decCBOR
--      trueOrFalse <- decCBOR
--      pure (Annotator (\(Full bytes) -> Inner int trueOrFalse bytes))
-- @
--
-- if an @Outer@ type has a field of type @Inner@, with a @(EncCBOR (Annotator Inner))@
-- instance, the @Outer@ type must also have a @(EncCBOR (Annotator Outer))@ instance.  The
-- key to writing that instance is to use the operation @withSlice@ which returns a pair.
-- The first component is an @Annotator@ that can build @Inner@, the second is an
-- @Annotator@ that given the full bytes, extracts just the bytes needed to decode
-- @Inner@.
--
-- @
-- data Outer = Outer Text Inner
--
-- instance EncCBOR Outer where
--   encCBOR (Outer t i) = encCBOR t <> encCBOR i
--
-- instance DecCBOR (Annotator Outer) where
--   decCBOR = do
--     t <- decCBOR
--     (Annotator mkInner, Annotator extractInnerBytes) <- withSlice decCBOR
--     pure (Annotator (\ full -> Outer t (mkInner (Full (extractInnerBytes full)))))
-- @
newtype Annotator a = Annotator {forall a. Annotator a -> FullByteString -> Either DecoderError a
runAnnotator :: FullByteString -> Either DecoderError a}

instance Functor Annotator where
  fmap :: forall a b. (a -> b) -> Annotator a -> Annotator b
fmap a -> b
f (Annotator FullByteString -> Either DecoderError a
m) = (FullByteString -> Either DecoderError b) -> Annotator b
forall a. (FullByteString -> Either DecoderError a) -> Annotator a
Annotator ((a -> b) -> Either DecoderError a -> Either DecoderError b
forall a b.
(a -> b) -> Either DecoderError a -> Either DecoderError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either DecoderError a -> Either DecoderError b)
-> (FullByteString -> Either DecoderError a)
-> FullByteString
-> Either DecoderError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FullByteString -> Either DecoderError a
m)
  {-# INLINE fmap #-}

instance Applicative Annotator where
  pure :: forall a. a -> Annotator a
pure = (FullByteString -> Either DecoderError a) -> Annotator a
forall a. (FullByteString -> Either DecoderError a) -> Annotator a
Annotator ((FullByteString -> Either DecoderError a) -> Annotator a)
-> (a -> FullByteString -> Either DecoderError a)
-> a
-> Annotator a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either DecoderError a -> FullByteString -> Either DecoderError a
forall a b. a -> b -> a
const (Either DecoderError a -> FullByteString -> Either DecoderError a)
-> (a -> Either DecoderError a)
-> a
-> FullByteString
-> Either DecoderError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either DecoderError a
forall a. a -> Either DecoderError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE pure #-}
  <*> :: forall a b. Annotator (a -> b) -> Annotator a -> Annotator b
(<*>) (Annotator FullByteString -> Either DecoderError (a -> b)
m1) (Annotator FullByteString -> Either DecoderError a
m2) = (FullByteString -> Either DecoderError b) -> Annotator b
forall a. (FullByteString -> Either DecoderError a) -> Annotator a
Annotator ((FullByteString -> Either DecoderError b) -> Annotator b)
-> (FullByteString -> Either DecoderError b) -> Annotator b
forall a b. (a -> b) -> a -> b
$ \FullByteString
bytes -> FullByteString -> Either DecoderError (a -> b)
m1 FullByteString
bytes Either DecoderError (a -> b)
-> Either DecoderError a -> Either DecoderError b
forall a b.
Either DecoderError (a -> b)
-> Either DecoderError a -> Either DecoderError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FullByteString -> Either DecoderError a
m2 FullByteString
bytes
  {-# INLINE (<*>) #-}

instance Monad Annotator where
  >>= :: forall a b. Annotator a -> (a -> Annotator b) -> Annotator b
(>>=) (Annotator FullByteString -> Either DecoderError a
m1) a -> Annotator b
m2 = (FullByteString -> Either DecoderError b) -> Annotator b
forall a. (FullByteString -> Either DecoderError a) -> Annotator a
Annotator ((FullByteString -> Either DecoderError b) -> Annotator b)
-> (FullByteString -> Either DecoderError b) -> Annotator b
forall a b. (a -> b) -> a -> b
$ \FullByteString
bytes -> FullByteString -> Either DecoderError a
m1 FullByteString
bytes Either DecoderError a
-> (a -> Either DecoderError b) -> Either DecoderError b
forall a b.
Either DecoderError a
-> (a -> Either DecoderError b) -> Either DecoderError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Annotator b -> FullByteString -> Either DecoderError b
forall a. Annotator a -> FullByteString -> Either DecoderError a
`runAnnotator` FullByteString
bytes) (Annotator b -> Either DecoderError b)
-> (a -> Annotator b) -> a -> Either DecoderError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Annotator b
m2
  {-# INLINE (>>=) #-}

instance MonadFail Annotator where
  fail :: forall a. String -> Annotator a
fail String
msg = (FullByteString -> Either DecoderError a) -> Annotator a
forall a. (FullByteString -> Either DecoderError a) -> Annotator a
Annotator ((FullByteString -> Either DecoderError a) -> Annotator a)
-> (FullByteString -> Either DecoderError a) -> Annotator a
forall a b. (a -> b) -> a -> b
$ Either DecoderError a -> FullByteString -> Either DecoderError a
forall a b. a -> b -> a
const (Either DecoderError a -> FullByteString -> Either DecoderError a)
-> Either DecoderError a -> FullByteString -> Either DecoderError a
forall a b. (a -> b) -> a -> b
$ DecoderError -> Either DecoderError a
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError a)
-> DecoderError -> Either DecoderError a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"Annotator" (String -> Text
T.pack String
msg)

-- | The argument is a decoder for a annotator that needs access to the bytes that
-- | were decoded. This function constructs and supplies the relevant piece.
annotatorSlice ::
  Decoder s (Annotator (BSL.ByteString -> a)) ->
  Decoder s (Annotator a)
annotatorSlice :: forall s a.
Decoder s (Annotator (ByteString -> a)) -> Decoder s (Annotator a)
annotatorSlice Decoder s (Annotator (ByteString -> a))
dec = do
  (k, bytes) <- Decoder s (Annotator (ByteString -> a))
-> Decoder s (Annotator (ByteString -> a), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice Decoder s (Annotator (ByteString -> a))
dec
  pure $ k <*> bytes
{-# INLINE annotatorSlice #-}

-- | Pairs the decoder result with an annotator that can be used to construct the exact
-- bytes used to decode the result.
withSlice :: Decoder s a -> Decoder s (a, Annotator BSL.ByteString)
withSlice :: forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice Decoder s a
dec = do
  Annotated r byteSpan <- Decoder s a -> Decoder s (Annotated a ByteSpan)
forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder Decoder s a
dec
  return (r, Annotator (\(Full ByteString
bsl) -> ByteString -> Either DecoderError ByteString
forall a. a -> Either DecoderError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either DecoderError ByteString)
-> ByteString -> Either DecoderError ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteSpan -> ByteString
slice ByteString
bsl ByteSpan
byteSpan))
{-# INLINE withSlice #-}

-- | Starting with protocol version 12 this decoder matches the length of a list with the size of
-- the Set in order to enforce there are no duplicates.
decodeAnnSet :: Ord t => Decoder s (Annotator t) -> Decoder s (Annotator (Set.Set t))
decodeAnnSet :: forall t s.
Ord t =>
Decoder s (Annotator t) -> Decoder s (Annotator (Set t))
decodeAnnSet Decoder s (Annotator t)
dec = do
  Version -> Decoder s () -> Decoder s ()
forall s a. Version -> Decoder s a -> Decoder s ()
whenDecoderVersionAtLeast (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
    Word -> Decoder s ()
forall s. Word -> Decoder s ()
allowTag Word
setTag
  xs <- Decoder s (Annotator t) -> Decoder s [Annotator t]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator t)
dec
  v <- getDecoderVersion
  pure $ do
    s <- Set.fromList <$> sequence xs
    when (v >= natVersion @12 && Set.size s /= length xs) $
      Annotator $
        const (Left $ DecoderErrorCustom "Set" "Duplicates detected")
    pure s
{-# INLINE decodeAnnSet #-}

decodeNonEmptySetLikeEnforceNoDuplicatesAnn ::
  forall s a b c.
  (Monoid b, DecCBOR (Annotator a)) =>
  -- | Add an element into the decoded Set like data structure
  (a -> b -> b) ->
  -- | Get the final data structure and the number of elements it has.
  (b -> (Int, c)) ->
  Decoder s (Annotator c)
decodeNonEmptySetLikeEnforceNoDuplicatesAnn :: forall s a b c.
(Monoid b, DecCBOR (Annotator a)) =>
(a -> b -> b) -> (b -> (Int, c)) -> Decoder s (Annotator c)
decodeNonEmptySetLikeEnforceNoDuplicatesAnn a -> b -> b
insert b -> (Int, c)
getFinalWithLen = do
  Word -> Decoder s ()
forall s. Word -> Decoder s ()
allowTag Word
setTag
  valAnns <- Decoder s (Annotator a) -> Decoder s (NonEmpty (Annotator a))
forall s a. Decoder s a -> Decoder s (NonEmpty a)
decodeNonEmptyList Decoder s (Annotator a)
forall s. Decoder s (Annotator a)
forall a s. DecCBOR a => Decoder s a
decCBOR
  pure $ go mempty 0 valAnns
  where
    go :: b -> Int -> NonEmpty (Annotator a) -> Annotator c
    go :: b -> Int -> NonEmpty (Annotator a) -> Annotator c
go !b
m !Int
n (Annotator a
x :| [Annotator a]
xs) = do
      val <- Annotator a
x
      case xs of
        [] -> b -> Int -> Annotator c
finish (a -> b -> b
insert a
val b
m) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        (Annotator a
y : [Annotator a]
ys) -> b -> Int -> NonEmpty (Annotator a) -> Annotator c
go (a -> b -> b
insert a
val b
m) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Annotator a
y Annotator a -> [Annotator a] -> NonEmpty (Annotator a)
forall a. a -> [a] -> NonEmpty a
:| [Annotator a]
ys)
    finish :: b -> Int -> Annotator c
    finish :: b -> Int -> Annotator c
finish b
m Int
n
      | Int
finalLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n = String -> Annotator c
forall a. String -> Annotator a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Duplicates found, expected no duplicates"
      | Bool
otherwise = c -> Annotator c
forall a. a -> Annotator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
final
      where
        (Int
finalLen, c
final) = b -> (Int, c)
getFinalWithLen b
m
    {-# INLINE finish #-}
{-# INLINE decodeNonEmptySetLikeEnforceNoDuplicatesAnn #-}

instance DecCBOR (Annotator PV1.Data) where
  decCBOR :: forall s. Decoder s (Annotator Data)
decCBOR = Data -> Annotator Data
forall a. a -> Annotator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Data -> Annotator Data)
-> Decoder s Data -> Decoder s (Annotator Data)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Data -> Decoder s Data
forall s a. Decoder s a -> Decoder s a
fromPlainDecoder Decoder s Data
forall s. Decoder s Data
forall a s. Serialise a => Decoder s a
Serialise.decode
  {-# INLINE decCBOR #-}