{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Alonzo.Translation.TranslationInstance (
  TranslationInstance (..),
  deserializeTranslationInstances,
  VersionedTxInfo (..),
) where

import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext, SupportedLanguage)
import Cardano.Ledger.BaseTypes (ProtVer)
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecoderError,
  EncCBOR (..),
  decodeFull,
  fromPlainDecoder,
  fromPlainEncoding,
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.Core as Core
import Cardano.Ledger.State (UTxO (..))
import qualified Codec.Serialise as Cborg (Serialise (..))
import qualified Data.ByteString.Lazy as BSL
import GHC.Generics (Generic)
import qualified PlutusLedgerApi.V1 as PV1
import qualified PlutusLedgerApi.V2 as PV2
import qualified PlutusLedgerApi.V3 as PV3

data VersionedTxInfo
  = TxInfoPV1 PV1.TxInfo
  | TxInfoPV2 PV2.TxInfo
  | TxInfoPV3 PV3.TxInfo
  | TxInfoPV4 PV3.TxInfo
  deriving (Int -> VersionedTxInfo -> ShowS
[VersionedTxInfo] -> ShowS
VersionedTxInfo -> String
(Int -> VersionedTxInfo -> ShowS)
-> (VersionedTxInfo -> String)
-> ([VersionedTxInfo] -> ShowS)
-> Show VersionedTxInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionedTxInfo -> ShowS
showsPrec :: Int -> VersionedTxInfo -> ShowS
$cshow :: VersionedTxInfo -> String
show :: VersionedTxInfo -> String
$cshowList :: [VersionedTxInfo] -> ShowS
showList :: [VersionedTxInfo] -> ShowS
Show, VersionedTxInfo -> VersionedTxInfo -> Bool
(VersionedTxInfo -> VersionedTxInfo -> Bool)
-> (VersionedTxInfo -> VersionedTxInfo -> Bool)
-> Eq VersionedTxInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionedTxInfo -> VersionedTxInfo -> Bool
== :: VersionedTxInfo -> VersionedTxInfo -> Bool
$c/= :: VersionedTxInfo -> VersionedTxInfo -> Bool
/= :: VersionedTxInfo -> VersionedTxInfo -> Bool
Eq, (forall x. VersionedTxInfo -> Rep VersionedTxInfo x)
-> (forall x. Rep VersionedTxInfo x -> VersionedTxInfo)
-> Generic VersionedTxInfo
forall x. Rep VersionedTxInfo x -> VersionedTxInfo
forall x. VersionedTxInfo -> Rep VersionedTxInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VersionedTxInfo -> Rep VersionedTxInfo x
from :: forall x. VersionedTxInfo -> Rep VersionedTxInfo x
$cto :: forall x. Rep VersionedTxInfo x -> VersionedTxInfo
to :: forall x. Rep VersionedTxInfo x -> VersionedTxInfo
Generic)

