{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Ledger.Alonzo.TxInfo where

-- =============================================

import Cardano.Binary (FromCBOR (..), ToCBOR (..), decodeFull')
import Cardano.Crypto.Hash.Class (Hash, hashToBytes)
import Cardano.Ledger.Address (Addr (..), RewardAcnt (..))
import Cardano.Ledger.Alonzo.Data (Data (..), Datum (..), getPlutusData)
import Cardano.Ledger.Alonzo.Language (Language (..))
import Cardano.Ledger.Alonzo.Scripts
  ( ExUnits (..),
    Script (..),
    decodeCostModel,
    getEvaluationContext,
  )
import Cardano.Ledger.Alonzo.Tx
  ( CostModel,
    DataHash,
    ScriptPurpose (..),
    ValidatedTx,
    txdats',
  )
import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr, TxWitness, unTxDats)
import Cardano.Ledger.BaseTypes (ProtVer (..), StrictMaybe (..), TxIx, certIxToInt, txIxToInt)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core as Core (PParams, Tx, TxBody, TxOut, Value)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Credential
  ( Credential (KeyHashObj, ScriptHashObj),
    Ptr (..),
    StakeReference (..),
  )
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Era (Era (..), getTxOutBootstrapAddress)
import Cardano.Ledger.Hashes (EraIndependentData)
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (Witness), hashKey)
import qualified Cardano.Ledger.Mary.Value as Mary (AssetName (..), PolicyID (..), Value (..))
import Cardano.Ledger.SafeHash (SafeHash, extractHash, hashAnnotated)
import Cardano.Ledger.Serialization (Sized (sizedValue))
import qualified Cardano.Ledger.Shelley.HardForks as HardForks
import Cardano.Ledger.Shelley.Scripts (ScriptHash (..))
import Cardano.Ledger.Shelley.TxBody
  ( DCert (..),
    DelegCert (..),
    Delegation (..),
    PoolCert (..),
    PoolParams (..),
    Wdrl (..),
    WitVKey (..),
  )
import Cardano.Ledger.Shelley.UTxO (UTxO (..))
import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..))
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import Cardano.Ledger.Val (Val (..))
import Cardano.Slotting.EpochInfo (EpochInfo, epochInfoSlotToUTCTime)
import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..))
import Cardano.Slotting.Time (SystemStart)
import qualified Codec.Serialise as Cborg (Serialise (..))
import Control.Arrow (left)
import Control.DeepSeq (deepseq)
import Data.ByteString as BS (ByteString, length)
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Short as SBS (ShortByteString, fromShort)
import qualified Data.ByteString.UTF8 as BSU
import Data.Coders
  ( Decode (..),
    Encode (..),
    decode,
    decodeList,
    encode,
    (!>),
    (<!),
  )
import Data.Fixed (HasResolution (resolution))
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe)
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text, pack)
import Data.Time.Clock (nominalDiffTimeToSeconds)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import Data.Typeable (Proxy (..), Typeable)
import GHC.Generics (Generic)
import GHC.Records (HasField (..))
import NoThunks.Class (NoThunks)
import Numeric.Natural (Natural)
import qualified Plutus.V1.Ledger.Api as PV1
import Plutus.V1.Ledger.Contexts ()
import qualified Plutus.V2.Ledger.Api as PV2
import Prettyprinter (Pretty (..))

-- =========================================================
-- Translate Hashes, Credentials, Certificates etc.

