{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-unused-foralls #-}

module Test.Cardano.Ledger.Conway.Binary.Golden (
  expectDecoderResultOn,
  expectDecoderFailureAnn,
  listRedeemersEnc,
  goldenListRedeemers,
) where

import Cardano.Ledger.Alonzo.Core (
  AsIx (..),
  eraProtVerLow,
  pattern SpendingPurpose,
 )
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..))
import Cardano.Ledger.Alonzo.TxWits (Redeemers (..), unRedeemers)
import Cardano.Ledger.BaseTypes (Version)
import Cardano.Ledger.Binary (
  Annotator (..),
  DecCBOR (..),
  ToCBOR (..),
  decodeFullAnnotator,
  toLazyByteString,
 )
import Cardano.Ledger.Binary.Plain (DecoderError (..), Tokens (..))
import Cardano.Ledger.Plutus (Data (..))
import qualified Data.Map as Map
import Data.Typeable (Proxy (..), Typeable)
import PlutusLedgerApi.Common (Data (..))
import Test.Cardano.Ledger.Binary.Plain.Golden (Enc (..))
import Test.Cardano.Ledger.Binary.RoundTrip (embedTripAnnExpectation)
import Test.Cardano.Ledger.Common (
  Expectation,
  HasCallStack,
  Spec,
  ToExpr,
  expectationFailure,
  it,
  shouldBe,
  shouldBeExpr,
  showExpr,
 )
import Test.Cardano.Ledger.Conway.Era (ConwayEraTest)

expectDecoderFailureAnn ::
  forall a.
  (ToExpr a, DecCBOR (Annotator a), Typeable a, HasCallStack) =>
  Version ->
  Enc ->
  DecoderError ->
  Expectation
expectDecoderFailureAnn :: forall a.
(ToExpr a, DecCBOR (Annotator a), Typeable a, HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn Version
version Enc
enc DecoderError
expectedErr =
  case Either DecoderError a
result of
    Left DecoderError
err -> DecoderError
err DecoderError -> DecoderError -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` DecoderError
expectedErr
    Right a
x ->
      HasCallStack => String -> Expectation
String -> Expectation
expectationFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$
        String
"Expected a failure, but decoder succeeded:\n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. ToExpr a => a -> String
showExpr a
x
  where
    bytes :: ByteString
bytes = Encoding -> ByteString
toLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Enc -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Enc
enc
    result :: Either DecoderError a
result = forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator @a Version
version (Proxy (Annotator a) -> Text
forall a. DecCBOR a => Proxy a -> Text
label (Proxy (Annotator a) -> Text) -> Proxy (Annotator a) -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Annotator a)) Decoder s (Annotator a)
forall s. Decoder s (Annotator a)
forall a s. DecCBOR a => Decoder s a
decCBOR ByteString
bytes

expectDecoderResultOn ::
  forall a b.
  (ToExpr b, DecCBOR (Annotator a), Eq b, HasCallStack) =>
  Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn :: forall a b.
(ToExpr b, DecCBOR (Annotator a), Eq b, HasCallStack) =>
Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn Version
version Enc
enc a
expected a -> b
f =
  Version
-> Version -> (a -> Enc -> Expectation) -> Enc -> Expectation
forall a b.
(ToCBOR a, DecCBOR (Annotator b), HasCallStack) =>
Version -> Version -> (b -> a -> Expectation) -> a -> Expectation
embedTripAnnExpectation Version
version Version
version (\a
x Enc
_ -> a -> b
f a
x b -> b -> Expectation
forall a. (HasCallStack, ToExpr a, Eq a) => a -> a -> Expectation
`shouldBeExpr` a -> b
f a
expected) Enc
enc

-- | A simple redeemer encoded as a list
listRedeemersEnc :: Enc
listRedeemersEnc :: Enc
listRedeemersEnc =
  [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
    [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
1)
    , [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
4)
        , Int -> Enc
forall a. ToCBOR a => a -> Enc
E (Int
0 :: Int)
        , Int -> Enc
forall a. ToCBOR a => a -> Enc
E (Int
10 :: Int)
        , Int -> Enc
forall a. ToCBOR a => a -> Enc
E (Int
20 :: Int)
        , [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
            [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
2)
            , Int -> Enc
forall a. ToCBOR a => a -> Enc
E (Int
30 :: Int)
            , Int -> Enc
forall a. ToCBOR a => a -> Enc
E (Int
40 :: Int)
            ]
        ]
    ]

goldenListRedeemers :: forall era. ConwayEraTest era => Spec
goldenListRedeemers :: forall era. ConwayEraTest era => Spec
goldenListRedeemers =
  String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decoding Redeemers encoded as a list succeeds" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$
    forall a b.
(ToExpr b, DecCBOR (Annotator a), Eq b, HasCallStack) =>
Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn @(Redeemers era)
      (forall era. Era era => Version
eraProtVerLow @era)
      Enc
listRedeemersEnc
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers (Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> Redeemers era
forall a b. (a -> b) -> a -> b
$ PlutusPurpose AsIx era
-> (Data era, ExUnits)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall k a. k -> a -> Map k a
Map.singleton (AsIx Word32 TxIn -> PlutusPurpose AsIx era
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 TxIn -> PlutusPurpose f era
SpendingPurpose (AsIx Word32 TxIn -> PlutusPurpose AsIx era)
-> AsIx Word32 TxIn -> PlutusPurpose AsIx era
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
10) (Data -> Data era
forall era. Era era => Data -> Data era
Data (Data -> Data era) -> Data -> Data era
forall a b. (a -> b) -> a -> b
$ Integer -> Data
I Integer
20, Natural -> Natural -> ExUnits
ExUnits Natural
30 Natural
40))
      Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers