{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Binary.Annotator (
  decodeFullAnnotator,
  decodeFullAnnotatedBytes,
  decodeFullAnnotatorFromHexText,
  Annotated (..),
  decodeAnnotated,
  ByteSpan (..),
  Decoded (..),
  annotatedDecoder,
  slice,
  decCBORAnnotated,
  reAnnotate,
  Annotator (..),
  annotatorSlice,
  withSlice,
  FullByteString (..),
  decodeAnnSet,
  translateViaCBORAnnotator,
)
where

import Cardano.Ledger.Binary
import qualified Cardano.Ledger.Binary.Plain as Plain
import qualified Codec.Serialise as Serialise (decode)
import Control.Monad.Except (Except, MonadError (throwError))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Text (Text)
import qualified PlutusLedgerApi.V1 as PV1

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

-- | Same as `decodeFullDecoder`, except it provdes the means of passing portion or all
-- of the `BSL.ByteString` input argument to the decoding `Annotator`.
decodeFullAnnotator ::
  Version ->
  Text ->
  (forall s. Decoder s (Annotator a)) ->
  BSL.ByteString ->
  Either DecoderError a
decodeFullAnnotator :: forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator Version
v Text
lbl forall s. Decoder s (Annotator a)
decoder ByteString
bytes =
  (\Annotator a
x -> forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator a
x (ByteString -> FullByteString
Full ByteString
bytes)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
decodeFullDecoder Version
v Text
lbl forall s. Decoder s (Annotator a)
decoder ByteString
bytes
{-# INLINE decodeFullAnnotator #-}

-- | Same as `decodeFullDecoder`, decodes a Haskell value from a lazy
-- `BSL.ByteString`, requiring that the full ByteString is consumed, and
-- replaces `ByteSpan` annotations with the corresponding slice of the input as
-- a strict `BS.ByteString`.
decodeFullAnnotatedBytes ::
  Functor f =>
  Version ->
  Text ->
  (forall s. Decoder s (f ByteSpan)) ->
  BSL.ByteString ->
  Either DecoderError (f BS.ByteString)
decodeFullAnnotatedBytes :: forall (f :: * -> *).
Functor f =>
Version
-> Text
-> (forall s. Decoder s (f ByteSpan))
-> ByteString
-> Either DecoderError (f ByteString)
decodeFullAnnotatedBytes Version
v Text
lbl forall s. Decoder s (f ByteSpan)
decoder ByteString
bytes =
  forall (f :: * -> *).
Functor f =>
ByteString -> f ByteSpan -> f ByteString
annotationBytes ByteString
bytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
decodeFullDecoder Version
v Text
lbl forall s. Decoder s (f ByteSpan)
decoder ByteString
bytes
{-# INLINE decodeFullAnnotatedBytes #-}

decodeFullAnnotatorFromHexText ::
  Version ->
  Text ->
  (forall s. Decoder s (Annotator a)) ->
  Text ->
  Either DecoderError a
decodeFullAnnotatorFromHexText :: forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> Text
-> Either DecoderError a
decodeFullAnnotatorFromHexText Version
v Text
desc forall s. Decoder s (Annotator a)
dec =
  forall b.
(ByteString -> Either DecoderError b)
-> Text -> Either DecoderError b
Plain.withHexText forall a b. (a -> b) -> a -> b
$ forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator Version
v Text
desc forall s. Decoder s (Annotator a)
dec forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict
{-# INLINE decodeFullAnnotatorFromHexText #-}

-- | Translation function between values through a related binary representation. This
-- function allows you to translate one type into another (or the same one) through their
-- common binary format. It is possible for the source type to be encoded with a different
-- version than the version that will be used for decoding. This is useful for types that
-- build upon one another and are "upgradeable" through their binary representation. It is
-- important to note that the deserialization will happen with `Annotator`, since that is
-- usually the way we deserialize upgradeable types that live on chain. Moreover, encoding
-- does not require a version, because memoized types that were decoded with annotation
-- will have the bytes retained and thus will have the `ToCBOR` instance.
translateViaCBORAnnotator ::
  (ToCBOR a, DecCBOR (Annotator b)) =>
  -- | Version that will be used for deserialization
  Version ->
  Text ->
  a ->
  Except DecoderError b
translateViaCBORAnnotator :: forall a b.
(ToCBOR a, DecCBOR (Annotator b)) =>
Version -> Text -> a -> Except DecoderError b
translateViaCBORAnnotator Version
versionDeserialize Text
name a
x =
  case forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator Version
versionDeserialize Text
name forall a s. DecCBOR a => Decoder s a
decCBOR (forall a. ToCBOR a => a -> ByteString
Plain.serialize a
x) of
    Right b
newx -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
newx
    Left DecoderError
decoderError -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DecoderError
decoderError

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