-- | Represents arguments passed to `alonzoTxInfo` along with the produced result.
data TranslationInstance era = TranslationInstance
  { forall era. TranslationInstance era -> ProtVer
tiProtVer :: ProtVer
  , forall era. TranslationInstance era -> SupportedLanguage era
tiLanguage :: SupportedLanguage era
  , forall era. TranslationInstance era -> UTxO era
tiUtxo :: UTxO era
  , forall era. TranslationInstance era -> Tx TopTx era
tiTx :: Core.Tx TopTx era
  , forall era. TranslationInstance era -> VersionedTxInfo
tiResult :: VersionedTxInfo
  }
  deriving ((forall x.
 TranslationInstance era -> Rep (TranslationInstance era) x)
-> (forall x.
    Rep (TranslationInstance era) x -> TranslationInstance era)
-> Generic (TranslationInstance era)
forall x.
Rep (TranslationInstance era) x -> TranslationInstance era
forall x.
TranslationInstance era -> Rep (TranslationInstance era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (TranslationInstance era) x -> TranslationInstance era
forall era x.
TranslationInstance era -> Rep (TranslationInstance era) x
$cfrom :: forall era x.
TranslationInstance era -> Rep (TranslationInstance era) x
from :: forall x.
TranslationInstance era -> Rep (TranslationInstance era) x
$cto :: forall era x.
Rep (TranslationInstance era) x -> TranslationInstance era
to :: forall x.
Rep (TranslationInstance era) x -> TranslationInstance era
Generic)

deriving instance
  (Era era, Eq (PParams era), Eq (UTxO era), Eq (Core.Tx TopTx era)) => Eq (TranslationInstance era)

deriving instance
  (Era era, Show (PParams era), Show (UTxO era), Show (Core.Tx TopTx era)) =>
  Show (TranslationInstance era)

instance Cborg.Serialise PV1.DCert

instance Cborg.Serialise PV1.TxInInfo

instance Cborg.Serialise PV1.TxInfo

instance Cborg.Serialise PV1.TxOut

instance Cborg.Serialise PV2.ScriptPurpose

instance Cborg.Serialise PV2.TxId

instance Cborg.Serialise PV2.TxOutRef

instance Cborg.Serialise PV2.TxInInfo

instance Cborg.Serialise PV2.TxInfo

instance Cborg.Serialise PV3.Address

instance Cborg.Serialise PV3.BuiltinData

instance Cborg.Serialise PV3.ChangedParameters

instance Cborg.Serialise PV3.ColdCommitteeCredential

instance Cborg.Serialise PV3.Committee

instance Cborg.Serialise PV3.Constitution

instance Cborg.Serialise PV3.Credential

instance Cborg.Serialise PV3.CurrencySymbol

instance Cborg.Serialise PV3.DRep

instance Cborg.Serialise PV3.DRepCredential

instance Cborg.Serialise PV3.DatumHash

instance Cborg.Serialise PV3.Delegatee

instance Cborg.Serialise PV3.GovernanceAction

instance Cborg.Serialise PV3.GovernanceActionId

instance Cborg.Serialise PV3.HotCommitteeCredential

instance Cborg.Serialise PV3.Lovelace

instance Cborg.Serialise PV3.MintValue

instance Cborg.Serialise PV3.OutputDatum

instance Cborg.Serialise PV3.POSIXTime

instance Cborg.Serialise PV3.ProposalProcedure

instance Cborg.Serialise PV3.ProtocolVersion

instance Cborg.Serialise PV3.PubKeyHash

instance Cborg.Serialise PV3.ScriptHash

instance Cborg.Serialise PV3.ScriptPurpose

instance Cborg.Serialise PV3.StakingCredential

instance Cborg.Serialise PV3.TokenName

instance Cborg.Serialise PV3.TxCert

instance Cborg.Serialise PV3.TxId

instance Cborg.Serialise PV3.TxInInfo

instance Cborg.Serialise PV3.TxInfo

instance Cborg.Serialise PV3.TxOut

instance Cborg.Serialise PV3.TxOutRef

instance Cborg.Serialise PV3.Value

instance Cborg.Serialise PV3.Vote

instance Cborg.Serialise PV3.Voter

instance (Cborg.Serialise k, Cborg.Serialise v) => Cborg.Serialise (PV3.Map k v)

instance Cborg.Serialise a => Cborg.Serialise (PV3.Extended a)

instance Cborg.Serialise a => Cborg.Serialise (PV3.Interval a)

instance Cborg.Serialise a => Cborg.Serialise (PV3.LowerBound a)

instance Cborg.Serialise a => Cborg.Serialise (PV3.UpperBound a)

instance Cborg.Serialise PV3.Rational

instance Cborg.Serialise VersionedTxInfo

instance EncCBOR VersionedTxInfo where
  encCBOR :: VersionedTxInfo -> Encoding
encCBOR = Encoding -> Encoding
fromPlainEncoding (Encoding -> Encoding)
-> (VersionedTxInfo -> Encoding) -> VersionedTxInfo -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionedTxInfo -> Encoding
forall a. Serialise a => a -> Encoding
Cborg.encode

instance DecCBOR VersionedTxInfo where
  decCBOR :: forall s. Decoder s VersionedTxInfo
decCBOR = Decoder s VersionedTxInfo -> Decoder s VersionedTxInfo
forall s a. Decoder s a -> Decoder s a
fromPlainDecoder Decoder s VersionedTxInfo
forall s. Decoder s VersionedTxInfo
forall a s. Serialise a => Decoder s a
Cborg.decode

instance
  ( Era era
  , EncCBOR (UTxO era)
  , EncCBOR (Core.Tx TopTx era)
  ) =>
  EncCBOR (TranslationInstance era)
  where
  encCBOR :: TranslationInstance era -> Encoding
encCBOR (TranslationInstance ProtVer
pp SupportedLanguage era
l UTxO era
u Tx TopTx era
tx VersionedTxInfo
r) =
    Encode (Closed Dense) (TranslationInstance era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode (Closed Dense) (TranslationInstance era) -> Encoding)
-> Encode (Closed Dense) (TranslationInstance era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (ProtVer
 -> SupportedLanguage era
 -> UTxO era
 -> Tx TopTx era
 -> VersionedTxInfo
 -> TranslationInstance era)
-> Encode
     (Closed Dense)
     (ProtVer
      -> SupportedLanguage era
      -> UTxO era
      -> Tx TopTx era
      -> VersionedTxInfo
      -> TranslationInstance era)
forall t. t -> Encode (Closed Dense) t
Rec ProtVer
-> SupportedLanguage era
-> UTxO era
-> Tx TopTx era
-> VersionedTxInfo
-> TranslationInstance era
forall era.
ProtVer
-> SupportedLanguage era
-> UTxO era
-> Tx TopTx era
-> VersionedTxInfo
-> TranslationInstance era
TranslationInstance
        Encode
  (Closed Dense)
  (ProtVer
   -> SupportedLanguage era
   -> UTxO era
   -> Tx TopTx era
   -> VersionedTxInfo
   -> TranslationInstance era)
-> Encode (Closed Dense) ProtVer
-> Encode
     (Closed Dense)
     (SupportedLanguage era
      -> UTxO era
      -> Tx TopTx era
      -> VersionedTxInfo
      -> TranslationInstance era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> ProtVer -> Encode (Closed Dense) ProtVer
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To ProtVer
pp
        Encode
  (Closed Dense)
  (SupportedLanguage era
   -> UTxO era
   -> Tx TopTx era
   -> VersionedTxInfo
   -> TranslationInstance era)
-> Encode (Closed Dense) (SupportedLanguage era)
-> Encode
     (Closed Dense)
     (UTxO era
      -> Tx TopTx era -> VersionedTxInfo -> TranslationInstance era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> SupportedLanguage era
-> Encode (Closed Dense) (SupportedLanguage era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To SupportedLanguage era
l
        Encode
  (Closed Dense)
  (UTxO era
   -> Tx TopTx era -> VersionedTxInfo -> TranslationInstance era)
-> Encode (Closed Dense) (UTxO era)
-> Encode
     (Closed Dense)
     (Tx TopTx era -> VersionedTxInfo -> TranslationInstance era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> UTxO era -> Encode (Closed Dense) (UTxO era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To UTxO era
u
        Encode
  (Closed Dense)
  (Tx TopTx era -> VersionedTxInfo -> TranslationInstance era)
-> Encode (Closed Dense) (Tx TopTx era)
-> Encode
     (Closed Dense) (VersionedTxInfo -> TranslationInstance era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Tx TopTx era -> Encode (Closed Dense) (Tx TopTx era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Tx TopTx era
tx
        Encode (Closed Dense) (VersionedTxInfo -> TranslationInstance era)
-> Encode (Closed Dense) VersionedTxInfo
-> Encode (Closed Dense) (TranslationInstance era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> VersionedTxInfo -> Encode (Closed Dense) VersionedTxInfo
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To VersionedTxInfo
r

instance
  ( DecCBOR (PParams era)
  , DecCBOR (UTxO era)
  , DecCBOR (Core.Tx TopTx era)
  , EraPlutusContext era
  ) =>
  DecCBOR (TranslationInstance era)
  where
  decCBOR :: forall s. Decoder s (TranslationInstance era)
decCBOR =
    Decode (Closed Dense) (TranslationInstance era)
-> Decoder s (TranslationInstance era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) (TranslationInstance era)
 -> Decoder s (TranslationInstance era))
-> Decode (Closed Dense) (TranslationInstance era)
-> Decoder s (TranslationInstance era)
forall a b. (a -> b) -> a -> b
$
      (ProtVer
 -> SupportedLanguage era
 -> UTxO era
 -> Tx TopTx era
 -> VersionedTxInfo
 -> TranslationInstance era)
-> Decode
     (Closed Dense)
     (ProtVer
      -> SupportedLanguage era
      -> UTxO era
      -> Tx TopTx era
      -> VersionedTxInfo
      -> TranslationInstance era)
forall t. t -> Decode (Closed Dense) t
RecD ProtVer
-> SupportedLanguage era
-> UTxO era
-> Tx TopTx era
-> VersionedTxInfo
-> TranslationInstance era
forall era.
ProtVer
-> SupportedLanguage era
-> UTxO era
-> Tx TopTx era
-> VersionedTxInfo
-> TranslationInstance era
TranslationInstance
        Decode
  (Closed Dense)
  (ProtVer
   -> SupportedLanguage era
   -> UTxO era
   -> Tx TopTx era
   -> VersionedTxInfo
   -> TranslationInstance era)
-> Decode (Closed (ZonkAny 4)) ProtVer
-> Decode
     (Closed Dense)
     (SupportedLanguage era
      -> UTxO era
      -> Tx TopTx era
      -> VersionedTxInfo
      -> TranslationInstance era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 4)) ProtVer
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  (Closed Dense)
  (SupportedLanguage era
   -> UTxO era
   -> Tx TopTx era
   -> VersionedTxInfo
   -> TranslationInstance era)
-> Decode (Closed (ZonkAny 3)) (SupportedLanguage era)
-> Decode
     (Closed Dense)
     (UTxO era
      -> Tx TopTx era -> VersionedTxInfo -> TranslationInstance era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 3)) (SupportedLanguage era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  (Closed Dense)
  (UTxO era
   -> Tx TopTx era -> VersionedTxInfo -> TranslationInstance era)
-> Decode (Closed (ZonkAny 2)) (UTxO era)
-> Decode
     (Closed Dense)
     (Tx TopTx era -> VersionedTxInfo -> TranslationInstance era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 2)) (UTxO era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  (Closed Dense)
  (Tx TopTx era -> VersionedTxInfo -> TranslationInstance era)
-> Decode (Closed (ZonkAny 1)) (Tx TopTx era)
-> Decode
     (Closed Dense) (VersionedTxInfo -> TranslationInstance era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 1)) (Tx TopTx era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode (Closed Dense) (VersionedTxInfo -> TranslationInstance era)
-> Decode (Closed (ZonkAny 0)) VersionedTxInfo
-> Decode (Closed Dense) (TranslationInstance era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 0)) VersionedTxInfo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From

deserializeTranslationInstances ::
  forall era.
  ( DecCBOR (PParams era)
  , DecCBOR (UTxO era)
  , DecCBOR (Core.Tx TopTx era)
  , EraPlutusContext era
  ) =>
  BSL.ByteString ->
  Either DecoderError [TranslationInstance era]
deserializeTranslationInstances :: forall era.
(DecCBOR (PParams era), DecCBOR (UTxO era), DecCBOR (Tx TopTx era),
 EraPlutusContext era) =>
ByteString -> Either DecoderError [TranslationInstance era]
deserializeTranslationInstances = Version
-> ByteString -> Either DecoderError [TranslationInstance era]
forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull (forall era. Era era => Version
eraProtVerHigh @era)