-- | A transaction output can be translated because it is a newly created output,
-- or because it is the output which is connected to a transaction input being spent.
data TxOutSource crypto
  = TxOutFromInput !(TxIn crypto)
  | TxOutFromOutput !TxIx
  deriving (TxOutSource crypto -> TxOutSource crypto -> Bool
(TxOutSource crypto -> TxOutSource crypto -> Bool)
-> (TxOutSource crypto -> TxOutSource crypto -> Bool)
-> Eq (TxOutSource crypto)
forall crypto. TxOutSource crypto -> TxOutSource crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxOutSource crypto -> TxOutSource crypto -> Bool
$c/= :: forall crypto. TxOutSource crypto -> TxOutSource crypto -> Bool
== :: TxOutSource crypto -> TxOutSource crypto -> Bool
$c== :: forall crypto. TxOutSource crypto -> TxOutSource crypto -> Bool
Eq, Int -> TxOutSource crypto -> ShowS
[TxOutSource crypto] -> ShowS
TxOutSource crypto -> String
(Int -> TxOutSource crypto -> ShowS)
-> (TxOutSource crypto -> String)
-> ([TxOutSource crypto] -> ShowS)
-> Show (TxOutSource crypto)
forall crypto. Int -> TxOutSource crypto -> ShowS
forall crypto. [TxOutSource crypto] -> ShowS
forall crypto. TxOutSource crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxOutSource crypto] -> ShowS
$cshowList :: forall crypto. [TxOutSource crypto] -> ShowS
show :: TxOutSource crypto -> String
$cshow :: forall crypto. TxOutSource crypto -> String
showsPrec :: Int -> TxOutSource crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> TxOutSource crypto -> ShowS
Show, (forall x. TxOutSource crypto -> Rep (TxOutSource crypto) x)
-> (forall x. Rep (TxOutSource crypto) x -> TxOutSource crypto)
-> Generic (TxOutSource crypto)
forall x. Rep (TxOutSource crypto) x -> TxOutSource crypto
forall x. TxOutSource crypto -> Rep (TxOutSource crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (TxOutSource crypto) x -> TxOutSource crypto
forall crypto x. TxOutSource crypto -> Rep (TxOutSource crypto) x
$cto :: forall crypto x. Rep (TxOutSource crypto) x -> TxOutSource crypto
$cfrom :: forall crypto x. TxOutSource crypto -> Rep (TxOutSource crypto) x
Generic, Context -> TxOutSource crypto -> IO (Maybe ThunkInfo)
Proxy (TxOutSource crypto) -> String
(Context -> TxOutSource crypto -> IO (Maybe ThunkInfo))
-> (Context -> TxOutSource crypto -> IO (Maybe ThunkInfo))
-> (Proxy (TxOutSource crypto) -> String)
-> NoThunks (TxOutSource crypto)
forall crypto.
Context -> TxOutSource crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (TxOutSource crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (TxOutSource crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (TxOutSource crypto) -> String
wNoThunks :: Context -> TxOutSource crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Context -> TxOutSource crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxOutSource crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto.
Context -> TxOutSource crypto -> IO (Maybe ThunkInfo)
NoThunks)

instance CC.Crypto crypto => ToCBOR (TxOutSource crypto) where
  toCBOR :: TxOutSource crypto -> Encoding
toCBOR = \case
    TxOutFromInput TxIn crypto
txIn -> Encode 'Open (TxOutSource crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (TxOutSource crypto) -> Encoding)
-> Encode 'Open (TxOutSource crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$ (TxIn crypto -> TxOutSource crypto)
-> Word -> Encode 'Open (TxIn crypto -> TxOutSource crypto)
forall t. t -> Word -> Encode 'Open t
Sum TxIn crypto -> TxOutSource crypto
forall crypto. TxIn crypto -> TxOutSource crypto
TxOutFromInput Word
0 Encode 'Open (TxIn crypto -> TxOutSource crypto)
-> Encode ('Closed 'Dense) (TxIn crypto)
-> Encode 'Open (TxOutSource crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxIn crypto -> Encode ('Closed 'Dense) (TxIn crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To TxIn crypto
txIn
    TxOutFromOutput TxIx
txIx -> Encode 'Open (TxOutSource Any) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (TxOutSource Any) -> Encoding)
-> Encode 'Open (TxOutSource Any) -> Encoding
forall a b. (a -> b) -> a -> b
$ (TxIx -> TxOutSource Any)
-> Word -> Encode 'Open (TxIx -> TxOutSource Any)
forall t. t -> Word -> Encode 'Open t
Sum TxIx -> TxOutSource Any
forall crypto. TxIx -> TxOutSource crypto
TxOutFromOutput Word
1 Encode 'Open (TxIx -> TxOutSource Any)
-> Encode ('Closed 'Dense) TxIx -> Encode 'Open (TxOutSource Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxIx -> Encode ('Closed 'Dense) TxIx
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To TxIx
txIx

instance CC.Crypto crypto => FromCBOR (TxOutSource crypto) where
  fromCBOR :: Decoder s (TxOutSource crypto)
fromCBOR = Decode ('Closed 'Dense) (TxOutSource crypto)
-> Decoder s (TxOutSource crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (String
-> (Word -> Decode 'Open (TxOutSource crypto))
-> Decode ('Closed 'Dense) (TxOutSource crypto)
forall t.
String -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands String
"TxOutSource" Word -> Decode 'Open (TxOutSource crypto)
forall crypto.
Crypto crypto =>
Word -> Decode 'Open (TxOutSource crypto)
dec)
    where
      dec :: Word -> Decode 'Open (TxOutSource crypto)
dec Word
0 = (TxIn crypto -> TxOutSource crypto)
-> Decode 'Open (TxIn crypto -> TxOutSource crypto)
forall t. t -> Decode 'Open t
SumD TxIn crypto -> TxOutSource crypto
forall crypto. TxIn crypto -> TxOutSource crypto
TxOutFromInput Decode 'Open (TxIn crypto -> TxOutSource crypto)
-> Decode ('Closed Any) (TxIn crypto)
-> Decode 'Open (TxOutSource crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (TxIn crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
1 = (TxIx -> TxOutSource crypto)
-> Decode 'Open (TxIx -> TxOutSource crypto)
forall t. t -> Decode 'Open t
SumD TxIx -> TxOutSource crypto
forall crypto. TxIx -> TxOutSource crypto
TxOutFromOutput Decode 'Open (TxIx -> TxOutSource crypto)
-> Decode ('Closed Any) TxIx -> Decode 'Open (TxOutSource crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) TxIx
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
n = Word -> Decode 'Open (TxOutSource crypto)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

data TranslationError crypto
  = ByronTxOutInContext !(TxOutSource crypto)
  | TranslationLogicMissingInput !(TxIn crypto)
  | RdmrPtrPointsToNothing !RdmrPtr
  | LanguageNotSupported !Language
  | InlineDatumsNotSupported !(TxOutSource crypto)
  | ReferenceScriptsNotSupported !(TxOutSource crypto)
  | ReferenceInputsNotSupported !(Set (TxIn crypto))
  | TimeTranslationPastHorizon !Text
  deriving (TranslationError crypto -> TranslationError crypto -> Bool
(TranslationError crypto -> TranslationError crypto -> Bool)
-> (TranslationError crypto -> TranslationError crypto -> Bool)
-> Eq (TranslationError crypto)
forall crypto.
TranslationError crypto -> TranslationError crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TranslationError crypto -> TranslationError crypto -> Bool
$c/= :: forall crypto.
TranslationError crypto -> TranslationError crypto -> Bool
== :: TranslationError crypto -> TranslationError crypto -> Bool
$c== :: forall crypto.
TranslationError crypto -> TranslationError crypto -> Bool
Eq, Int -> TranslationError crypto -> ShowS
[TranslationError crypto] -> ShowS
TranslationError crypto -> String
(Int -> TranslationError crypto -> ShowS)
-> (TranslationError crypto -> String)
-> ([TranslationError crypto] -> ShowS)
-> Show (TranslationError crypto)
forall crypto. Int -> TranslationError crypto -> ShowS
forall crypto. [TranslationError crypto] -> ShowS
forall crypto. TranslationError crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TranslationError crypto] -> ShowS
$cshowList :: forall crypto. [TranslationError crypto] -> ShowS
show :: TranslationError crypto -> String
$cshow :: forall crypto. TranslationError crypto -> String
showsPrec :: Int -> TranslationError crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> TranslationError crypto -> ShowS
Show, (forall x.
 TranslationError crypto -> Rep (TranslationError crypto) x)
-> (forall x.
    Rep (TranslationError crypto) x -> TranslationError crypto)
-> Generic (TranslationError crypto)
forall x.
Rep (TranslationError crypto) x -> TranslationError crypto
forall x.
TranslationError crypto -> Rep (TranslationError crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (TranslationError crypto) x -> TranslationError crypto
forall crypto x.
TranslationError crypto -> Rep (TranslationError crypto) x
$cto :: forall crypto x.
Rep (TranslationError crypto) x -> TranslationError crypto
$cfrom :: forall crypto x.
TranslationError crypto -> Rep (TranslationError crypto) x
Generic, Context -> TranslationError crypto -> IO (Maybe ThunkInfo)
Proxy (TranslationError crypto) -> String
(Context -> TranslationError crypto -> IO (Maybe ThunkInfo))
-> (Context -> TranslationError crypto -> IO (Maybe ThunkInfo))
-> (Proxy (TranslationError crypto) -> String)
-> NoThunks (TranslationError crypto)
forall crypto.
Context -> TranslationError crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (TranslationError crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (TranslationError crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (TranslationError crypto) -> String
wNoThunks :: Context -> TranslationError crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Context -> TranslationError crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> TranslationError crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto.
Context -> TranslationError crypto -> IO (Maybe ThunkInfo)
NoThunks)

instance CC.Crypto crypto => ToCBOR (TranslationError crypto) where
  toCBOR :: TranslationError crypto -> Encoding
toCBOR = \case
    ByronTxOutInContext TxOutSource crypto
txOutSource ->
      Encode 'Open (TranslationError crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (TranslationError crypto) -> Encoding)
-> Encode 'Open (TranslationError crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$ (TxOutSource crypto -> TranslationError crypto)
-> Word
-> Encode 'Open (TxOutSource crypto -> TranslationError crypto)
forall t. t -> Word -> Encode 'Open t
Sum TxOutSource crypto -> TranslationError crypto
forall crypto. TxOutSource crypto -> TranslationError crypto
ByronTxOutInContext Word
0 Encode 'Open (TxOutSource crypto -> TranslationError crypto)
-> Encode ('Closed 'Dense) (TxOutSource crypto)
-> Encode 'Open (TranslationError crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxOutSource crypto -> Encode ('Closed 'Dense) (TxOutSource crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To TxOutSource crypto
txOutSource
    TranslationLogicMissingInput TxIn crypto
txIn ->
      Encode 'Open (TranslationError crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (TranslationError crypto) -> Encoding)
-> Encode 'Open (TranslationError crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$ (TxIn crypto -> TranslationError crypto)
-> Word -> Encode 'Open (TxIn crypto -> TranslationError crypto)
forall t. t -> Word -> Encode 'Open t
Sum TxIn crypto -> TranslationError crypto
forall crypto. TxIn crypto -> TranslationError crypto
TranslationLogicMissingInput Word
1 Encode 'Open (TxIn crypto -> TranslationError crypto)
-> Encode ('Closed 'Dense) (TxIn crypto)
-> Encode 'Open (TranslationError crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxIn crypto -> Encode ('Closed 'Dense) (TxIn crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To TxIn crypto
txIn
    RdmrPtrPointsToNothing RdmrPtr
ptr ->
      Encode 'Open (TranslationError Any) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (TranslationError Any) -> Encoding)
-> Encode 'Open (TranslationError Any) -> Encoding
forall a b. (a -> b) -> a -> b
$ (RdmrPtr -> TranslationError Any)
-> Word -> Encode 'Open (RdmrPtr -> TranslationError Any)
forall t. t -> Word -> Encode 'Open t
Sum RdmrPtr -> TranslationError Any
forall crypto. RdmrPtr -> TranslationError crypto
RdmrPtrPointsToNothing Word
2 Encode 'Open (RdmrPtr -> TranslationError Any)
-> Encode ('Closed 'Dense) RdmrPtr
-> Encode 'Open (TranslationError Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> RdmrPtr -> Encode ('Closed 'Dense) RdmrPtr
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To RdmrPtr
ptr
    LanguageNotSupported Language
lang ->
      Encode 'Open (TranslationError Any) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (TranslationError Any) -> Encoding)
-> Encode 'Open (TranslationError Any) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Language -> TranslationError Any)
-> Word -> Encode 'Open (Language -> TranslationError Any)
forall t. t -> Word -> Encode 'Open t
Sum Language -> TranslationError Any
forall crypto. Language -> TranslationError crypto
LanguageNotSupported Word
3 Encode 'Open (Language -> TranslationError Any)
-> Encode ('Closed 'Dense) Language
-> Encode 'Open (TranslationError Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Language -> Encode ('Closed 'Dense) Language
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Language
lang
    InlineDatumsNotSupported TxOutSource crypto
txOutSource ->
      Encode 'Open (TranslationError crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (TranslationError crypto) -> Encoding)
-> Encode 'Open (TranslationError crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$ (TxOutSource crypto -> TranslationError crypto)
-> Word
-> Encode 'Open (TxOutSource crypto -> TranslationError crypto)
forall t. t -> Word -> Encode 'Open t
Sum TxOutSource crypto -> TranslationError crypto
forall crypto. TxOutSource crypto -> TranslationError crypto
InlineDatumsNotSupported Word
4 Encode 'Open (TxOutSource crypto -> TranslationError crypto)
-> Encode ('Closed 'Dense) (TxOutSource crypto)
-> Encode 'Open (TranslationError crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxOutSource crypto -> Encode ('Closed 'Dense) (TxOutSource crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To TxOutSource crypto
txOutSource
    ReferenceScriptsNotSupported TxOutSource crypto
txOutSource ->
      Encode 'Open (TranslationError crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (TranslationError crypto) -> Encoding)
-> Encode 'Open (TranslationError crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$ (TxOutSource crypto -> TranslationError crypto)
-> Word
-> Encode 'Open (TxOutSource crypto -> TranslationError crypto)
forall t. t -> Word -> Encode 'Open t
Sum TxOutSource crypto -> TranslationError crypto
forall crypto. TxOutSource crypto -> TranslationError crypto
ReferenceScriptsNotSupported Word
5 Encode 'Open (TxOutSource crypto -> TranslationError crypto)
-> Encode ('Closed 'Dense) (TxOutSource crypto)
-> Encode 'Open (TranslationError crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxOutSource crypto -> Encode ('Closed 'Dense) (TxOutSource crypto)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To TxOutSource crypto
txOutSource
    ReferenceInputsNotSupported Set (TxIn crypto)
txIns ->
      Encode 'Open (TranslationError crypto) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (TranslationError crypto) -> Encoding)
-> Encode 'Open (TranslationError crypto) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Set (TxIn crypto) -> TranslationError crypto)
-> Word
-> Encode 'Open (Set (TxIn crypto) -> TranslationError crypto)
forall t. t -> Word -> Encode 'Open t
Sum Set (TxIn crypto) -> TranslationError crypto
forall crypto. Set (TxIn crypto) -> TranslationError crypto
ReferenceInputsNotSupported Word
6 Encode 'Open (Set (TxIn crypto) -> TranslationError crypto)
-> Encode ('Closed 'Dense) (Set (TxIn crypto))
-> Encode 'Open (TranslationError crypto)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Set (TxIn crypto) -> Encode ('Closed 'Dense) (Set (TxIn crypto))
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Set (TxIn crypto)
txIns
    TimeTranslationPastHorizon Text
err ->
      Encode 'Open (TranslationError Any) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (TranslationError Any) -> Encoding)
-> Encode 'Open (TranslationError Any) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Text -> TranslationError Any)
-> Word -> Encode 'Open (Text -> TranslationError Any)
forall t. t -> Word -> Encode 'Open t
Sum Text -> TranslationError Any
forall crypto. Text -> TranslationError crypto
TimeTranslationPastHorizon Word
7 Encode 'Open (Text -> TranslationError Any)
-> Encode ('Closed 'Dense) Text
-> Encode 'Open (TranslationError Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Text -> Encode ('Closed 'Dense) Text
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Text
err

instance CC.Crypto crypto => FromCBOR (TranslationError crypto) where
  fromCBOR :: Decoder s (TranslationError crypto)
fromCBOR = Decode ('Closed 'Dense) (TranslationError crypto)
-> Decoder s (TranslationError crypto)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (String
-> (Word -> Decode 'Open (TranslationError crypto))
-> Decode ('Closed 'Dense) (TranslationError crypto)
forall t.
String -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands String
"TranslationError" Word -> Decode 'Open (TranslationError crypto)
forall crypto.
Crypto crypto =>
Word -> Decode 'Open (TranslationError crypto)
dec)
    where
      dec :: Word -> Decode 'Open (TranslationError crypto)
dec Word
0 = (TxOutSource crypto -> TranslationError crypto)
-> Decode 'Open (TxOutSource crypto -> TranslationError crypto)
forall t. t -> Decode 'Open t
SumD TxOutSource crypto -> TranslationError crypto
forall crypto. TxOutSource crypto -> TranslationError crypto
ByronTxOutInContext Decode 'Open (TxOutSource crypto -> TranslationError crypto)
-> Decode ('Closed Any) (TxOutSource crypto)
-> Decode 'Open (TranslationError crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (TxOutSource crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
1 = (TxIn crypto -> TranslationError crypto)
-> Decode 'Open (TxIn crypto -> TranslationError crypto)
forall t. t -> Decode 'Open t
SumD TxIn crypto -> TranslationError crypto
forall crypto. TxIn crypto -> TranslationError crypto
TranslationLogicMissingInput Decode 'Open (TxIn crypto -> TranslationError crypto)
-> Decode ('Closed Any) (TxIn crypto)
-> Decode 'Open (TranslationError crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (TxIn crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
2 = (RdmrPtr -> TranslationError crypto)
-> Decode 'Open (RdmrPtr -> TranslationError crypto)
forall t. t -> Decode 'Open t
SumD RdmrPtr -> TranslationError crypto
forall crypto. RdmrPtr -> TranslationError crypto
RdmrPtrPointsToNothing Decode 'Open (RdmrPtr -> TranslationError crypto)
-> Decode ('Closed Any) RdmrPtr
-> Decode 'Open (TranslationError crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) RdmrPtr
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
3 = (Language -> TranslationError crypto)
-> Decode 'Open (Language -> TranslationError crypto)
forall t. t -> Decode 'Open t
SumD Language -> TranslationError crypto
forall crypto. Language -> TranslationError crypto
LanguageNotSupported Decode 'Open (Language -> TranslationError crypto)
-> Decode ('Closed Any) Language
-> Decode 'Open (TranslationError crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Language
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
4 = (TxOutSource crypto -> TranslationError crypto)
-> Decode 'Open (TxOutSource crypto -> TranslationError crypto)
forall t. t -> Decode 'Open t
SumD TxOutSource crypto -> TranslationError crypto
forall crypto. TxOutSource crypto -> TranslationError crypto
InlineDatumsNotSupported Decode 'Open (TxOutSource crypto -> TranslationError crypto)
-> Decode ('Closed Any) (TxOutSource crypto)
-> Decode 'Open (TranslationError crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (TxOutSource crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
5 = (TxOutSource crypto -> TranslationError crypto)
-> Decode 'Open (TxOutSource crypto -> TranslationError crypto)
forall t. t -> Decode 'Open t
SumD TxOutSource crypto -> TranslationError crypto
forall crypto. TxOutSource crypto -> TranslationError crypto
ReferenceScriptsNotSupported Decode 'Open (TxOutSource crypto -> TranslationError crypto)
-> Decode ('Closed Any) (TxOutSource crypto)
-> Decode 'Open (TranslationError crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (TxOutSource crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
6 = (Set (TxIn crypto) -> TranslationError crypto)
-> Decode 'Open (Set (TxIn crypto) -> TranslationError crypto)
forall t. t -> Decode 'Open t
SumD Set (TxIn crypto) -> TranslationError crypto
forall crypto. Set (TxIn crypto) -> TranslationError crypto
ReferenceInputsNotSupported Decode 'Open (Set (TxIn crypto) -> TranslationError crypto)
-> Decode ('Closed Any) (Set (TxIn crypto))
-> Decode 'Open (TranslationError crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Set (TxIn crypto))
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
7 = (Text -> TranslationError crypto)
-> Decode 'Open (Text -> TranslationError crypto)
forall t. t -> Decode 'Open t
SumD Text -> TranslationError crypto
forall crypto. Text -> TranslationError crypto
TimeTranslationPastHorizon Decode 'Open (Text -> TranslationError crypto)
-> Decode ('Closed Any) Text
-> Decode 'Open (TranslationError crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Text
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
n = Word -> Decode 'Open (TranslationError crypto)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

transDataHash :: StrictMaybe (DataHash c) -> Maybe PV1.DatumHash
transDataHash :: StrictMaybe (DataHash c) -> Maybe DatumHash
transDataHash (SJust DataHash c
safe) = DatumHash -> Maybe DatumHash
forall a. a -> Maybe a
Just (DataHash c -> DatumHash
forall c. DataHash c -> DatumHash
transDataHash' DataHash c
safe)
transDataHash StrictMaybe (DataHash c)
SNothing = Maybe DatumHash
forall a. Maybe a
Nothing

transDataHash' :: DataHash c -> PV1.DatumHash
transDataHash' :: DataHash c -> DatumHash
transDataHash' DataHash c
safe = BuiltinByteString -> DatumHash
PV1.DatumHash (DataHash c -> BuiltinByteString
forall c i. SafeHash c i -> BuiltinByteString
transSafeHash DataHash c
safe)

transKeyHash :: KeyHash d c -> PV1.PubKeyHash
transKeyHash :: KeyHash d c -> PubKeyHash
transKeyHash (KeyHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
h) = BuiltinByteString -> PubKeyHash
PV1.PubKeyHash (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PV1.toBuiltin (Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c)) -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
h))

transScriptHash :: ScriptHash c -> PV1.ValidatorHash
transScriptHash :: ScriptHash c -> ValidatorHash
transScriptHash (ScriptHash Hash (ADDRHASH c) EraIndependentScript
h) = BuiltinByteString -> ValidatorHash
PV1.ValidatorHash (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PV1.toBuiltin (Hash (ADDRHASH c) EraIndependentScript -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash (ADDRHASH c) EraIndependentScript
h))

transSafeHash :: SafeHash c i -> PV1.BuiltinByteString
transSafeHash :: SafeHash c i -> BuiltinByteString
transSafeHash = ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PV1.toBuiltin (ByteString -> BuiltinByteString)
-> (SafeHash c i -> ByteString)
-> SafeHash c i
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (HASH c) i -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash (HASH c) i -> ByteString)
-> (SafeHash c i -> Hash (HASH c) i) -> SafeHash c i -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHash c i -> Hash (HASH c) i
forall crypto i. SafeHash crypto i -> Hash (HASH crypto) i
extractHash

transHash :: Hash h a -> BS.ByteString
transHash :: Hash h a -> ByteString
transHash = Hash h a -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes

txInfoId :: TxId crypto -> PV1.TxId
txInfoId :: TxId crypto -> TxId
txInfoId (TxId SafeHash crypto EraIndependentTxBody
safe) = BuiltinByteString -> TxId
PV1.TxId (SafeHash crypto EraIndependentTxBody -> BuiltinByteString
forall c i. SafeHash c i -> BuiltinByteString
transSafeHash SafeHash crypto EraIndependentTxBody
safe)

transStakeCred :: Credential keyrole crypto -> PV1.Credential
transStakeCred :: Credential keyrole crypto -> Credential
transStakeCred (ScriptHashObj (ScriptHash Hash (ADDRHASH crypto) EraIndependentScript
kh)) =
  ValidatorHash -> Credential
PV1.ScriptCredential (BuiltinByteString -> ValidatorHash
PV1.ValidatorHash (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PV1.toBuiltin (Hash (ADDRHASH crypto) EraIndependentScript -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash (ADDRHASH crypto) EraIndependentScript
kh)))
transStakeCred (KeyHashObj (KeyHash Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
kh)) =
  PubKeyHash -> Credential
PV1.PubKeyCredential (BuiltinByteString -> PubKeyHash
PV1.PubKeyHash (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PV1.toBuiltin (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)) -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
kh)))

transStakeReference :: StakeReference crypto -> Maybe PV1.StakingCredential
transStakeReference :: StakeReference crypto -> Maybe StakingCredential
transStakeReference (StakeRefBase StakeCredential crypto
cred) = StakingCredential -> Maybe StakingCredential
forall a. a -> Maybe a
Just (Credential -> StakingCredential
PV1.StakingHash (StakeCredential crypto -> Credential
forall (keyrole :: KeyRole) crypto.
Credential keyrole crypto -> Credential
transStakeCred StakeCredential crypto
cred))
transStakeReference (StakeRefPtr (Ptr (SlotNo Word64
slot) TxIx
txIx CertIx
certIx)) =
  let !txIxInteger :: Integer
txIxInteger = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (TxIx -> Int
txIxToInt TxIx
txIx)
      !certIxInteger :: Integer
certIxInteger = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (CertIx -> Int
certIxToInt CertIx
certIx)
   in StakingCredential -> Maybe StakingCredential
forall a. a -> Maybe a
Just (Integer -> Integer -> Integer -> StakingCredential
PV1.StakingPtr (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slot) Integer
txIxInteger Integer
certIxInteger)
transStakeReference StakeReference crypto
StakeRefNull = Maybe StakingCredential
forall a. Maybe a
Nothing

transCred :: Credential keyrole crypto -> PV1.Credential
transCred :: Credential keyrole crypto -> Credential
transCred (KeyHashObj (KeyHash Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
kh)) =
  PubKeyHash -> Credential
PV1.PubKeyCredential (BuiltinByteString -> PubKeyHash
PV1.PubKeyHash (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PV1.toBuiltin (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)) -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
kh)))
transCred (ScriptHashObj (ScriptHash Hash (ADDRHASH crypto) EraIndependentScript
kh)) =
  ValidatorHash -> Credential
PV1.ScriptCredential (BuiltinByteString -> ValidatorHash
PV1.ValidatorHash (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PV1.toBuiltin (Hash (ADDRHASH crypto) EraIndependentScript -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash (ADDRHASH crypto) EraIndependentScript
kh)))

transAddr :: Addr crypto -> Maybe PV1.Address
transAddr :: Addr crypto -> Maybe Address
transAddr (Addr Network
_net PaymentCredential crypto
object StakeReference crypto
stake) = Address -> Maybe Address
forall a. a -> Maybe a
Just (Credential -> Maybe StakingCredential -> Address
PV1.Address (PaymentCredential crypto -> Credential
forall (keyrole :: KeyRole) crypto.
Credential keyrole crypto -> Credential
transCred PaymentCredential crypto
object) (StakeReference crypto -> Maybe StakingCredential
forall crypto. StakeReference crypto -> Maybe StakingCredential
transStakeReference StakeReference crypto
stake))
transAddr (AddrBootstrap BootstrapAddress crypto
_bootaddr) = Maybe Address
forall a. Maybe a
Nothing

transTxOutAddr :: Era era => TxOut era -> Maybe PV1.Address
transTxOutAddr :: TxOut era -> Maybe Address
transTxOutAddr TxOut era
txOut = do
  -- filter out Byron addresses without uncompacting them
  case TxOut era -> Maybe (BootstrapAddress (Crypto era))
forall era.
Era era =>
TxOut era -> Maybe (BootstrapAddress (Crypto era))
getTxOutBootstrapAddress TxOut era
txOut of
    Just BootstrapAddress (Crypto era)
_ -> Maybe Address
forall a. Maybe a
Nothing
    -- The presence of a Byron address is caught above in the Just case
    Maybe (BootstrapAddress (Crypto era))
Nothing -> Addr (Crypto era) -> Maybe Address
forall crypto. Addr crypto -> Maybe Address
transAddr (TxOut era -> Addr (Crypto era)
forall e. Era e => TxOut e -> Addr (Crypto e)
getTxOutAddr TxOut era
txOut)

slotToPOSIXTime ::
  HasField "_protocolVersion" (PParams era) ProtVer =>
  Core.PParams era ->
  EpochInfo (Either Text) ->
  SystemStart ->
  SlotNo ->
  Either Text PV1.POSIXTime
slotToPOSIXTime :: PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> SlotNo
-> Either Text POSIXTime
slotToPOSIXTime PParams era
pp EpochInfo (Either Text)
ei SystemStart
sysS SlotNo
s = do
  Integer -> POSIXTime
PV1.POSIXTime (Integer -> POSIXTime)
-> (UTCTime -> Integer) -> UTCTime -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed E12 -> Integer
transTime (Fixed E12 -> Integer)
-> (UTCTime -> Fixed E12) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Fixed E12
nominalDiffTimeToSeconds (NominalDiffTime -> Fixed E12)
-> (UTCTime -> NominalDiffTime) -> UTCTime -> Fixed E12
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds
    (UTCTime -> POSIXTime)
-> Either Text UTCTime -> Either Text POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochInfo (Either Text)
-> SystemStart -> SlotNo -> Either Text UTCTime
forall (m :: * -> *).
(HasCallStack, Monad m) =>
EpochInfo m -> SystemStart -> SlotNo -> m UTCTime
epochInfoSlotToUTCTime EpochInfo (Either Text)
ei SystemStart
sysS SlotNo
s
  where
    transTime :: Fixed E12 -> Integer
transTime =
      if PParams era -> Bool
forall pp. HasField "_protocolVersion" pp ProtVer => pp -> Bool
HardForks.translateTimeForPlutusScripts PParams era
pp
        then
          Fixed E12 -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate
            -- Convert to milliseconds
            (Fixed E12 -> Integer)
-> (Fixed E12 -> Fixed E12) -> Fixed E12 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fixed E12 -> Fixed E12 -> Fixed E12
forall a. Num a => a -> a -> a
* Fixed E12
1000)
        else Fixed E12 -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution

-- | translate a validity interval to POSIX time
transVITime ::
  HasField "_protocolVersion" (PParams era) ProtVer =>
  Core.PParams era ->
  EpochInfo (Either Text) ->
  SystemStart ->
  ValidityInterval ->
  Either Text PV1.POSIXTimeRange
transVITime :: PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either Text POSIXTimeRange
transVITime PParams era
_ EpochInfo (Either Text)
_ SystemStart
_ (ValidityInterval StrictMaybe SlotNo
SNothing StrictMaybe SlotNo
SNothing) = POSIXTimeRange -> Either Text POSIXTimeRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure POSIXTimeRange
forall a. Interval a
PV1.always
transVITime PParams era
pp EpochInfo (Either Text)
ei SystemStart
sysS (ValidityInterval (SJust SlotNo
i) StrictMaybe SlotNo
SNothing) = do
  POSIXTime
t <- PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> SlotNo
-> Either Text POSIXTime
forall era.
HasField "_protocolVersion" (PParams era) ProtVer =>
PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> SlotNo
-> Either Text POSIXTime
slotToPOSIXTime PParams era
pp EpochInfo (Either Text)
ei SystemStart
sysS SlotNo
i
  POSIXTimeRange -> Either Text POSIXTimeRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure (POSIXTimeRange -> Either Text POSIXTimeRange)
-> POSIXTimeRange -> Either Text POSIXTimeRange
forall a b. (a -> b) -> a -> b
$ POSIXTime -> POSIXTimeRange
forall a. a -> Interval a
PV1.from POSIXTime
t
transVITime PParams era
pp EpochInfo (Either Text)
ei SystemStart
sysS (ValidityInterval StrictMaybe SlotNo
SNothing (SJust SlotNo
i)) = do
  POSIXTime
t <- PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> SlotNo
-> Either Text POSIXTime
forall era.
HasField "_protocolVersion" (PParams era) ProtVer =>
PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> SlotNo
-> Either Text POSIXTime
slotToPOSIXTime PParams era
pp EpochInfo (Either Text)
ei SystemStart
sysS SlotNo
i
  POSIXTimeRange -> Either Text POSIXTimeRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure (POSIXTimeRange -> Either Text POSIXTimeRange)
-> POSIXTimeRange -> Either Text POSIXTimeRange
forall a b. (a -> b) -> a -> b
$ POSIXTime -> POSIXTimeRange
forall a. a -> Interval a
PV1.to POSIXTime
t
transVITime PParams era
pp EpochInfo (Either Text)
ei SystemStart
sysS (ValidityInterval (SJust SlotNo
i) (SJust SlotNo
j)) = do
  POSIXTime
t1 <- PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> SlotNo
-> Either Text POSIXTime
forall era.
HasField "_protocolVersion" (PParams era) ProtVer =>
PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> SlotNo
-> Either Text POSIXTime
slotToPOSIXTime PParams era
pp EpochInfo (Either Text)
ei SystemStart
sysS SlotNo
i
  POSIXTime
t2 <- PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> SlotNo
-> Either Text POSIXTime
forall era.
HasField "_protocolVersion" (PParams era) ProtVer =>
PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> SlotNo
-> Either Text POSIXTime
slotToPOSIXTime PParams era
pp EpochInfo (Either Text)
ei SystemStart
sysS SlotNo
j
  POSIXTimeRange -> Either Text POSIXTimeRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure (POSIXTimeRange -> Either Text POSIXTimeRange)
-> POSIXTimeRange -> Either Text POSIXTimeRange
forall a b. (a -> b) -> a -> b
$
    LowerBound POSIXTime -> UpperBound POSIXTime -> POSIXTimeRange
forall a. LowerBound a -> UpperBound a -> Interval a
PV1.Interval
      (POSIXTime -> LowerBound POSIXTime
forall a. a -> LowerBound a
PV1.lowerBound POSIXTime
t1)
      (POSIXTime -> UpperBound POSIXTime
forall a. a -> UpperBound a
PV1.strictUpperBound POSIXTime
t2)

-- ========================================
-- translate TxIn and TxOut

txInfoIn' :: TxIn c -> PV1.TxOutRef
txInfoIn' :: TxIn c -> TxOutRef
txInfoIn' (TxIn TxId c
txid TxIx
txIx) = TxId -> Integer -> TxOutRef
PV1.TxOutRef (TxId c -> TxId
forall crypto. TxId crypto -> TxId
txInfoId TxId c
txid) (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (TxIx -> Int
txIxToInt TxIx
txIx))

-- | Given a TxIn, look it up in the UTxO. If it exists, translate it and return
--   (Just translation). If does not exist in the UTxO, return Nothing.
txInfoIn ::
  forall era c i.
  ( Era era,
    Value era ~ Mary.Value (Crypto era),
    HasField "datahash" (TxOut era) (StrictMaybe (SafeHash c i))
  ) =>
  TxIn (Crypto era) ->
  TxOut era ->
  Maybe PV1.TxInInfo
txInfoIn :: TxIn (Crypto era) -> TxOut era -> Maybe TxInInfo
txInfoIn TxIn (Crypto era)
txin TxOut era
txout = do
  let valout :: Value
valout = Value (Crypto era) -> Value
forall c. Value c -> Value
transValue (TxOut era -> Value (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"value" TxOut era
txout)
      dhash :: Maybe DatumHash
dhash = case TxOut era -> StrictMaybe (SafeHash c i)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"datahash" TxOut era
txout of
        StrictMaybe (SafeHash c i)
SNothing -> Maybe DatumHash
forall a. Maybe a
Nothing
        SJust SafeHash c i
safehash -> DatumHash -> Maybe DatumHash
forall a. a -> Maybe a
Just (BuiltinByteString -> DatumHash
PV1.DatumHash (SafeHash c i -> BuiltinByteString
forall c i. SafeHash c i -> BuiltinByteString
transSafeHash SafeHash c i
safehash))
  Address
addr <- TxOut era -> Maybe Address
forall era. Era era => TxOut era -> Maybe Address
transTxOutAddr TxOut era
txout
  TxInInfo -> Maybe TxInInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxInInfo -> Maybe TxInInfo) -> TxInInfo -> Maybe TxInInfo
forall a b. (a -> b) -> a -> b
$ TxOutRef -> TxOut -> TxInInfo
PV1.TxInInfo (TxIn (Crypto era) -> TxOutRef
forall c. TxIn c -> TxOutRef
txInfoIn' TxIn (Crypto era)
txin) (Address -> Value -> Maybe DatumHash -> TxOut
PV1.TxOut Address
addr Value
valout Maybe DatumHash
dhash)

-- | Given a TxOut, translate it and return (Just transalation). It is
--   possible the address part is a Bootstrap Address, in that case return Nothing
--   I.e. don't include Bootstrap Addresses in the answer.
txInfoOut ::
  forall era c.
  ( Era era,
    Value era ~ Mary.Value (Crypto era),
    HasField "datahash" (Core.TxOut era) (StrictMaybe (DataHash c))
  ) =>
  Core.TxOut era ->
  Maybe PV1.TxOut
txInfoOut :: TxOut era -> Maybe TxOut
txInfoOut TxOut era
txout = do
  let val :: Value (Crypto era)
val = TxOut era -> Value (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"value" TxOut era
txout
      datahash :: StrictMaybe (DataHash c)
datahash = TxOut era -> StrictMaybe (DataHash c)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"datahash" TxOut era
txout
  Address
addr <- TxOut era -> Maybe Address
forall era. Era era => TxOut era -> Maybe Address
transTxOutAddr TxOut era
txout
  TxOut -> Maybe TxOut
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> Value -> Maybe DatumHash -> TxOut
PV1.TxOut Address
addr (Value (Crypto era) -> Value
forall c. Value c -> Value
transValue @(Crypto era) Value (Crypto era)
val) (StrictMaybe (DataHash c) -> Maybe DatumHash
forall c. StrictMaybe (DataHash c) -> Maybe DatumHash
transDataHash StrictMaybe (DataHash c)
datahash))

-- ==================================
-- translate Values

transPolicyID :: Mary.PolicyID crypto -> PV1.CurrencySymbol
transPolicyID :: PolicyID crypto -> CurrencySymbol
transPolicyID (Mary.PolicyID (ScriptHash Hash (ADDRHASH crypto) EraIndependentScript
x)) = BuiltinByteString -> CurrencySymbol
PV1.CurrencySymbol (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PV1.toBuiltin (Hash (ADDRHASH crypto) EraIndependentScript -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash (ADDRHASH crypto) EraIndependentScript
x))

transAssetName :: Mary.AssetName -> PV1.TokenName
transAssetName :: AssetName -> TokenName
transAssetName (Mary.AssetName ShortByteString
bs) = BuiltinByteString -> TokenName
PV1.TokenName (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PV1.toBuiltin (ShortByteString -> ByteString
SBS.fromShort ShortByteString
bs))

transValue :: Mary.Value c -> PV1.Value
transValue :: Value c -> Value
transValue (Mary.Value Integer
n Map (PolicyID c) (Map AssetName Integer)
mp) = (Value -> PolicyID c -> Map AssetName Integer -> Value)
-> Value -> Map (PolicyID c) (Map AssetName Integer) -> Value
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Value -> PolicyID c -> Map AssetName Integer -> Value
forall crypto.
Value -> PolicyID crypto -> Map AssetName Integer -> Value
accum1 Value
justada Map (PolicyID c) (Map AssetName Integer)
mp
  where
    accum1 :: Value -> PolicyID crypto -> Map AssetName Integer -> Value
accum1 Value
ans PolicyID crypto
sym Map AssetName Integer
mp2 = (Value -> AssetName -> Integer -> Value)
-> Value -> Map AssetName Integer -> Value
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Value -> AssetName -> Integer -> Value
accum2 Value
ans Map AssetName Integer
mp2
      where
        accum2 :: Value -> AssetName -> Integer -> Value
accum2 Value
ans2 AssetName
tok Integer
quantity =
          (Integer -> Integer -> Integer) -> Value -> Value -> Value
PV1.unionWith
            Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
            Value
ans2
            (CurrencySymbol -> TokenName -> Integer -> Value
PV1.singleton (PolicyID crypto -> CurrencySymbol
forall crypto. PolicyID crypto -> CurrencySymbol
transPolicyID PolicyID crypto
sym) (AssetName -> TokenName
transAssetName AssetName
tok) Integer
quantity)
    justada :: Value
justada = CurrencySymbol -> TokenName -> Integer -> Value
PV1.singleton CurrencySymbol
PV1.adaSymbol TokenName
PV1.adaToken Integer
n

-- =============================================
-- translate fileds like DCert, Wdrl, and similar

transDCert :: DCert c -> PV1.DCert
transDCert :: DCert c -> DCert
transDCert (DCertDeleg (RegKey StakeCredential c
stkcred)) =
  StakingCredential -> DCert
PV1.DCertDelegRegKey (Credential -> StakingCredential
PV1.StakingHash (StakeCredential c -> Credential
forall (keyrole :: KeyRole) crypto.
Credential keyrole crypto -> Credential
transStakeCred StakeCredential c
stkcred))
transDCert (DCertDeleg (DeRegKey StakeCredential c
stkcred)) =
  StakingCredential -> DCert
PV1.DCertDelegDeRegKey (Credential -> StakingCredential
PV1.StakingHash (StakeCredential c -> Credential
forall (keyrole :: KeyRole) crypto.
Credential keyrole crypto -> Credential
transStakeCred StakeCredential c
stkcred))
transDCert (DCertDeleg (Delegate (Delegation StakeCredential c
stkcred KeyHash 'StakePool c
keyhash))) =
  StakingCredential -> PubKeyHash -> DCert
PV1.DCertDelegDelegate
    (Credential -> StakingCredential
PV1.StakingHash (StakeCredential c -> Credential
forall (keyrole :: KeyRole) crypto.
Credential keyrole crypto -> Credential
transStakeCred StakeCredential c
stkcred))
    (KeyHash 'StakePool c -> PubKeyHash
forall (d :: KeyRole) c. KeyHash d c -> PubKeyHash
transKeyHash KeyHash 'StakePool c
keyhash)
transDCert (DCertPool (RegPool PoolParams c
pp)) =
  PubKeyHash -> PubKeyHash -> DCert
PV1.DCertPoolRegister (KeyHash 'StakePool c -> PubKeyHash
forall (d :: KeyRole) c. KeyHash d c -> PubKeyHash
transKeyHash (PoolParams c -> KeyHash 'StakePool c
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
_poolId PoolParams c
pp)) (BuiltinByteString -> PubKeyHash
PV1.PubKeyHash (ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PV1.toBuiltin (Hash (HASH c) (VerKeyVRF (VRF c)) -> ByteString
forall h a. Hash h a -> ByteString
transHash (PoolParams c -> Hash (HASH c) (VerKeyVRF (VRF c))
forall crypto. PoolParams crypto -> Hash crypto (VerKeyVRF crypto)
_poolVrf PoolParams c
pp))))
transDCert (DCertPool (RetirePool KeyHash 'StakePool c
keyhash (EpochNo Word64
i))) =
  PubKeyHash -> Integer -> DCert
PV1.DCertPoolRetire (KeyHash 'StakePool c -> PubKeyHash
forall (d :: KeyRole) c. KeyHash d c -> PubKeyHash
transKeyHash KeyHash 'StakePool c
keyhash) (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i)
transDCert (DCertGenesis GenesisDelegCert c
_) = DCert
PV1.DCertGenesis
transDCert (DCertMir MIRCert c
_) = DCert
PV1.DCertMir

transWdrl :: Wdrl crypto -> Map.Map PV1.StakingCredential Integer
transWdrl :: Wdrl crypto -> Map StakingCredential Integer
transWdrl (Wdrl Map (RewardAcnt crypto) Coin
mp) = (Map StakingCredential Integer
 -> RewardAcnt crypto -> Coin -> Map StakingCredential Integer)
-> Map StakingCredential Integer
-> Map (RewardAcnt crypto) Coin
-> Map StakingCredential Integer
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map StakingCredential Integer
-> RewardAcnt crypto -> Coin -> Map StakingCredential Integer
forall crypto.
Map StakingCredential Integer
-> RewardAcnt crypto -> Coin -> Map StakingCredential Integer
accum Map StakingCredential Integer
forall k a. Map k a
Map.empty Map (RewardAcnt crypto) Coin
mp
  where
    accum :: Map StakingCredential Integer
-> RewardAcnt crypto -> Coin -> Map StakingCredential Integer
accum Map StakingCredential Integer
ans (RewardAcnt Network
_network Credential 'Staking crypto
cred) (Coin Integer
n) =
      StakingCredential
-> Integer
-> Map StakingCredential Integer
-> Map StakingCredential Integer
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Credential -> StakingCredential
PV1.StakingHash (Credential 'Staking crypto -> Credential
forall (keyrole :: KeyRole) crypto.
Credential keyrole crypto -> Credential
transStakeCred Credential 'Staking crypto
cred)) Integer
n Map StakingCredential Integer
ans

getWitVKeyHash :: (CC.Crypto crypto, Typeable kr) => WitVKey kr crypto -> PV1.PubKeyHash
getWitVKeyHash :: WitVKey kr crypto -> PubKeyHash
getWitVKeyHash =
  BuiltinByteString -> PubKeyHash
PV1.PubKeyHash
    (BuiltinByteString -> PubKeyHash)
-> (WitVKey kr crypto -> BuiltinByteString)
-> WitVKey kr crypto
-> PubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PV1.toBuiltin
    (ByteString -> BuiltinByteString)
-> (WitVKey kr crypto -> ByteString)
-> WitVKey kr crypto
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)) -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes
    (Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)) -> ByteString)
-> (WitVKey kr crypto
    -> Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)))
-> WitVKey kr crypto
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(KeyHash Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
x) -> Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
x)
    (KeyHash kr crypto
 -> Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto)))
-> (WitVKey kr crypto -> KeyHash kr crypto)
-> WitVKey kr crypto
-> Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey kr crypto -> KeyHash kr crypto
forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
hashKey
    (VKey kr crypto -> KeyHash kr crypto)
-> (WitVKey kr crypto -> VKey kr crypto)
-> WitVKey kr crypto
-> KeyHash kr crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(WitVKey VKey kr crypto
x SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
_) -> VKey kr crypto
x)

transDataPair :: (DataHash c, Data era) -> (PV1.DatumHash, PV1.Datum)
transDataPair :: (DataHash c, Data era) -> (DatumHash, Datum)
transDataPair (DataHash c
x, Data era
y) = (DataHash c -> DatumHash
forall c. DataHash c -> DatumHash
transDataHash' DataHash c
x, BuiltinData -> Datum
PV1.Datum (Data -> BuiltinData
PV1.dataToBuiltinData (Data era -> Data
forall era. Data era -> Data
getPlutusData Data era
y)))

transExUnits :: ExUnits -> PV1.ExBudget
transExUnits :: ExUnits -> ExBudget
transExUnits (ExUnits Natural
mem Natural
steps) =
  ExCPU -> ExMemory -> ExBudget
PV1.ExBudget (CostingInteger -> ExCPU
PV1.ExCPU (Natural -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
steps)) (CostingInteger -> ExMemory
PV1.ExMemory (Natural -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
mem))

exBudgetToExUnits :: PV1.ExBudget -> Maybe ExUnits
exBudgetToExUnits :: ExBudget -> Maybe ExUnits
exBudgetToExUnits (PV1.ExBudget (PV1.ExCPU CostingInteger
steps) (PV1.ExMemory CostingInteger
memory)) =
  Natural -> Natural -> ExUnits
ExUnits (Natural -> Natural -> ExUnits)
-> Maybe Natural -> Maybe (Natural -> ExUnits)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CostingInteger -> Maybe Natural
forall a. Integral a => a -> Maybe Natural
safeFromInteger CostingInteger
memory
    Maybe (Natural -> ExUnits) -> Maybe Natural -> Maybe ExUnits
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CostingInteger -> Maybe Natural
forall a. Integral a => a -> Maybe Natural
safeFromInteger CostingInteger
steps
  where
    safeFromInteger :: Integral a => a -> Maybe Natural
    safeFromInteger :: a -> Maybe Natural
safeFromInteger a
i
      | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 = Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Maybe Natural) -> Natural -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ a -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
      | Bool
otherwise = Maybe Natural
forall a. Maybe a
Nothing

-- ===================================
-- translate Script Purpose

transScriptPurpose :: ScriptPurpose crypto -> PV1.ScriptPurpose
transScriptPurpose :: ScriptPurpose crypto -> ScriptPurpose
transScriptPurpose (Minting PolicyID crypto
policyid) = CurrencySymbol -> ScriptPurpose
PV1.Minting (PolicyID crypto -> CurrencySymbol
forall crypto. PolicyID crypto -> CurrencySymbol
transPolicyID PolicyID crypto
policyid)
transScriptPurpose (Spending TxIn crypto
txin) = TxOutRef -> ScriptPurpose
PV1.Spending (TxIn crypto -> TxOutRef
forall c. TxIn c -> TxOutRef
txInfoIn' TxIn crypto
txin)
transScriptPurpose (Rewarding (RewardAcnt Network
_network Credential 'Staking crypto
cred)) =
  StakingCredential -> ScriptPurpose
PV1.Rewarding (Credential -> StakingCredential
PV1.StakingHash (Credential 'Staking crypto -> Credential
forall (keyrole :: KeyRole) crypto.
Credential keyrole crypto -> Credential
transStakeCred Credential 'Staking crypto
cred))
transScriptPurpose (Certifying DCert crypto
dcert) = DCert -> ScriptPurpose
PV1.Certifying (DCert crypto -> DCert
forall c. DCert c -> DCert
transDCert DCert crypto
dcert)

data VersionedTxInfo
  = TxInfoPV1 PV1.TxInfo
  | TxInfoPV2 PV2.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
showList :: [VersionedTxInfo] -> ShowS
$cshowList :: [VersionedTxInfo] -> ShowS
show :: VersionedTxInfo -> String
$cshow :: VersionedTxInfo -> String
showsPrec :: Int -> VersionedTxInfo -> ShowS
$cshowsPrec :: Int -> VersionedTxInfo -> ShowS
Show, VersionedTxInfo -> VersionedTxInfo -> Bool
(VersionedTxInfo -> VersionedTxInfo -> Bool)
-> (VersionedTxInfo -> VersionedTxInfo -> Bool)
-> Eq VersionedTxInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionedTxInfo -> VersionedTxInfo -> Bool
$c/= :: VersionedTxInfo -> VersionedTxInfo -> Bool
== :: VersionedTxInfo -> VersionedTxInfo -> Bool
$c== :: VersionedTxInfo -> VersionedTxInfo -> Bool
Eq)

-- | Where we keep functions that differ from Era to Era but which
--   deal with the extra things in the TxOut (Scripts, DataHash, Datum, etc)
class ExtendedUTxO era where
  -- Compute a Digest of the current transaction to pass to the script
  --    This is the major component of the valContext function.
  txInfo ::
    Core.PParams era ->
    Language ->
    EpochInfo (Either Text) ->
    SystemStart ->
    UTxO era ->
    Core.Tx era ->
    Either (TranslationError (Crypto era)) VersionedTxInfo

  -- Compute two sets for all TwoPhase scripts in a Tx.
  -- set 1) DataHashes for each Two phase Script in a TxIn that has a DataHash
  -- set 2) TxIns that are TwoPhase scripts, and should have a DataHash but don't.
  {- { h | (_ → (a,_,h)) ∈ txins tx ◁ utxo, isNonNativeScriptAddress tx a} -}
  inputDataHashes ::
    Map.Map (ScriptHash (Crypto era)) (Core.Script era) ->
    ValidatedTx era ->
    UTxO era ->
    (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))

  txscripts ::
    UTxO era ->
    Core.Tx era ->
    Map.Map (ScriptHash (Crypto era)) (Core.Script era)

  getAllowedSupplimentalDataHashes ::
    Core.TxBody era ->
    UTxO era ->
    Set (DataHash (Crypto era))

  getDatum ::
    Core.Tx era ->
    UTxO era ->
    ScriptPurpose (Crypto era) ->
    Maybe (Data era)

  getTxOutDatum ::
    Core.TxOut era -> Datum era

  allOuts ::
    Core.TxBody era ->
    [Core.TxOut era]
  allOuts = (Sized (TxOut era) -> TxOut era)
