{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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.BaseTypes (ProtVer)
import Cardano.Ledger.Binary (
  Annotator,
  DecCBOR (..),
  DecoderError,
  EncCBOR (..),
  decodeFullAnnotator,
  decodeList,
  fromPlainDecoder,
  fromPlainEncoding,
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<*!),
 )
import Cardano.Ledger.Core as Core
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.UTxO (UTxO (..))
import qualified Codec.Serialise as Cborg (Serialise (..))
import qualified Data.ByteString.Lazy as BSL
import Data.Typeable (Typeable)
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
  deriving (Int -> VersionedTxInfo -> ShowS
[VersionedTxInfo] -> ShowS
VersionedTxInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionedTxInfo] -> ShowS
$cshowList :: [VersionedTxInfo] -> ShowS
show :: VersionedTxInfo -> String
$cshow :: VersionedTxInfo -> String
showsPrec :: Int -> VersionedTxInfo -> ShowS
$cshowsPrec :: Int -> VersionedTxInfo -> ShowS
Show, VersionedTxInfo -> VersionedTxInfo -> Closure
forall a. (a -> a -> Closure) -> (a -> a -> Closure) -> Eq a
/= :: VersionedTxInfo -> VersionedTxInfo -> Closure
$c/= :: VersionedTxInfo -> VersionedTxInfo -> Closure
== :: VersionedTxInfo -> VersionedTxInfo -> Closure
$c== :: VersionedTxInfo -> VersionedTxInfo -> Closure
Eq, 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
$cto :: forall x. Rep VersionedTxInfo x -> VersionedTxInfo
$cfrom :: forall x. VersionedTxInfo -> Rep VersionedTxInfo x
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 -> Language
tiLanguage :: Language
  , forall era. TranslationInstance era -> UTxO era
tiUtxo :: UTxO era
  , forall era. TranslationInstance era -> Tx era
tiTx :: Core.Tx era
  , forall era. TranslationInstance era -> VersionedTxInfo
tiResult :: VersionedTxInfo
  }
  deriving (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
$cto :: forall era x.
Rep (TranslationInstance era) x -> TranslationInstance era
$cfrom :: forall era x.
TranslationInstance era -> Rep (TranslationInstance era) x
Generic)

deriving instance
  (Era era, Eq (PParams era), Eq (UTxO era), Eq (Core.Tx era)) => Eq (TranslationInstance era)
deriving instance
  (Era era, Show (PParams era), Show (UTxO era), Show (Core.Tx 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.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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialise a => a -> Encoding
Cborg.encode

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

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

instance
  ( Typeable era
  , DecCBOR (PParams era)
  , DecCBOR (UTxO era)
  , DecCBOR (Annotator (Core.Tx era))
  ) =>
  DecCBOR (Annotator (TranslationInstance era))
  where
  decCBOR :: forall s. Decoder s (Annotator (TranslationInstance era))
decCBOR =
    forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
      forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann (forall t. t -> Decode ('Closed 'Dense) t
RecD forall era.
ProtVer
-> Language
-> UTxO era
-> Tx era
-> VersionedTxInfo
-> TranslationInstance era
TranslationInstance)
        forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann forall t (w :: Wrapped). DecCBOR t => Decode w t
From

deserializeTranslationInstances ::
  forall era.
  ( Era era
  , DecCBOR (PParams era)
  , DecCBOR (UTxO era)
  , DecCBOR (Annotator (Core.Tx era))
  ) =>
  BSL.ByteString ->
  Either DecoderError [TranslationInstance era]
deserializeTranslationInstances :: forall era.
(Era era, DecCBOR (PParams era), DecCBOR (UTxO era),
 DecCBOR (Annotator (Tx era))) =>
ByteString -> Either DecoderError [TranslationInstance era]
deserializeTranslationInstances = forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator (forall era. Era era => Version
eraProtVerHigh @era) Text
"Translations" forall {s}. Decoder s (Annotator [TranslationInstance era])
decList
  where
    decList :: Decoder s (Annotator [TranslationInstance era])
decList = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s [a]
decodeList forall a s. DecCBOR a => Decoder s a
decCBOR