{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Core.Binary.Annotator (
  decoderEquivalenceEraSpec,
  decoderEquivalenceCoreEraTypesSpec,
  Mem,
  module Test.Cardano.Ledger.Binary.Annotator,
) where

import Cardano.Ledger.Binary
import Cardano.Ledger.Block
import Cardano.Ledger.Core
import Cardano.Ledger.Keys
import Cardano.Ledger.MemoBytes (MemoBytes)
import Cardano.Ledger.MemoBytes.Internal (mkMemoBytes)
import Cardano.Ledger.Plutus
import Data.Typeable
import Test.Cardano.Ledger.Binary (decoderEquivalenceSpec)
import Test.Cardano.Ledger.Binary.Annotator
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary ()

-- | Useful when deriving DecCBOR(Annotator T)
-- deriving via (Mem T) instance DecCBOR (Annotator T)
type Mem t = Annotator (MemoBytes t)

instance
  (Typeable t, DecCBOR (Annotator t)) =>
  DecCBOR (Annotator (MemoBytes t))
  where
  decCBOR :: forall s. Decoder s (Annotator (MemoBytes t))
decCBOR = do
    (Annotator FullByteString -> t
getT, Annotator FullByteString -> ByteString
getBytes) <- forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. (FullByteString -> a) -> Annotator a
Annotator (\FullByteString
fullbytes -> forall t. t -> ByteString -> MemoBytes t
mkMemoBytes (FullByteString -> t
getT FullByteString
fullbytes) (FullByteString -> ByteString
getBytes FullByteString
fullbytes)))

instance DecCBOR (Annotator BootstrapWitness) where
  decCBOR :: forall s. Decoder s (Annotator BootstrapWitness)
decCBOR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

instance Typeable kr => DecCBOR (Annotator (WitVKey kr)) where
  decCBOR :: forall s. Decoder s (Annotator (WitVKey kr))
decCBOR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

instance
  ( EraSegWits era
  , DecCBOR (Annotator h)
  , DecCBOR (Annotator (TxSeq era))
  , Typeable h
  ) =>
  DecCBOR (Annotator (Block h era))
  where
  decCBOR :: forall s. Decoder s (Annotator (Block h era))
decCBOR = forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"Block" (forall a b. a -> b -> a
const Int
blockSize) forall a b. (a -> b) -> a -> b
$ do
    Annotator h
header <- forall a s. DecCBOR a => Decoder s a
decCBOR
    Annotator (TxSeq era)
txns <- forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall h era. h -> TxSeq era -> Block h era
Block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator h
header forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator (TxSeq era)
txns
    where
      blockSize :: Int
blockSize = Int
1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall era. EraSegWits era => Word64
numSegComponents @era)

instance DecCBOR (Annotator PlutusBinary) where
  decCBOR :: forall s. Decoder s (Annotator PlutusBinary)
decCBOR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

instance Typeable era => DecCBOR (Annotator (PlutusData era)) where
  decCBOR :: forall s. Decoder s (Annotator (PlutusData era))
decCBOR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

instance Era era => DecCBOR (Annotator (Data era)) where
  decCBOR :: forall s. Decoder s (Annotator (Data era))
decCBOR = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall era. MemoBytes (PlutusData era) -> Data era
MkData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

decoderEquivalenceEraSpec ::
  forall era t.
  ( Era era
  , Eq t
  , ToCBOR t
  , DecCBOR (Annotator t)
  , Arbitrary t
  , Show t
  ) =>
  Spec
decoderEquivalenceEraSpec :: forall era t.
(Era era, Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t,
 Show t) =>
Spec
decoderEquivalenceEraSpec = forall t.
(Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t, Show t) =>
Version -> Version -> Spec
decoderEquivalenceSpec @t (forall era. Era era => Version
eraProtVerLow @era) (forall era. Era era => Version
eraProtVerHigh @era)

decoderEquivalenceCoreEraTypesSpec ::
  forall era.
  ( EraTx era
  , Arbitrary (Tx era)
  , Arbitrary (TxBody era)
  , Arbitrary (TxWits era)
  , Arbitrary (TxAuxData era)
  , Arbitrary (Script era)
  , DecCBOR (Annotator (Tx era))
  , DecCBOR (Annotator (TxBody era))
  , DecCBOR (Annotator (TxWits era))
  , DecCBOR (Annotator (TxAuxData era))
  , DecCBOR (Annotator (Script era))
  , HasCallStack
  ) =>
  Spec
decoderEquivalenceCoreEraTypesSpec :: forall era.
(EraTx era, Arbitrary (Tx era), Arbitrary (TxBody era),
 Arbitrary (TxWits era), Arbitrary (TxAuxData era),
 Arbitrary (Script era), DecCBOR (Annotator (Tx era)),
 DecCBOR (Annotator (TxBody era)), DecCBOR (Annotator (TxWits era)),
 DecCBOR (Annotator (TxAuxData era)),
 DecCBOR (Annotator (Script era)), HasCallStack) =>
Spec
decoderEquivalenceCoreEraTypesSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DecCBOR instances equivalence" forall a b. (a -> b) -> a -> b
$ do
    forall era t.
(Era era, Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t,
 Show t) =>
Spec
decoderEquivalenceEraSpec @era @(Data era)
    forall era t.
(Era era, Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t,
 Show t) =>
Spec
decoderEquivalenceEraSpec @era @(Script era)
    forall era t.
(Era era, Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t,
 Show t) =>
Spec
decoderEquivalenceEraSpec @era @(TxAuxData era)
    forall era t.
(Era era, Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t,
 Show t) =>
Spec
decoderEquivalenceEraSpec @era @(TxWits era)
    forall era t.
(Era era, Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t,
 Show t) =>
Spec
decoderEquivalenceEraSpec @era @(TxBody era)
    forall era t.
(Era era, Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t,
 Show t) =>
Spec
decoderEquivalenceEraSpec @era @(Tx era)