-> [Sized (TxOut era)] -> [TxOut era]
forall a b. (a -> b) -> [a] -> [b]
map Sized (TxOut era) -> TxOut era
forall a. Sized a -> a
sizedValue ([Sized (TxOut era)] -> [TxOut era])
-> (TxBody era -> [Sized (TxOut era)]) -> TxBody era -> [TxOut era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody era -> [Sized (TxOut era)]
forall era. ExtendedUTxO era => TxBody era -> [Sized (TxOut era)]
allSizedOuts

  allSizedOuts ::
    Core.TxBody era ->
    [Sized (Core.TxOut era)]

alonzoTxInfo ::
  forall era.
  ( Era era,
    Value era ~ Mary.Value (Crypto era),
    HasField "wits" (Core.Tx era) (TxWitness era),
    HasField "datahash" (TxOut era) (StrictMaybe (SafeHash (Crypto era) EraIndependentData)),
    HasField "_protocolVersion" (PParams era) ProtVer,
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "reqSignerHashes" (Core.TxBody era) (Set (KeyHash 'Witness (Crypto era))),
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "mint" (Core.TxBody era) (Mary.Value (Crypto era)),
    HasField "vldt" (Core.TxBody era) ValidityInterval
  ) =>
  Core.PParams era ->
  Language ->
  EpochInfo (Either Text) ->
  SystemStart ->
  UTxO era ->
  Core.Tx era ->
  Either (TranslationError (Crypto era)) VersionedTxInfo
alonzoTxInfo :: PParams era
-> Language
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO era
-> Tx era
-> Either (TranslationError (Crypto era)) VersionedTxInfo
alonzoTxInfo PParams era
pp Language
lang EpochInfo (Either Text)
ei SystemStart
sysS UTxO era
utxo Tx era
tx = do
  POSIXTimeRange
timeRange <- (Text -> TranslationError (Crypto era))
-> Either Text POSIXTimeRange
-> Either (TranslationError (Crypto era)) POSIXTimeRange
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Text -> TranslationError (Crypto era)
forall crypto. Text -> TranslationError crypto
TimeTranslationPastHorizon (Either Text POSIXTimeRange
 -> Either (TranslationError (Crypto era)) POSIXTimeRange)
-> Either Text POSIXTimeRange
-> Either (TranslationError (Crypto era)) POSIXTimeRange
forall a b. (a -> b) -> a -> b
$ PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either Text POSIXTimeRange
forall era.
HasField "_protocolVersion" (PParams era) ProtVer =>
PParams era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either Text POSIXTimeRange
transVITime PParams era
pp EpochInfo (Either Text)
ei SystemStart
sysS ValidityInterval
interval
  -- We need to do this as a separate step
  let lookupTxOut :: TxIn (Crypto era)
-> Either
     (TranslationError (Crypto era)) (TxIn (Crypto era), TxOut era)
lookupTxOut TxIn (Crypto era)
txIn =
        case TxIn (Crypto era)
-> Map (TxIn (Crypto era)) (TxOut era) -> Maybe (TxOut era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn (Crypto era)
txIn (UTxO era -> Map (TxIn (Crypto era)) (TxOut era)
forall era. UTxO era -> Map (TxIn (Crypto era)) (TxOut era)
unUTxO UTxO era
utxo) of
          Maybe (TxOut era)
Nothing -> TranslationError (Crypto era)
-> Either
     (TranslationError (Crypto era)) (TxIn (Crypto era), TxOut era)
forall a b. a -> Either a b
Left (TranslationError (Crypto era)
 -> Either
      (TranslationError (Crypto era)) (TxIn (Crypto era), TxOut era))
-> TranslationError (Crypto era)
-> Either
     (TranslationError (Crypto era)) (TxIn (Crypto era), TxOut era)
forall a b. (a -> b) -> a -> b
$ TxIn (Crypto era) -> TranslationError (Crypto era)
forall crypto. TxIn crypto -> TranslationError crypto
TranslationLogicMissingInput TxIn (Crypto era)
txIn
          Just TxOut era
txOut -> (TxIn (Crypto era), TxOut era)
-> Either
     (TranslationError (Crypto era)) (TxIn (Crypto era), TxOut era)
forall a b. b -> Either a b
Right (TxIn (Crypto era)
txIn, TxOut era
txOut)
  [(TxIn (Crypto era), TxOut era)]
txOuts <- (TxIn (Crypto era)
 -> Either
      (TranslationError (Crypto era)) (TxIn (Crypto era), TxOut era))
-> [TxIn (Crypto era)]
-> Either
     (TranslationError (Crypto era)) [(TxIn (Crypto era), TxOut era)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxIn (Crypto era)
-> Either
     (TranslationError (Crypto era)) (TxIn (Crypto era), TxOut era)
lookupTxOut (Set (TxIn (Crypto era)) -> [TxIn (Crypto era)]
forall a. Set a -> [a]
Set.toList (TxBody era -> Set (TxIn (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"inputs" TxBody era
tbody))
  case Language
lang of
    Language
PlutusV1 ->
      VersionedTxInfo
-> Either (TranslationError (Crypto era)) VersionedTxInfo
forall a b. b -> Either a b
Right (VersionedTxInfo
 -> Either (TranslationError (Crypto era)) VersionedTxInfo)
-> (TxInfo -> VersionedTxInfo)
-> TxInfo
-> Either (TranslationError (Crypto era)) VersionedTxInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxInfo -> VersionedTxInfo
TxInfoPV1 (TxInfo -> Either (TranslationError (Crypto era)) VersionedTxInfo)
-> TxInfo -> Either (TranslationError (Crypto era)) VersionedTxInfo
forall a b. (a -> b) -> a -> b
$
        TxInfo :: [TxInInfo]
-> [TxOut]
-> Value
-> Value
-> [DCert]
-> [(StakingCredential, Integer)]
-> POSIXTimeRange
-> [PubKeyHash]
-> [(DatumHash, Datum)]
-> TxId
-> TxInfo
PV1.TxInfo
          { txInfoInputs :: [TxInInfo]
PV1.txInfoInputs = ((TxIn (Crypto era), TxOut era) -> Maybe TxInInfo)
-> [(TxIn (Crypto era), TxOut era)] -> [TxInInfo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((TxIn (Crypto era) -> TxOut era -> Maybe TxInInfo)
-> (TxIn (Crypto era), TxOut era) -> Maybe TxInInfo
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxIn (Crypto era) -> TxOut era -> Maybe TxInInfo
forall era c i.
(Era era, Value era ~ Value (Crypto era),
 HasField "datahash" (TxOut era) (StrictMaybe (SafeHash c i))) =>
TxIn (Crypto era) -> TxOut era -> Maybe TxInInfo
txInfoIn) [(TxIn (Crypto era), TxOut era)]
txOuts,
            txInfoOutputs :: [TxOut]
PV1.txInfoOutputs = (TxOut era -> Maybe TxOut) -> [TxOut era] -> [TxOut]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxOut era -> Maybe TxOut
forall era c.
(Era era, Value era ~ Value (Crypto era),
 HasField "datahash" (TxOut era) (StrictMaybe (DataHash c))) =>
TxOut era -> Maybe TxOut
txInfoOut ((TxOut era -> [TxOut era] -> [TxOut era])
-> [TxOut era] -> StrictSeq (TxOut era) -> [TxOut era]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] StrictSeq (TxOut era)
outs),
            txInfoFee :: Value
PV1.txInfoFee = Value (Crypto era) -> Value
forall c. Value c -> Value
transValue (Coin -> Value (Crypto era)
forall t. Val t => Coin -> t
inject @(Mary.Value (Crypto era)) Coin
fee),
            txInfoMint :: Value
PV1.txInfoMint = Value (Crypto era) -> Value
forall c. Value c -> Value
transValue Value (Crypto era)
forge,
            txInfoDCert :: [DCert]
PV1.txInfoDCert = (DCert (Crypto era) -> [DCert] -> [DCert])
-> [DCert] -> StrictSeq (DCert (Crypto era)) -> [DCert]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\DCert (Crypto era)
c [DCert]
ans -> DCert (Crypto era) -> DCert
forall c. DCert c -> DCert
transDCert DCert (Crypto era)
c DCert -> [DCert] -> [DCert]
forall a. a -> [a] -> [a]
: [DCert]
ans) [] (TxBody era -> StrictSeq (DCert (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody era
tbody),
            txInfoWdrl :: [(StakingCredential, Integer)]
PV1.txInfoWdrl = Map StakingCredential Integer -> [(StakingCredential, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList (Wdrl (Crypto era) -> Map StakingCredential Integer
forall crypto. Wdrl crypto -> Map StakingCredential Integer
transWdrl (TxBody era -> Wdrl (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wdrls" TxBody era
tbody)),
            txInfoValidRange :: POSIXTimeRange
PV1.txInfoValidRange = POSIXTimeRange
timeRange,
            txInfoSignatories :: [PubKeyHash]
PV1.txInfoSignatories = (KeyHash 'Witness (Crypto era) -> PubKeyHash)
-> [KeyHash 'Witness (Crypto era)] -> [PubKeyHash]
forall a b. (a -> b) -> [a] -> [b]
map KeyHash 'Witness (Crypto era) -> PubKeyHash
forall (d :: KeyRole) c. KeyHash d c -> PubKeyHash
transKeyHash (Set (KeyHash 'Witness (Crypto era))
-> [KeyHash 'Witness (Crypto era)]
forall a. Set a -> [a]
Set.toList (TxBody era -> Set (KeyHash 'Witness (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"reqSignerHashes" TxBody era
tbody)),
            txInfoData :: [(DatumHash, Datum)]
PV1.txInfoData = ((DataHash (Crypto era), Data era) -> (DatumHash, Datum))
-> [(DataHash (Crypto era), Data era)] -> [(DatumHash, Datum)]
forall a b. (a -> b) -> [a] -> [b]
map (DataHash (Crypto era), Data era) -> (DatumHash, Datum)
forall c era. (DataHash c, Data era) -> (DatumHash, Datum)
transDataPair [(DataHash (Crypto era), Data era)]
datpairs,
            txInfoId :: TxId
PV1.txInfoId = BuiltinByteString -> TxId
PV1.TxId (SafeHash (Crypto era) EraIndependentTxBody -> BuiltinByteString
forall c i. SafeHash c i -> BuiltinByteString
transSafeHash (TxBody era -> SafeHash (Crypto era) EraIndependentTxBody
forall c i x.
(HasAlgorithm c, HashAnnotated x i c) =>
x -> SafeHash c i
hashAnnotated @(Crypto era) TxBody era
tbody))
          }
    Language
_ -> TranslationError (Crypto era)
-> Either (TranslationError (Crypto era)) VersionedTxInfo
forall a b. a -> Either a b
Left (TranslationError (Crypto era)
 -> Either (TranslationError (Crypto era)) VersionedTxInfo)
-> TranslationError (Crypto era)
-> Either (TranslationError (Crypto era)) VersionedTxInfo
forall a b. (a -> b) -> a -> b
$ Language -> TranslationError (Crypto era)
forall crypto. Language -> TranslationError crypto
LanguageNotSupported Language
lang
  where
    tbody :: Core.TxBody era
    tbody :: TxBody era
tbody = Tx era -> TxBody era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"body" Tx era
tx
    _witnesses :: TxWitness era
_witnesses = Tx era -> TxWitness era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wits" Tx era
tx
    outs :: StrictSeq (TxOut era)
outs = TxBody era -> StrictSeq (TxOut era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"outputs" TxBody era
tbody
    fee :: Coin
fee = TxBody era -> Coin
forall k (x :: k) r a. HasField x r a => r -> a
getField @"txfee" TxBody era
tbody
    forge :: Value (Crypto era)
forge = TxBody era -> Value (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"mint" TxBody era
tbody
    interval :: ValidityInterval
interval = TxBody era -> ValidityInterval
forall k (x :: k) r a. HasField x r a => r -> a
getField @"vldt" TxBody era
tbody

    datpairs :: [(DataHash (Crypto era), Data era)]
datpairs = Map (DataHash (Crypto era)) (Data era)
-> [(DataHash (Crypto era), Data era)]
forall k a. Map k a -> [(k, a)]
Map.toList (TxDats era -> Map (DataHash (Crypto era)) (Data era)
forall era. TxDats era -> Map (DataHash (Crypto era)) (Data era)
unTxDats (TxDats era -> Map (DataHash (Crypto era)) (Data era))
-> TxDats era -> Map (DataHash (Crypto era)) (Data era)
forall a b. (a -> b) -> a -> b
$ TxWitness era -> TxDats era
forall era. TxWitness era -> TxDats era
txdats' TxWitness era
_witnesses)

-- | valContext pairs transaction data with a script purpose.
--   See figure 22 of the Alonzo specification.
valContext ::
  VersionedTxInfo ->
  ScriptPurpose (Crypto era) ->
  Data era
valContext :: VersionedTxInfo -> ScriptPurpose (Crypto era) -> Data era
valContext (TxInfoPV1 TxInfo
txinfo) ScriptPurpose (Crypto era)
sp = Data -> Data era
forall era. Data -> Data era
Data (ScriptContext -> Data
forall a. ToData a => a -> Data
PV1.toData (TxInfo -> ScriptPurpose -> ScriptContext
PV1.ScriptContext TxInfo
txinfo (ScriptPurpose (Crypto era) -> ScriptPurpose
forall crypto. ScriptPurpose crypto -> ScriptPurpose
transScriptPurpose ScriptPurpose (Crypto era)
sp)))
valContext (TxInfoPV2 TxInfo
txinfo) ScriptPurpose (Crypto era)
sp = Data -> Data era
forall era. Data -> Data era
Data (ScriptContext -> Data
forall a. ToData a => a -> Data
PV2.toData (TxInfo -> ScriptPurpose -> ScriptContext
PV2.ScriptContext TxInfo
txinfo (ScriptPurpose (Crypto era) -> ScriptPurpose
forall crypto. ScriptPurpose crypto -> ScriptPurpose
transScriptPurpose ScriptPurpose (Crypto era)
sp)))

data ScriptFailure = PlutusSF Text PlutusDebug
  deriving (ScriptFailure -> ScriptFailure -> Bool
(ScriptFailure -> ScriptFailure -> Bool)
-> (ScriptFailure -> ScriptFailure -> Bool) -> Eq ScriptFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptFailure -> ScriptFailure -> Bool
$c/= :: ScriptFailure -> ScriptFailure -> Bool
== :: ScriptFailure -> ScriptFailure -> Bool
$c== :: ScriptFailure -> ScriptFailure -> Bool
Eq, (forall x. ScriptFailure -> Rep ScriptFailure x)
-> (forall x. Rep ScriptFailure x -> ScriptFailure)
-> Generic ScriptFailure
forall x. Rep ScriptFailure x -> ScriptFailure
forall x. ScriptFailure -> Rep ScriptFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScriptFailure x -> ScriptFailure
$cfrom :: forall x. ScriptFailure -> Rep ScriptFailure x
Generic, Context -> ScriptFailure -> IO (Maybe ThunkInfo)
Proxy ScriptFailure -> String
(Context -> ScriptFailure -> IO (Maybe ThunkInfo))
-> (Context -> ScriptFailure -> IO (Maybe ThunkInfo))
-> (Proxy ScriptFailure -> String)
-> NoThunks ScriptFailure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ScriptFailure -> String
$cshowTypeOf :: Proxy ScriptFailure -> String
wNoThunks :: Context -> ScriptFailure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ScriptFailure -> IO (Maybe ThunkInfo)
noThunks :: Context -> ScriptFailure -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ScriptFailure -> IO (Maybe ThunkInfo)
NoThunks)

data ScriptResult
  = Passes [PlutusDebug]
  | Fails [PlutusDebug] (NonEmpty ScriptFailure)
  deriving ((forall x. ScriptResult -> Rep ScriptResult x)
-> (forall x. Rep ScriptResult x -> ScriptResult)
-> Generic ScriptResult
forall x. Rep ScriptResult x -> ScriptResult
forall x. ScriptResult -> Rep ScriptResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScriptResult x -> ScriptResult
$cfrom :: forall x. ScriptResult -> Rep ScriptResult x
Generic)

scriptPass :: PlutusDebug -> ScriptResult
scriptPass :: PlutusDebug -> ScriptResult
scriptPass PlutusDebug
pd = [PlutusDebug] -> ScriptResult
Passes [PlutusDebug
pd]

scriptFail :: ScriptFailure -> ScriptResult
scriptFail :: ScriptFailure -> ScriptResult
scriptFail ScriptFailure
pd = [PlutusDebug] -> NonEmpty ScriptFailure -> ScriptResult
Fails [] (ScriptFailure -> NonEmpty ScriptFailure
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptFailure
pd)

instance NoThunks ScriptResult

instance Semigroup ScriptResult where
  (Passes [PlutusDebug]
ps) <> :: ScriptResult -> ScriptResult -> ScriptResult
<> (Passes [PlutusDebug]
qs) = [PlutusDebug] -> ScriptResult
Passes ([PlutusDebug]
ps [PlutusDebug] -> [PlutusDebug] -> [PlutusDebug]
forall a. Semigroup a => a -> a -> a
<> [PlutusDebug]
qs)
  (Passes [PlutusDebug]
ps) <> (Fails [PlutusDebug]
qs NonEmpty ScriptFailure
xs) = [PlutusDebug] -> NonEmpty ScriptFailure -> ScriptResult
Fails ([PlutusDebug]
ps [PlutusDebug] -> [PlutusDebug] -> [PlutusDebug]
forall a. Semigroup a => a -> a -> a
<> [PlutusDebug]
qs) NonEmpty ScriptFailure
xs
  (Fails [PlutusDebug]
ps NonEmpty ScriptFailure
xs) <> (Passes [PlutusDebug]
qs) = [PlutusDebug] -> NonEmpty ScriptFailure -> ScriptResult
Fails ([PlutusDebug]
ps [PlutusDebug] -> [PlutusDebug] -> [PlutusDebug]
forall a. Semigroup a => a -> a -> a
<> [PlutusDebug]
qs) NonEmpty ScriptFailure
xs
  (Fails [PlutusDebug]
ps NonEmpty ScriptFailure
xs) <> (Fails [PlutusDebug]
qs NonEmpty ScriptFailure
ys) = [PlutusDebug] -> NonEmpty ScriptFailure -> ScriptResult
Fails ([PlutusDebug]
ps [PlutusDebug] -> [PlutusDebug] -> [PlutusDebug]
forall a. Semigroup a => a -> a -> a
<> [PlutusDebug]
qs) (NonEmpty ScriptFailure
xs NonEmpty ScriptFailure
-> NonEmpty ScriptFailure -> NonEmpty ScriptFailure
forall a. Semigroup a => a -> a -> a
<> NonEmpty ScriptFailure
ys)

instance Monoid ScriptResult where
  mempty :: ScriptResult
mempty = [PlutusDebug] -> ScriptResult
Passes [PlutusDebug]
forall a. Monoid a => a
mempty

data PlutusDebug
  = PlutusDebugV1
      CostModel
      ExUnits
      SBS.ShortByteString
      [PV1.Data]
      ProtVer
  | PlutusDebugV2
      CostModel
      ExUnits
      SBS.ShortByteString
      [PV2.Data]
      ProtVer
  deriving (PlutusDebug -> PlutusDebug -> Bool
(PlutusDebug -> PlutusDebug -> Bool)
-> (PlutusDebug -> PlutusDebug -> Bool) -> Eq PlutusDebug
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusDebug -> PlutusDebug -> Bool
$c/= :: PlutusDebug -> PlutusDebug -> Bool
== :: PlutusDebug -> PlutusDebug -> Bool
$c== :: PlutusDebug -> PlutusDebug -> Bool
Eq, (forall x. PlutusDebug -> Rep PlutusDebug x)
-> (forall x. Rep PlutusDebug x -> PlutusDebug)
-> Generic PlutusDebug
forall x. Rep PlutusDebug x -> PlutusDebug
forall x. PlutusDebug -> Rep PlutusDebug x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlutusDebug x -> PlutusDebug
$cfrom :: forall x. PlutusDebug -> Rep PlutusDebug x
Generic, Context -> PlutusDebug -> IO (Maybe ThunkInfo)
Proxy PlutusDebug -> String
(Context -> PlutusDebug -> IO (Maybe ThunkInfo))
-> (Context -> PlutusDebug -> IO (Maybe ThunkInfo))
-> (Proxy PlutusDebug -> String)
-> NoThunks PlutusDebug
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy PlutusDebug -> String
$cshowTypeOf :: Proxy PlutusDebug -> String
wNoThunks :: Context -> PlutusDebug -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PlutusDebug -> IO (Maybe ThunkInfo)
noThunks :: Context -> PlutusDebug -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> PlutusDebug -> IO (Maybe ThunkInfo)
NoThunks)

-- There is no Show instance for PlutusDebug intentionally, because it is too
-- expensive and it will be too tempting to use it incorrectly. If needed for
-- testing use 'StandaloneDeriving', otherwise define an efficient way to display
-- this info.

data PlutusError = PlutusErrorV1 PV1.EvaluationError | PlutusErrorV2 PV2.EvaluationError
  deriving (Int -> PlutusError -> ShowS
[PlutusError] -> ShowS
PlutusError -> String
(Int -> PlutusError -> ShowS)
-> (PlutusError -> String)
-> ([PlutusError] -> ShowS)
-> Show PlutusError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusError] -> ShowS
$cshowList :: [PlutusError] -> ShowS
show :: PlutusError -> String
$cshow :: PlutusError -> String
showsPrec :: Int -> PlutusError -> ShowS
$cshowsPrec :: Int -> PlutusError -> ShowS
Show)

data PlutusDebugInfo
  = DebugSuccess PV1.ExBudget
  | DebugCannotDecode String
  | DebugInfo [Text] PlutusError PlutusDebug
  | DebugBadHex String

instance ToCBOR PlutusDebug where
  toCBOR :: PlutusDebug -> Encoding
toCBOR (PlutusDebugV1 CostModel
a ExUnits
b ShortByteString
c [Data]
d ProtVer
e) = Encode 'Open PlutusDebug -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open PlutusDebug -> Encoding)
-> Encode 'Open PlutusDebug -> Encoding
forall a b. (a -> b) -> a -> b
$ (CostModel
 -> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Word
-> Encode
     'Open
     (CostModel
      -> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
forall t. t -> Word -> Encode 'Open t
Sum CostModel
-> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug
PlutusDebugV1 Word
0 Encode
  'Open
  (CostModel
   -> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Encode ('Closed 'Dense) CostModel
-> Encode
     'Open
     (ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> CostModel -> Encode ('Closed 'Dense) CostModel
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To CostModel
a Encode
  'Open
  (ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Encode ('Closed 'Dense) ExUnits
-> Encode
     'Open (ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ExUnits -> Encode ('Closed 'Dense) ExUnits
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ExUnits
b Encode 'Open (ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Encode ('Closed 'Dense) ShortByteString
-> Encode 'Open ([Data] -> ProtVer -> PlutusDebug)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ShortByteString -> Encode ('Closed 'Dense) ShortByteString
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ShortByteString
c Encode 'Open ([Data] -> ProtVer -> PlutusDebug)
-> Encode ('Closed 'Dense) [Data]
-> Encode 'Open (ProtVer -> PlutusDebug)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> [Data] -> Encode ('Closed 'Dense) [Data]
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To [Data]
d Encode 'Open (ProtVer -> PlutusDebug)
-> Encode ('Closed 'Dense) ProtVer -> Encode 'Open PlutusDebug
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. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ProtVer
e
  toCBOR (PlutusDebugV2 CostModel
a ExUnits
b ShortByteString
c [Data]
d ProtVer
e) = Encode 'Open PlutusDebug -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open PlutusDebug -> Encoding)
-> Encode 'Open PlutusDebug -> Encoding
forall a b. (a -> b) -> a -> b
$ (CostModel
 -> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Word
-> Encode
     'Open
     (CostModel
      -> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
forall t. t -> Word -> Encode 'Open t
Sum CostModel
-> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug
PlutusDebugV2 Word
1 Encode
  'Open
  (CostModel
   -> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Encode ('Closed 'Dense) CostModel
-> Encode
     'Open
     (ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> CostModel -> Encode ('Closed 'Dense) CostModel
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To CostModel
a Encode
  'Open
  (ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Encode ('Closed 'Dense) ExUnits
-> Encode
     'Open (ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ExUnits -> Encode ('Closed 'Dense) ExUnits
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ExUnits
b Encode 'Open (ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Encode ('Closed 'Dense) ShortByteString
-> Encode 'Open ([Data] -> ProtVer -> PlutusDebug)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ShortByteString -> Encode ('Closed 'Dense) ShortByteString
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ShortByteString
c Encode 'Open ([Data] -> ProtVer -> PlutusDebug)
-> Encode ('Closed 'Dense) [Data]
-> Encode 'Open (ProtVer -> PlutusDebug)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> [Data] -> Encode ('Closed 'Dense) [Data]
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To [Data]
d Encode 'Open (ProtVer -> PlutusDebug)
-> Encode ('Closed 'Dense) ProtVer -> Encode 'Open PlutusDebug
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. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ProtVer
e

instance FromCBOR PlutusDebug where
  fromCBOR :: Decoder s PlutusDebug
fromCBOR = Decode ('Closed 'Dense) PlutusDebug -> Decoder s PlutusDebug
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (String
-> (Word -> Decode 'Open PlutusDebug)
-> Decode ('Closed 'Dense) PlutusDebug
forall t.
String -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands String
"PlutusDebug" Word -> Decode 'Open PlutusDebug
dec)
    where
      dec :: Word -> Decode 'Open PlutusDebug
dec Word
0 =
        (CostModel
 -> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Decode
     'Open
     (CostModel
      -> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
forall t. t -> Decode 'Open t
SumD CostModel
-> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug
PlutusDebugV1
          Decode
  'Open
  (CostModel
   -> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Decode ('Closed 'Dense) CostModel
-> Decode
     'Open
     (ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s CostModel)
-> Decode ('Closed 'Dense) CostModel
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Language -> Decoder s CostModel
forall s. Language -> Decoder s CostModel
decodeCostModel Language
PlutusV1)
          Decode
  'Open
  (ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Decode ('Closed Any) ExUnits
-> Decode
     'Open (ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ExUnits
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
          Decode 'Open (ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Decode ('Closed Any) ShortByteString
-> Decode 'Open ([Data] -> ProtVer -> PlutusDebug)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ShortByteString
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
          Decode 'Open ([Data] -> ProtVer -> PlutusDebug)
-> Decode ('Closed 'Dense) [Data]
-> Decode 'Open (ProtVer -> PlutusDebug)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s [Data]) -> Decode ('Closed 'Dense) [Data]
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s Data -> Decoder s [Data]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s Data
forall a s. Serialise a => Decoder s a
Cborg.decode)
          Decode 'Open (ProtVer -> PlutusDebug)
-> Decode ('Closed Any) ProtVer -> Decode 'Open PlutusDebug
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ProtVer
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
1 =
        (CostModel
 -> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Decode
     'Open
     (CostModel
      -> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
forall t. t -> Decode 'Open t
SumD CostModel
-> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug
PlutusDebugV2
          Decode
  'Open
  (CostModel
   -> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Decode ('Closed 'Dense) CostModel
-> Decode
     'Open
     (ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s CostModel)
-> Decode ('Closed 'Dense) CostModel
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Language -> Decoder s CostModel
forall s. Language -> Decoder s CostModel
decodeCostModel Language
PlutusV2)
          Decode
  'Open
  (ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Decode ('Closed Any) ExUnits
-> Decode
     'Open (ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ExUnits
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
          Decode 'Open (ShortByteString -> [Data] -> ProtVer -> PlutusDebug)
-> Decode ('Closed Any) ShortByteString
-> Decode 'Open ([Data] -> ProtVer -> PlutusDebug)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ShortByteString
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
          Decode 'Open ([Data] -> ProtVer -> PlutusDebug)
-> Decode ('Closed 'Dense) [Data]
-> Decode 'Open (ProtVer -> PlutusDebug)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s [Data]) -> Decode ('Closed 'Dense) [Data]
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s Data -> Decoder s [Data]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s Data
forall a s. Serialise a => Decoder s a
Cborg.decode)
          Decode 'Open (ProtVer -> PlutusDebug)
-> Decode ('Closed Any) ProtVer -> Decode 'Open PlutusDebug
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ProtVer
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
n = Word -> Decode 'Open PlutusDebug
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

debugPlutus :: String -> PlutusDebugInfo
debugPlutus :: String -> PlutusDebugInfo
debugPlutus String
db =
  case ByteString -> Either String ByteString
B64.decode (String -> ByteString
BSU.fromString String
db) of
    Left String
e -> String -> PlutusDebugInfo
DebugBadHex (ShowS
forall a. Show a => a -> String
show String
e)
    Right ByteString
bs ->
      case ByteString -> Either DecoderError PlutusDebug
forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull' ByteString
bs of
        Left DecoderError
e -> String -> PlutusDebugInfo
DebugCannotDecode (DecoderError -> String
forall a. Show a => a -> String
show DecoderError
e)
        Right pdb :: PlutusDebug
pdb@(PlutusDebugV1 CostModel
cm ExUnits
units ShortByteString
script [Data]
ds ProtVer
pv) ->
          case ProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ShortByteString
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
PV1.evaluateScriptRestricting
            (ProtVer -> ProtocolVersion
transProtocolVersion ProtVer
pv)
            VerboseMode
PV1.Verbose
            (CostModel -> EvaluationContext
getEvaluationContext CostModel
cm)
            (ExUnits -> ExBudget
transExUnits ExUnits
units)
            ShortByteString
script
            [Data]
ds of
            (LogOutput
logs, Left EvaluationError
e) -> LogOutput -> PlutusError -> PlutusDebug -> PlutusDebugInfo
DebugInfo LogOutput
logs (EvaluationError -> PlutusError
PlutusErrorV1 EvaluationError
e) PlutusDebug
pdb
            (LogOutput
_, Right ExBudget
ex) -> ExBudget -> PlutusDebugInfo
DebugSuccess ExBudget
ex
        Right pdb :: PlutusDebug
pdb@(PlutusDebugV2 CostModel
cm ExUnits
units ShortByteString
script [Data]
ds ProtVer
pv) ->
          case ProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ShortByteString
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
PV2.evaluateScriptRestricting
            (ProtVer -> ProtocolVersion
transProtocolVersion ProtVer
pv)
            VerboseMode
PV2.Verbose
            (CostModel -> EvaluationContext
getEvaluationContext CostModel
cm)
            (ExUnits -> ExBudget
transExUnits ExUnits
units)
            ShortByteString
script
            [Data]
ds of
            (LogOutput
logs, Left EvaluationError
e) -> LogOutput -> PlutusError -> PlutusDebug -> PlutusDebugInfo
DebugInfo LogOutput
logs (EvaluationError -> PlutusError
PlutusErrorV2 EvaluationError
e) PlutusDebug
pdb
            (LogOutput
_, Right ExBudget
ex) -> ExBudget -> PlutusDebugInfo
DebugSuccess ExBudget
ex

-- The runPLCScript in the Specification has a slightly different type
-- than the one in the implementation below. Made necessary by the the type
-- of PV1.evaluateScriptRestricting which is the interface to Plutus, and in the impementation
-- we try to track why a script failed (if it does) by the [String] in the Fails constructor of ScriptResut.

-- | Run a Plutus Script, given the script and the bounds on resources it is allocated.
runPLCScript ::
  forall era.
  Show (Script era) =>
  Proxy era ->
  ProtVer ->
  Language ->
  CostModel ->
  SBS.ShortByteString ->
  ExUnits ->
  [PV1.Data] ->
  ScriptResult
runPLCScript :: Proxy era
-> ProtVer
-> Language
-> CostModel
-> ShortByteString
-> ExUnits
-> [Data]
-> ScriptResult
runPLCScript Proxy era
proxy ProtVer
pv Language
lang CostModel
cm ShortByteString
scriptbytestring ExUnits
units [Data]
ds =
  case Language
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ShortByteString
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
plutusInterpreter
    Language
lang
    VerboseMode
PV1.Quiet
    (CostModel -> EvaluationContext
getEvaluationContext CostModel
cm)
    (ExUnits -> ExBudget
transExUnits ExUnits
units)
    ShortByteString
scriptbytestring
    [Data]
ds of
    (LogOutput
_, Left EvaluationError
e) -> Proxy era
-> ProtVer
-> Language
-> ShortByteString
-> EvaluationError
-> [Data]
-> CostModel
-> ExUnits
-> ScriptResult
forall era.
Show (Script era) =>
Proxy era
-> ProtVer
-> Language
-> ShortByteString
-> EvaluationError
-> [Data]
-> CostModel
-> ExUnits
-> ScriptResult
explainPlutusFailure Proxy era
proxy ProtVer
pv Language
lang ShortByteString
scriptbytestring EvaluationError
e [Data]
ds CostModel
cm ExUnits
units
    (LogOutput
_, Right ExBudget
_) -> PlutusDebug -> ScriptResult
scriptPass (PlutusDebug -> ScriptResult) -> PlutusDebug -> ScriptResult
forall a b. (a -> b) -> a -> b
$ Language
-> CostModel
-> ExUnits
-> ShortByteString
-> [Data]
-> ProtVer
-> PlutusDebug
successConstructor Language
lang CostModel
cm ExUnits
units ShortByteString
scriptbytestring [Data]
ds ProtVer
pv
  where
    plutusPV :: ProtocolVersion
plutusPV = ProtVer -> ProtocolVersion
transProtocolVersion ProtVer
pv
    plutusInterpreter :: Language
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ShortByteString
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
plutusInterpreter Language
PlutusV1 = ProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ShortByteString
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
PV1.evaluateScriptRestricting ProtocolVersion
plutusPV
    plutusInterpreter Language
PlutusV2 = ProtocolVersion
-> VerboseMode
-> EvaluationContext
-> ExBudget
-> ShortByteString
-> [Data]
-> (LogOutput, Either EvaluationError ExBudget)
PV2.evaluateScriptRestricting ProtocolVersion
plutusPV
    successConstructor :: Language
-> CostModel
-> ExUnits
-> ShortByteString
-> [Data]
-> ProtVer
-> PlutusDebug
successConstructor Language
PlutusV1 = CostModel
-> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug
PlutusDebugV1
    successConstructor Language
PlutusV2 = CostModel
-> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug
PlutusDebugV2

-- | Explain why a script might fail. Scripts come in two flavors:
--
-- (1) with 3  data arguments [data,redeemer,context]
--
-- (2) with 2 data arguments [redeemer,context].
--
-- It pays to decode the context data into a real context because that provides
-- way more information. But there is no guarantee the context data really can
-- be decoded.
explainPlutusFailure ::
  forall era.
  Show (Script era) =>
  Proxy era ->
  ProtVer ->
  Language ->
  SBS.ShortByteString ->
  PV1.EvaluationError ->
  [PV1.Data] ->
  CostModel ->
  ExUnits ->
  ScriptResult
explainPlutusFailure :: Proxy era
-> ProtVer
-> Language
-> ShortByteString
-> EvaluationError
-> [Data]
-> CostModel
-> ExUnits
-> ScriptResult
explainPlutusFailure Proxy era
_proxy ProtVer
pv Language
lang ShortByteString
scriptbytestring EvaluationError
e ds :: [Data]
ds@[Data
dat, Data
redeemer, Data
info] CostModel
cm ExUnits
eu =
  -- A three data argument script.
  let ss :: Script era
      ss :: Script era
ss = Language -> ShortByteString -> Script era
forall era. Language -> ShortByteString -> Script era
PlutusScript Language
lang ShortByteString
scriptbytestring
      name :: String
      name :: String
name = Script era -> String
forall a. Show a => a -> String
show Script era
ss
   in case Data -> Maybe ScriptContext
forall a. FromData a => Data -> Maybe a
PV1.fromData Data
info of
        Maybe ScriptContext
Nothing -> ScriptFailure -> ScriptResult
scriptFail (ScriptFailure -> ScriptResult) -> ScriptFailure -> ScriptResult
forall a b. (a -> b) -> a -> b
$ Text -> PlutusDebug -> ScriptFailure
PlutusSF Text
line PlutusDebug
db
          where
            line :: Text
line =
              String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
                Context -> String
unlines
                  [ String
"\nThe 3 arg plutus script (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") fails.",
                    EvaluationError -> String
forall a. Show a => a -> String
show EvaluationError
e,
                    String
"The protocol version is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProtVer -> String
forall a. Show a => a -> String
show ProtVer
pv,
                    String
"The data is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Data -> String
forall a. Show a => a -> String
show Data
dat,
                    String
"The redeemer is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Data -> String
forall a. Show a => a -> String
show Data
redeemer,
                    String
"The third data argument, does not decode to a context\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Data -> String
forall a. Show a => a -> String
show Data
info
                  ]
            db :: PlutusDebug
db = CostModel
-> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug
PlutusDebugV1 CostModel
cm ExUnits
eu ShortByteString
scriptbytestring [Data]
ds ProtVer
pv
        Just ScriptContext
info2 -> ScriptFailure -> ScriptResult
scriptFail (ScriptFailure -> ScriptResult) -> ScriptFailure -> ScriptResult
forall a b. (a -> b) -> a -> b
$ Text -> PlutusDebug -> ScriptFailure
PlutusSF Text
line PlutusDebug
db
          where
            info3 :: String
info3 = Doc Any -> String
forall a. Show a => a -> String
show (ScriptContext -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty (ScriptContext
info2 :: PV1.ScriptContext))
            line :: Text
line =
              String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
                Context -> String
unlines
                  [ String
"\nThe 3 arg plutus script (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") fails.",
                    EvaluationError -> String
forall a. Show a => a -> String
show EvaluationError
e,
                    String
"The protocol version is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProtVer -> String
forall a. Show a => a -> String
show ProtVer
pv,
                    String
"The data is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Data -> String
forall a. Show a => a -> String
show Data
dat,
                    String
"The redeemer is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Data -> String
forall a. Show a => a -> String
show Data
redeemer,
                    String
"The context is:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
info3
                  ]
            db :: PlutusDebug
db = CostModel
-> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug
PlutusDebugV1 CostModel
cm ExUnits
eu ShortByteString
scriptbytestring [Data]
ds ProtVer
pv
explainPlutusFailure Proxy era
_proxy ProtVer
pv Language
lang ShortByteString
scriptbytestring EvaluationError
e ds :: [Data]
ds@[Data
redeemer, Data
info] CostModel
cm ExUnits
eu =
  -- A two data argument script.
  let ss :: Script era
      ss :: Script era
ss = Language -> ShortByteString -> Script era
forall era. Language -> ShortByteString -> Script era
PlutusScript Language
lang ShortByteString
scriptbytestring
      name :: String
      name :: String
name = Script era -> String
forall a. Show a => a -> String
show Script era
ss
   in case Data -> Maybe ScriptContext
forall a. FromData a => Data -> Maybe a
PV1.fromData Data
info of
        Maybe ScriptContext
Nothing -> ScriptFailure -> ScriptResult
scriptFail (ScriptFailure -> ScriptResult) -> ScriptFailure -> ScriptResult
forall a b. (a -> b) -> a -> b
$ Text -> PlutusDebug -> ScriptFailure
PlutusSF Text
line PlutusDebug
db
          where
            line :: Text
line =
              String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
                Context -> String
unlines
                  [ String
"\nThe 2 arg plutus script (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") fails.",
                    EvaluationError -> String
forall a. Show a => a -> String
show EvaluationError
e,
                    String
"The protocol version is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProtVer -> String
forall a. Show a => a -> String
show ProtVer
pv,
                    String
"The redeemer is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Data -> String
forall a. Show a => a -> String
show Data
redeemer,
                    String
"The second data argument, does not decode to a context\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Data -> String
forall a. Show a => a -> String
show Data
info
                  ]
            db :: PlutusDebug
db = CostModel
-> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug
PlutusDebugV1 CostModel
cm ExUnits
eu ShortByteString
scriptbytestring [Data]
ds ProtVer
pv
        Just ScriptContext
info2 -> ScriptFailure -> ScriptResult
scriptFail (ScriptFailure -> ScriptResult) -> ScriptFailure -> ScriptResult
forall a b. (a -> b) -> a -> b
$ Text -> PlutusDebug -> ScriptFailure
PlutusSF Text
line PlutusDebug
db
          where
            info3 :: String
info3 = Doc Any -> String
forall a. Show a => a -> String
show (ScriptContext -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty (ScriptContext
info2 :: PV1.ScriptContext))
            line :: Text
line =
              String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
                Context -> String
unlines
                  [ String
"\nThe 2 arg plutus script (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") fails.",
                    EvaluationError -> String
forall a. Show a => a -> String
show EvaluationError
e,
                    String
"The protocol version is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProtVer -> String
forall a. Show a => a -> String
show ProtVer
pv,
                    String
"The redeemer is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Data -> String
forall a. Show a => a -> String
show Data
redeemer,
                    String
"The context is:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
info3
                  ]
            db :: PlutusDebug
db = CostModel
-> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug
PlutusDebugV1 CostModel
cm ExUnits
eu ShortByteString
scriptbytestring [Data]
ds ProtVer
pv
explainPlutusFailure Proxy era
_proxy ProtVer
pv Language
lang ShortByteString
scriptbytestring EvaluationError
e [Data]
ds CostModel
cm ExUnits
eu =
  -- A script with the wrong number of arguments
  ScriptFailure -> ScriptResult
scriptFail (ScriptFailure -> ScriptResult) -> ScriptFailure -> ScriptResult
forall a b. (a -> b) -> a -> b
$ Text -> PlutusDebug -> ScriptFailure
PlutusSF Text
line PlutusDebug
db
  where
    ss :: Script era
    ss :: Script era
ss = Language -> ShortByteString -> Script era
forall era. Language -> ShortByteString -> Script era
PlutusScript Language
lang ShortByteString
scriptbytestring
    name :: String
    name :: String
name = Script era -> String
forall a. Show a => a -> String
show Script era
ss
    line :: Text
line =
      String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        Context -> String
unlines
          ( [ String
"\nThe plutus script (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") fails.",
              EvaluationError -> String
forall a. Show a => a -> String
show EvaluationError
e,
              String
"The protocol version is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ProtVer -> String
forall a. Show a => a -> String
show ProtVer
pv,
              String
"It was passed these " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Data] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Data]
ds) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" data arguments."
            ]
              Context -> Context -> Context
forall a. [a] -> [a] -> [a]
++ (Data -> String) -> [Data] -> Context
forall a b. (a -> b) -> [a] -> [b]
map Data -> String
forall a. Show a => a -> String
show [Data]
ds
          )
    db :: PlutusDebug
db = CostModel
-> ExUnits -> ShortByteString -> [Data] -> ProtVer -> PlutusDebug
PlutusDebugV1 CostModel
cm ExUnits
eu ShortByteString
scriptbytestring [Data]
ds ProtVer
pv

validPlutusdata :: PV1.Data -> Bool
validPlutusdata :: Data -> Bool
validPlutusdata (PV1.Constr Integer
_n [Data]
ds) = (Data -> Bool) -> [Data] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Data -> Bool
validPlutusdata [Data]
ds
validPlutusdata (PV1.Map [(Data, Data)]
ds) =
  ((Data, Data) -> Bool) -> [(Data, Data)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Data
x, Data
y) -> Data -> Bool
validPlutusdata Data
x Bool -> Bool -> Bool
&& Data -> Bool
validPlutusdata Data
y) [(Data, Data)]
ds
validPlutusdata (PV1.List [Data]
ds) = (Data -> Bool) -> [Data] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Data -> Bool
validPlutusdata [Data]
ds
validPlutusdata (PV1.I Integer
_n) = Bool
True
validPlutusdata (PV1.B ByteString
bs) = ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64

-- | Test that every Alonzo script represents a real Script.
--     Run deepseq to see that there are no infinite computations and that
--     every Plutus Script unflattens into a real PV1.Script
validScript :: ProtVer -> Script era -> Bool
validScript :: ProtVer -> Script era -> Bool
validScript ProtVer
pv Script era
scrip = case Script era
scrip of
  TimelockScript Timelock (Crypto era)
sc -> Timelock (Crypto era) -> Bool -> Bool
forall a b. NFData a => a -> b -> b
deepseq Timelock (Crypto era)
sc Bool
True
  PlutusScript Language
PlutusV1 ShortByteString
bytes -> ProtocolVersion -> ShortByteString -> Bool
PV1.isScriptWellFormed (ProtVer -> ProtocolVersion
transProtocolVersion ProtVer
pv) ShortByteString
bytes
  PlutusScript Language
PlutusV2 ShortByteString
bytes -> ProtocolVersion -> ShortByteString -> Bool
PV2.isScriptWellFormed (ProtVer -> ProtocolVersion
transProtocolVersion ProtVer
pv) ShortByteString
bytes

transProtocolVersion :: ProtVer -> PV1.ProtocolVersion
transProtocolVersion :: ProtVer -> ProtocolVersion
transProtocolVersion (ProtVer Natural
major Natural
minor) = Int -> Int -> ProtocolVersion
PV1.ProtocolVersion (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
major) (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
minor)

-- | Compute the Set of Languages in an era, where Alonzo.Scripts are used
languages ::
  forall era.
  ( ExtendedUTxO era,
    Core.Script era ~ Script era
  ) =>
  Core.Tx era ->
  UTxO era ->
  Set (ScriptHash (Crypto era)) ->
  Set Language
languages :: Tx era -> UTxO era -> Set (ScriptHash (Crypto era)) -> Set Language
languages Tx era
tx UTxO era
utxo Set (ScriptHash (Crypto era))
sNeeded = (Set Language -> Script era -> Set Language)
-> Set Language
-> Map (ScriptHash (Crypto era)) (Script era)
-> Set Language
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Set Language -> Script era -> Set Language
forall era. Set Language -> Script era -> Set Language
accum Set Language
forall a. Set a
Set.empty Map (ScriptHash (Crypto era)) (Script era)
allscripts
  where
    allscripts :: Map (ScriptHash (Crypto era)) (Script era)
allscripts = Map (ScriptHash (Crypto era)) (Script era)
-> Set (ScriptHash (Crypto era))
-> Map (ScriptHash (Crypto era)) (Script era)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (UTxO era -> Tx era -> Map (ScriptHash (Crypto era)) (Script era)
forall era.
ExtendedUTxO era =>
UTxO era -> Tx era -> Map (ScriptHash (Crypto era)) (Script era)
txscripts @era UTxO era
utxo Tx era
tx) Set (ScriptHash (Crypto era))
sNeeded
    accum :: Set Language -> Script era -> Set Language
accum Set Language
ans (TimelockScript Timelock (Crypto era)
_) = Set Language
ans
    accum Set Language
ans (PlutusScript Language
l ShortByteString
_) = Language -> Set Language -> Set Language
forall a. Ord a => a -> Set a -> Set a
Set.insert Language
l Set Language
ans