{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE OverloadedLists    #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TupleSections      #-}
{-# LANGUAGE ViewPatterns       #-}

{-# OPTIONS_GHC -Wno-orphans    #-}

{-|

Interface to the transaction types from 'cardano-api'

-}
module Ledger.Tx.CardanoAPI.Internal(
  CardanoBuildTx(..)
  , SomeCardanoApiTx(..)
  , txOutRefs
  , unspentOutputsTx
  , fromCardanoTxId
  , fromCardanoTxIn
  , fromCardanoTxOutToPV1TxInfoTxOut
  , fromCardanoTxOutToPV2TxInfoTxOut
  , fromCardanoTxOutDatumHash
  , fromCardanoTxOutDatum
  , fromCardanoTxOutValue
  , fromCardanoAddressInEra
  , fromCardanoAddress
  , fromCardanoAssetId
  , fromCardanoAssetName
  , fromCardanoMintValue
  , fromCardanoValue
  , fromCardanoPolicyId
  , fromCardanoFee
  , fromCardanoValidityRange
  , fromCardanoScriptInEra
  , fromCardanoPaymentKeyHash
  , fromCardanoScriptData
  , fromCardanoPlutusScript
  , fromCardanoScriptInAnyLang
  , fromCardanoLovelace
  , fromTxScriptValidity
  , toTxScriptValidity
  , scriptDataFromCardanoTxBody
  , plutusScriptsFromTxBody
  , makeTransactionBody
  , toCardanoTxIn
  , toCardanoTxOut
  , toCardanoTxOutDatum
  , toCardanoTxOutDatumHash
  , toCardanoTxOutDatumHashFromDatum
  , toCardanoTxOutDatumInline
  , toCardanoTxOutDatumInTx
  , toCardanoTxOutNoDatum
  , toCardanoTxOutValue
  , toCardanoAddressInEra
  , toCardanoAssetId
  , toCardanoAssetName
  , toCardanoPolicyId
  , toCardanoValue
  , toCardanoLovelace
  , toCardanoFee
  , adaToCardanoValue
  , toCardanoValidityRange
  , toCardanoScriptInEra
  , toCardanoPaymentKeyHash
  , toCardanoScriptData
  , toCardanoScriptDataHash
  , toCardanoScriptHash
  , toCardanoStakeKeyHash
  , toCardanoPlutusScript
  , toCardanoScriptInAnyLang
  , toCardanoReferenceScript
  , toCardanoTxId
  , ToCardanoError(..)
  , FromCardanoError(..)
  , deserialiseFromRawBytes
  , zeroExecutionUnits
  , tag
  , withIsCardanoEra) where

import Cardano.Api qualified as C
import Cardano.Api.Byron qualified as C
import Cardano.Api.Shelley qualified as C
import Cardano.BM.Data.Tracer (ToObject)
import Cardano.Chain.Common (addrToBase58)
import Cardano.Ledger.Alonzo.Language qualified as Alonzo
import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo
import Cardano.Ledger.Alonzo.TxWitness qualified as Alonzo

import Cardano.Ledger.Babbage qualified as Babbage
import Cardano.Ledger.Babbage.PParams qualified as Babbage
import Cardano.Ledger.Crypto (StandardCrypto)

import Cardano.Ledger.Core qualified as Ledger
import Codec.Serialise (Serialise, deserialiseOrFail)
import Codec.Serialise qualified as Codec
import Codec.Serialise.Decoding (Decoder, decodeBytes, decodeSimple)
import Codec.Serialise.Encoding (Encoding (Encoding), Tokens (TkBytes, TkSimple))
import Control.Applicative ((<|>))
import Control.Lens ((&), (.~), (<&>), (?~))
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), object, (.:), (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Types (Parser, parseFail, prependFailure, typeMismatch)
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.ByteString.Short qualified as SBS
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.OpenApi (NamedSchema (NamedSchema), OpenApiType (OpenApiObject), byteSchema, declareSchemaRef, properties,
                     required, sketchSchema, type_)
import Data.OpenApi qualified as OpenApi
import Data.Proxy (Proxy (Proxy))
import Data.Tuple (swap)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Ledger.Ada qualified as Ada
import Ledger.Ada qualified as P
import Ledger.Address qualified as P
import Ledger.Scripts qualified as P
import Ledger.Slot qualified as P
import Ledger.Tx.CardanoAPITemp (makeTransactionBody')
import Plutus.Script.Utils.V1.Scripts qualified as PV1
import Plutus.Script.Utils.V2.Scripts qualified as PV2
import Plutus.V1.Ledger.Api qualified as PV1
import Plutus.V1.Ledger.Credential qualified as Credential
import Plutus.V1.Ledger.Tx qualified as PV1
import Plutus.V1.Ledger.Value qualified as Value
import Plutus.V2.Ledger.Api qualified as PV2
import PlutusTx.Prelude qualified as PlutusTx
import Prettyprinter (Pretty (pretty), colon, viaShow, (<+>))

newtype CardanoBuildTx = CardanoBuildTx { CardanoBuildTx -> TxBodyContent BuildTx BabbageEra
getCardanoBuildTx :: C.TxBodyContent C.BuildTx C.BabbageEra }
  deriving (CardanoBuildTx -> CardanoBuildTx -> Bool
(CardanoBuildTx -> CardanoBuildTx -> Bool)
-> (CardanoBuildTx -> CardanoBuildTx -> Bool) -> Eq CardanoBuildTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CardanoBuildTx -> CardanoBuildTx -> Bool
$c/= :: CardanoBuildTx -> CardanoBuildTx -> Bool
== :: CardanoBuildTx -> CardanoBuildTx -> Bool
$c== :: CardanoBuildTx -> CardanoBuildTx -> Bool
Eq, Int -> CardanoBuildTx -> ShowS
[CardanoBuildTx] -> ShowS
CardanoBuildTx -> String
(Int -> CardanoBuildTx -> ShowS)
-> (CardanoBuildTx -> String)
-> ([CardanoBuildTx] -> ShowS)
-> Show CardanoBuildTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CardanoBuildTx] -> ShowS
$cshowList :: [CardanoBuildTx] -> ShowS
show :: CardanoBuildTx -> String
$cshow :: CardanoBuildTx -> String
showsPrec :: Int -> CardanoBuildTx -> ShowS
$cshowsPrec :: Int -> CardanoBuildTx -> ShowS
Show)

instance ToJSON CardanoBuildTx where
  toJSON :: CardanoBuildTx -> Value
toJSON = String -> CardanoBuildTx -> Value
forall a. HasCallStack => String -> a
error String
"TODO: ToJSON CardanoBuildTx"

instance FromJSON CardanoBuildTx where
  parseJSON :: Value -> Parser CardanoBuildTx
parseJSON Value
_ = String -> Parser CardanoBuildTx
forall a. String -> Parser a
parseFail String
"TODO: FromJSON CardanoBuildTx"

instance OpenApi.ToSchema CardanoBuildTx where
  -- TODO: implement the schema
  declareNamedSchema :: Proxy CardanoBuildTx -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy CardanoBuildTx
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"CardanoBuildTx") Schema
forall a. Monoid a => a
mempty

instance (Typeable era, Typeable mode) => OpenApi.ToSchema (C.EraInMode era mode) where
  declareNamedSchema :: Proxy (EraInMode era mode)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (EraInMode era mode)
_ = do
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"EraInMode") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ EraInMode BabbageEra CardanoMode -> Schema
forall a. ToJSON a => a -> Schema
sketchSchema EraInMode BabbageEra CardanoMode
C.BabbageEraInCardanoMode

instance (Typeable era) => OpenApi.ToSchema (C.Tx era) where
  declareNamedSchema :: Proxy (Tx era) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Tx era)
_ = do
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Tx") Schema
byteSchema

-- | Cardano tx from any era.
data SomeCardanoApiTx where
  SomeTx :: C.IsCardanoEra era => C.Tx era -> C.EraInMode era C.CardanoMode -> SomeCardanoApiTx

instance Eq SomeCardanoApiTx where
  (SomeTx Tx era
tx1 EraInMode era CardanoMode
C.ByronEraInCardanoMode) == :: SomeCardanoApiTx -> SomeCardanoApiTx -> Bool
== (SomeTx Tx era
tx2 EraInMode era CardanoMode
C.ByronEraInCardanoMode)     = Tx era
tx1 Tx era -> Tx era -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
Tx era
tx2
  (SomeTx Tx era
tx1 EraInMode era CardanoMode
C.ShelleyEraInCardanoMode) == (SomeTx Tx era
tx2 EraInMode era CardanoMode
C.ShelleyEraInCardanoMode) = Tx era
tx1 Tx era -> Tx era -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
Tx era
tx2
  (SomeTx Tx era
tx1 EraInMode era CardanoMode
C.AllegraEraInCardanoMode) == (SomeTx Tx era
tx2 EraInMode era CardanoMode
C.AllegraEraInCardanoMode) = Tx era
tx1 Tx era -> Tx era -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
Tx era
tx2
  (SomeTx Tx era
tx1 EraInMode era CardanoMode
C.MaryEraInCardanoMode) == (SomeTx Tx era
tx2 EraInMode era CardanoMode
C.MaryEraInCardanoMode)       = Tx era
tx1 Tx era -> Tx era -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
Tx era
tx2
  (SomeTx Tx era
tx1 EraInMode era CardanoMode
C.AlonzoEraInCardanoMode) == (SomeTx Tx era
tx2 EraInMode era CardanoMode
C.AlonzoEraInCardanoMode)   = Tx era
tx1 Tx era -> Tx era -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
Tx era
tx2
  (SomeTx Tx era
tx1 EraInMode era CardanoMode
C.BabbageEraInCardanoMode) == (SomeTx Tx era
tx2 EraInMode era CardanoMode
C.BabbageEraInCardanoMode) = Tx era
tx1 Tx era -> Tx era -> Bool
forall a. Eq a => a -> a -> Bool
== Tx era
Tx era
tx2
  SomeCardanoApiTx
_ == SomeCardanoApiTx
_                                                                           = Bool
False

deriving instance Show SomeCardanoApiTx

instance Serialise SomeCardanoApiTx where
  encode :: SomeCardanoApiTx -> Encoding
encode (SomeTx Tx era
tx EraInMode era CardanoMode
eraInMode) = EraInMode era CardanoMode -> Encoding
forall era. EraInMode era CardanoMode -> Encoding
encodedMode EraInMode era CardanoMode
eraInMode Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Tokens -> Tokens) -> Encoding
Encoding (ByteString -> Tokens -> Tokens
TkBytes (Tx era -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
C.serialiseToCBOR Tx era
tx))
    where
      encodedMode :: C.EraInMode era C.CardanoMode -> Encoding
      -- 0 and 1 are for ByronEraInByronMode and ShelleyEraInShelleyMode
      encodedMode :: EraInMode era CardanoMode -> Encoding
encodedMode EraInMode era CardanoMode
C.ByronEraInCardanoMode   = (Tokens -> Tokens) -> Encoding
Encoding (Word8 -> Tokens -> Tokens
TkSimple Word8
2)
      encodedMode EraInMode era CardanoMode
C.ShelleyEraInCardanoMode = (Tokens -> Tokens) -> Encoding
Encoding (Word8 -> Tokens -> Tokens
TkSimple Word8
3)
      encodedMode EraInMode era CardanoMode
C.AllegraEraInCardanoMode = (Tokens -> Tokens) -> Encoding
Encoding (Word8 -> Tokens -> Tokens
TkSimple Word8
4)
      encodedMode EraInMode era CardanoMode
C.MaryEraInCardanoMode    = (Tokens -> Tokens) -> Encoding
Encoding (Word8 -> Tokens -> Tokens
TkSimple Word8
5)
      encodedMode EraInMode era CardanoMode
C.AlonzoEraInCardanoMode  = (Tokens -> Tokens) -> Encoding
Encoding (Word8 -> Tokens -> Tokens
TkSimple Word8
6)
      encodedMode EraInMode era CardanoMode
C.BabbageEraInCardanoMode = (Tokens -> Tokens) -> Encoding
Encoding (Word8 -> Tokens -> Tokens
TkSimple Word8
7)
  decode :: Decoder s SomeCardanoApiTx
decode = do
    Word8
w <- Decoder s Word8
forall s. Decoder s Word8
decodeSimple
    case Word8
w of
      Word8
2 -> AsType ByronEra
-> EraInMode ByronEra CardanoMode -> Decoder s SomeCardanoApiTx
forall era s.
IsCardanoEra era =>
AsType era
-> EraInMode era CardanoMode -> Decoder s SomeCardanoApiTx
decodeTx AsType ByronEra
C.AsByronEra EraInMode ByronEra CardanoMode
C.ByronEraInCardanoMode
      Word8
3 -> AsType ShelleyEra
-> EraInMode ShelleyEra CardanoMode -> Decoder s SomeCardanoApiTx
forall era s.
IsCardanoEra era =>
AsType era
-> EraInMode era CardanoMode -> Decoder s SomeCardanoApiTx
decodeTx AsType ShelleyEra
C.AsShelleyEra EraInMode ShelleyEra CardanoMode
C.ShelleyEraInCardanoMode
      Word8
4 -> AsType AllegraEra
-> EraInMode AllegraEra CardanoMode -> Decoder s SomeCardanoApiTx
forall era s.
IsCardanoEra era =>
AsType era
-> EraInMode era CardanoMode -> Decoder s SomeCardanoApiTx
decodeTx AsType AllegraEra
C.AsAllegraEra EraInMode AllegraEra CardanoMode
C.AllegraEraInCardanoMode
      Word8
5 -> AsType MaryEra
-> EraInMode MaryEra CardanoMode -> Decoder s SomeCardanoApiTx
forall era s.
IsCardanoEra era =>
AsType era
-> EraInMode era CardanoMode -> Decoder s SomeCardanoApiTx
decodeTx AsType MaryEra
C.AsMaryEra EraInMode MaryEra CardanoMode
C.MaryEraInCardanoMode
      Word8
6 -> AsType AlonzoEra
-> EraInMode AlonzoEra CardanoMode -> Decoder s SomeCardanoApiTx
forall era s.
IsCardanoEra era =>
AsType era
-> EraInMode era CardanoMode -> Decoder s SomeCardanoApiTx
decodeTx AsType AlonzoEra
C.AsAlonzoEra EraInMode AlonzoEra CardanoMode
C.AlonzoEraInCardanoMode
      Word8
7 -> AsType BabbageEra
-> EraInMode BabbageEra CardanoMode -> Decoder s SomeCardanoApiTx
forall era s.
IsCardanoEra era =>
AsType era
-> EraInMode era CardanoMode -> Decoder s SomeCardanoApiTx
decodeTx AsType BabbageEra
C.AsBabbageEra EraInMode BabbageEra CardanoMode
C.BabbageEraInCardanoMode
      Word8
_ -> String -> Decoder s SomeCardanoApiTx
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected value while decoding Cardano.Api.EraInMode"
    where
      decodeTx :: C.IsCardanoEra era => C.AsType era -> C.EraInMode era C.CardanoMode -> Decoder s SomeCardanoApiTx
      decodeTx :: AsType era
-> EraInMode era CardanoMode -> Decoder s SomeCardanoApiTx
decodeTx AsType era
asType EraInMode era CardanoMode
eraInMode = do
        ByteString
bytes <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
        Tx era
tx <- (DecoderError -> Decoder s (Tx era))
-> (Tx era -> Decoder s (Tx era))
-> Either DecoderError (Tx era)
-> Decoder s (Tx era)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Decoder s (Tx era) -> DecoderError -> Decoder s (Tx era)
forall a b. a -> b -> a
const (Decoder s (Tx era) -> DecoderError -> Decoder s (Tx era))
-> Decoder s (Tx era) -> DecoderError -> Decoder s (Tx era)
forall a b. (a -> b) -> a -> b
$ String -> Decoder s (Tx era)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to decode Cardano.Api.Tx") Tx era -> Decoder s (Tx era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DecoderError (Tx era) -> Decoder s (Tx era))
-> Either DecoderError (Tx era) -> Decoder s (Tx era)
forall a b. (a -> b) -> a -> b
$ AsType (Tx era) -> ByteString -> Either DecoderError (Tx era)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
C.deserialiseFromCBOR (AsType era -> AsType (Tx era)
forall era. AsType era -> AsType (Tx era)
C.AsTx AsType era
asType) ByteString
bytes
        SomeCardanoApiTx -> Decoder s SomeCardanoApiTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeCardanoApiTx -> Decoder s SomeCardanoApiTx)
-> SomeCardanoApiTx -> Decoder s SomeCardanoApiTx
forall a b. (a -> b) -> a -> b
$ Tx era -> EraInMode era CardanoMode -> SomeCardanoApiTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> SomeCardanoApiTx
SomeTx Tx era
tx EraInMode era CardanoMode
eraInMode

instance ToJSON SomeCardanoApiTx where
  toJSON :: SomeCardanoApiTx -> Value
toJSON (SomeTx Tx era
tx EraInMode era CardanoMode
eraInMode) =
    [Pair] -> Value
object [ Key
"tx" Key -> TextEnvelope -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TextEnvelopeDescr -> Tx era -> TextEnvelope
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> TextEnvelope
C.serialiseToTextEnvelope Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing Tx era
tx
           , Key
"eraInMode" Key -> EraInMode era CardanoMode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= EraInMode era CardanoMode
eraInMode
           ]

-- | Converting 'SomeCardanoApiTx' to JSON.
--
-- If the "tx" field is from an unknown era, the JSON parser will print an
-- error at runtime while parsing.
instance FromJSON SomeCardanoApiTx where
  parseJSON :: Value -> Parser SomeCardanoApiTx
parseJSON Value
v = Value -> Parser SomeCardanoApiTx
parseByronInCardanoModeTx Value
v
            Parser SomeCardanoApiTx
-> Parser SomeCardanoApiTx -> Parser SomeCardanoApiTx
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser SomeCardanoApiTx
parseShelleyEraInCardanoModeTx Value
v
            Parser SomeCardanoApiTx
-> Parser SomeCardanoApiTx -> Parser SomeCardanoApiTx
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser SomeCardanoApiTx
parseAllegraEraInCardanoModeTx Value
v
            Parser SomeCardanoApiTx
-> Parser SomeCardanoApiTx -> Parser SomeCardanoApiTx
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser SomeCardanoApiTx
parseMaryEraInCardanoModeTx Value
v
            Parser SomeCardanoApiTx
-> Parser SomeCardanoApiTx -> Parser SomeCardanoApiTx
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser SomeCardanoApiTx
parseAlonzoEraInCardanoModeTx Value
v
            Parser SomeCardanoApiTx
-> Parser SomeCardanoApiTx -> Parser SomeCardanoApiTx
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser SomeCardanoApiTx
parseBabbageEraInCardanoModeTx Value
v
            Parser SomeCardanoApiTx
-> Parser SomeCardanoApiTx -> Parser SomeCardanoApiTx
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser SomeCardanoApiTx
parseEraInCardanoModeFail Value
v

-- | Run code that needs an `IsCardanoEra` constraint while you only have an `EraInMode` value.
withIsCardanoEra :: C.EraInMode era C.CardanoMode -> (C.IsCardanoEra era => r) -> r
withIsCardanoEra :: EraInMode era CardanoMode -> (IsCardanoEra era => r) -> r
withIsCardanoEra EraInMode era CardanoMode
C.ByronEraInCardanoMode IsCardanoEra era => r
r   = r
IsCardanoEra era => r
r
withIsCardanoEra EraInMode era CardanoMode
C.ShelleyEraInCardanoMode IsCardanoEra era => r
r = r
IsCardanoEra era => r
r
withIsCardanoEra EraInMode era CardanoMode
C.AllegraEraInCardanoMode IsCardanoEra era => r
r = r
IsCardanoEra era => r
r
withIsCardanoEra EraInMode era CardanoMode
C.MaryEraInCardanoMode IsCardanoEra era => r
r    = r
IsCardanoEra era => r
r
withIsCardanoEra EraInMode era CardanoMode
C.AlonzoEraInCardanoMode IsCardanoEra era => r
r  = r
IsCardanoEra era => r
r
withIsCardanoEra EraInMode era CardanoMode
C.BabbageEraInCardanoMode IsCardanoEra era => r
r = r
IsCardanoEra era => r
r

parseByronInCardanoModeTx :: Aeson.Value -> Parser SomeCardanoApiTx
parseByronInCardanoModeTx :: Value -> Parser SomeCardanoApiTx
parseByronInCardanoModeTx =
  String -> AsType (Tx ByronEra) -> Value -> Parser SomeCardanoApiTx
forall era.
(FromJSON (EraInMode era CardanoMode), IsCardanoEra era) =>
String -> AsType (Tx era) -> Value -> Parser SomeCardanoApiTx
parseSomeCardanoTx String
"Failed to parse ByronEra 'tx' field from SomeCardanoApiTx"
                     (AsType ByronEra -> AsType (Tx ByronEra)
forall era. AsType era -> AsType (Tx era)
C.AsTx AsType ByronEra
C.AsByronEra)

parseShelleyEraInCardanoModeTx :: Aeson.Value -> Parser SomeCardanoApiTx
parseShelleyEraInCardanoModeTx :: Value -> Parser SomeCardanoApiTx
parseShelleyEraInCardanoModeTx =
  String
-> AsType (Tx ShelleyEra) -> Value -> Parser SomeCardanoApiTx
forall era.
(FromJSON (EraInMode era CardanoMode), IsCardanoEra era) =>
String -> AsType (Tx era) -> Value -> Parser SomeCardanoApiTx
parseSomeCardanoTx String
"Failed to parse ShelleyEra 'tx' field from SomeCardanoApiTx"
                     (AsType ShelleyEra -> AsType (Tx ShelleyEra)
forall era. AsType era -> AsType (Tx era)
C.AsTx AsType ShelleyEra
C.AsShelleyEra)

parseMaryEraInCardanoModeTx :: Aeson.Value -> Parser SomeCardanoApiTx
parseMaryEraInCardanoModeTx :: Value -> Parser SomeCardanoApiTx
parseMaryEraInCardanoModeTx =
  String -> AsType (Tx MaryEra) -> Value -> Parser SomeCardanoApiTx
forall era.
(FromJSON (EraInMode era CardanoMode), IsCardanoEra era) =>
String -> AsType (Tx era) -> Value -> Parser SomeCardanoApiTx
parseSomeCardanoTx String
"Failed to parse MaryEra 'tx' field from SomeCardanoApiTx"
                     (AsType MaryEra -> AsType (Tx MaryEra)
forall era. AsType era -> AsType (Tx era)
C.AsTx AsType MaryEra
C.AsMaryEra)

parseAllegraEraInCardanoModeTx :: Aeson.Value -> Parser SomeCardanoApiTx
parseAllegraEraInCardanoModeTx :: Value -> Parser SomeCardanoApiTx
parseAllegraEraInCardanoModeTx =
  String
-> AsType (Tx AllegraEra) -> Value -> Parser SomeCardanoApiTx
forall era.
(FromJSON (EraInMode era CardanoMode), IsCardanoEra era) =>
String -> AsType (Tx era) -> Value -> Parser SomeCardanoApiTx
parseSomeCardanoTx String
"Failed to parse AllegraEra 'tx' field from SomeCardanoApiTx"
                     (AsType AllegraEra -> AsType (Tx AllegraEra)
forall era. AsType era -> AsType (Tx era)
C.AsTx AsType AllegraEra
C.AsAllegraEra)

parseAlonzoEraInCardanoModeTx :: Aeson.Value -> Parser SomeCardanoApiTx
parseAlonzoEraInCardanoModeTx :: Value -> Parser SomeCardanoApiTx
parseAlonzoEraInCardanoModeTx =
  String -> AsType (Tx AlonzoEra) -> Value -> Parser SomeCardanoApiTx
forall era.
(FromJSON (EraInMode era CardanoMode), IsCardanoEra era) =>
String -> AsType (Tx era) -> Value -> Parser SomeCardanoApiTx
parseSomeCardanoTx String
"Failed to parse AlonzoEra 'tx' field from SomeCardanoApiTx"
                     (AsType AlonzoEra -> AsType (Tx AlonzoEra)
forall era. AsType era -> AsType (Tx era)
C.AsTx AsType AlonzoEra
C.AsAlonzoEra)

-- TODO Uncomment the implementation once Cardano.Api adds a FromJSON instance
-- for 'EraInMode BabbageEra CardanoMode':
-- https://github.com/input-output-hk/cardano-node/pull/3837
parseBabbageEraInCardanoModeTx :: Aeson.Value -> Parser SomeCardanoApiTx
parseBabbageEraInCardanoModeTx :: Value -> Parser SomeCardanoApiTx
parseBabbageEraInCardanoModeTx (Aeson.Object Object
v) =
    Tx BabbageEra
-> EraInMode BabbageEra CardanoMode -> SomeCardanoApiTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> SomeCardanoApiTx
SomeTx
    (Tx BabbageEra
 -> EraInMode BabbageEra CardanoMode -> SomeCardanoApiTx)
-> Parser (Tx BabbageEra)
-> Parser (EraInMode BabbageEra CardanoMode -> SomeCardanoApiTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Key -> Parser TextEnvelope
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx" Parser TextEnvelope
-> (TextEnvelope -> Parser (Tx BabbageEra))
-> Parser (Tx BabbageEra)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TextEnvelope
envelope -> (TextEnvelopeError -> Parser (Tx BabbageEra))
-> (Tx BabbageEra -> Parser (Tx BabbageEra))
-> Either TextEnvelopeError (Tx BabbageEra)
-> Parser (Tx BabbageEra)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Parser (Tx BabbageEra)
-> TextEnvelopeError -> Parser (Tx BabbageEra)
forall a b. a -> b -> a
const (Parser (Tx BabbageEra)
 -> TextEnvelopeError -> Parser (Tx BabbageEra))
-> Parser (Tx BabbageEra)
-> TextEnvelopeError
-> Parser (Tx BabbageEra)
forall a b. (a -> b) -> a -> b
$ String -> Parser (Tx BabbageEra)
forall a. String -> Parser a
parseFail String
"Failed to parse BabbageEra 'tx' field from SomeCardanoApiTx")
                                           Tx BabbageEra -> Parser (Tx BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                                           (Either TextEnvelopeError (Tx BabbageEra)
 -> Parser (Tx BabbageEra))
-> Either TextEnvelopeError (Tx BabbageEra)
-> Parser (Tx BabbageEra)
forall a b. (a -> b) -> a -> b
$ AsType (Tx BabbageEra)
-> TextEnvelope -> Either TextEnvelopeError (Tx BabbageEra)
forall a.
HasTextEnvelope a =>
AsType a -> TextEnvelope -> Either TextEnvelopeError a
C.deserialiseFromTextEnvelope (AsType BabbageEra -> AsType (Tx BabbageEra)
forall era. AsType era -> AsType (Tx era)
C.AsTx AsType BabbageEra
C.AsBabbageEra) TextEnvelope
envelope)
    Parser (EraInMode BabbageEra CardanoMode -> SomeCardanoApiTx)
-> Parser (EraInMode BabbageEra CardanoMode)
-> Parser SomeCardanoApiTx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EraInMode BabbageEra CardanoMode
-> Parser (EraInMode BabbageEra CardanoMode)
forall (f :: * -> *) a. Applicative f => a -> f a
pure EraInMode BabbageEra CardanoMode
C.BabbageEraInCardanoMode -- This is a workaround that only works because we tried all other eras first
parseBabbageEraInCardanoModeTx Value
invalid =
  String -> Parser SomeCardanoApiTx -> Parser SomeCardanoApiTx
forall a. String -> Parser a -> Parser a
prependFailure String
"parsing SomeCardanoApiTx failed, "
      (String -> Value -> Parser SomeCardanoApiTx
forall a. String -> Value -> Parser a
typeMismatch String
"Object" Value
invalid)
  -- parseSomeCardanoTx "Failed to parse BabbageEra 'tx' field from SomeCardanoApiTx"
  --                    (C.AsTx C.AsBabbageEra)

parseEraInCardanoModeFail :: Aeson.Value -> Parser SomeCardanoApiTx
parseEraInCardanoModeFail :: Value -> Parser SomeCardanoApiTx
parseEraInCardanoModeFail Value
_ = String -> Parser SomeCardanoApiTx
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse 'eraInMode'"

parseSomeCardanoTx
  :: ( FromJSON (C.EraInMode era C.CardanoMode)
     , C.IsCardanoEra era
     )
  => String
  -> C.AsType (C.Tx era)
  -> Aeson.Value
  -> Parser SomeCardanoApiTx
parseSomeCardanoTx :: String -> AsType (Tx era) -> Value -> Parser SomeCardanoApiTx
parseSomeCardanoTx String
errorMsg AsType (Tx era)
txAsType (Aeson.Object Object
v) =
  Tx era -> EraInMode era CardanoMode -> SomeCardanoApiTx
forall era.
IsCardanoEra era =>
Tx era -> EraInMode era CardanoMode -> SomeCardanoApiTx
SomeTx
    (Tx era -> EraInMode era CardanoMode -> SomeCardanoApiTx)
-> Parser (Tx era)
-> Parser (EraInMode era CardanoMode -> SomeCardanoApiTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Key -> Parser TextEnvelope
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx" Parser TextEnvelope
-> (TextEnvelope -> Parser (Tx era)) -> Parser (Tx era)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TextEnvelope
envelope -> (TextEnvelopeError -> Parser (Tx era))
-> (Tx era -> Parser (Tx era))
-> Either TextEnvelopeError (Tx era)
-> Parser (Tx era)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Parser (Tx era) -> TextEnvelopeError -> Parser (Tx era)
forall a b. a -> b -> a
const (Parser (Tx era) -> TextEnvelopeError -> Parser (Tx era))
-> Parser (Tx era) -> TextEnvelopeError -> Parser (Tx era)
forall a b. (a -> b) -> a -> b
$ String -> Parser (Tx era)
forall a. String -> Parser a
parseFail String
errorMsg)
                                           Tx era -> Parser (Tx era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                                           (Either TextEnvelopeError (Tx era) -> Parser (Tx era))
-> Either TextEnvelopeError (Tx era) -> Parser (Tx era)
forall a b. (a -> b) -> a -> b
$ AsType (Tx era)
-> TextEnvelope -> Either TextEnvelopeError (Tx era)
forall a.
HasTextEnvelope a =>
AsType a -> TextEnvelope -> Either TextEnvelopeError a
C.deserialiseFromTextEnvelope AsType (Tx era)
txAsType TextEnvelope
envelope)
    Parser (EraInMode era CardanoMode -> SomeCardanoApiTx)
-> Parser (EraInMode era CardanoMode) -> Parser SomeCardanoApiTx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (EraInMode era CardanoMode)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"eraInMode"
parseSomeCardanoTx String
_ AsType (Tx era)
_ Value
invalid =
    String -> Parser SomeCardanoApiTx -> Parser SomeCardanoApiTx
forall a. String -> Parser a -> Parser a
prependFailure String
"parsing SomeCardanoApiTx failed, "
      (String -> Value -> Parser SomeCardanoApiTx
forall a. String -> Value -> Parser a
typeMismatch String
"Object" Value
invalid)

instance OpenApi.ToSchema SomeCardanoApiTx where
  declareNamedSchema :: Proxy SomeCardanoApiTx -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy SomeCardanoApiTx
_ = do
    Referenced Schema
txSchema <- Proxy (Tx BabbageEra)
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy (Tx BabbageEra)
forall k (t :: k). Proxy t
Proxy :: Proxy (C.Tx C.BabbageEra))
    Referenced Schema
eraInModeSchema <- Proxy (EraInMode BabbageEra CardanoMode)
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy (EraInMode BabbageEra CardanoMode)
forall k (t :: k). Proxy t
Proxy :: Proxy (C.EraInMode C.BabbageEra C.CardanoMode))
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"SomeCardanoApiTx") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~
          [ (Text
"tx", Referenced Schema
txSchema)
          , (Text
"eraInMode", Referenced Schema
eraInModeSchema)
          ]
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Item [Text]
"tx", Item [Text]
"eraInMode" ]

txOutRefs :: SomeCardanoApiTx -> [(PV1.TxOut, PV1.TxOutRef)]
txOutRefs :: SomeCardanoApiTx -> [(TxOut, TxOutRef)]
txOutRefs (SomeTx (C.Tx txBody :: TxBody era
txBody@(C.TxBody C.TxBodyContent{TxIns ViewTx era
[TxOut CtxTx era]
(TxValidityLowerBound era, TxValidityUpperBound era)
TxScriptValidity era
BuildTxWith ViewTx (Maybe ProtocolParameters)
TxInsCollateral era
TxInsReference ViewTx era
TxReturnCollateral CtxTx era
TxTotalCollateral era
TxFee era
TxMetadataInEra era
TxAuxScripts era
TxExtraKeyWitnesses era
TxWithdrawals ViewTx era
TxCertificates ViewTx era
TxUpdateProposal era
TxMintValue ViewTx era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txInsCollateral :: forall build era. TxBodyContent build era -> TxInsCollateral era
txInsReference :: forall build era.
TxBodyContent build era -> TxInsReference build era
txOuts :: forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txTotalCollateral :: forall build era. TxBodyContent build era -> TxTotalCollateral era
txReturnCollateral :: forall build era.
TxBodyContent build era -> TxReturnCollateral CtxTx era
txFee :: forall build era. TxBodyContent build era -> TxFee era
txValidityRange :: forall build era.
TxBodyContent build era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
txMetadata :: forall build era. TxBodyContent build era -> TxMetadataInEra era
txAuxScripts :: forall build era. TxBodyContent build era -> TxAuxScripts era
txExtraKeyWits :: forall build era.
TxBodyContent build era -> TxExtraKeyWitnesses era
txProtocolParams :: forall build era.
TxBodyContent build era
-> BuildTxWith build (Maybe ProtocolParameters)
txWithdrawals :: forall build era.
TxBodyContent build era -> TxWithdrawals build era
txCertificates :: forall build era.
TxBodyContent build era -> TxCertificates build era
txUpdateProposal :: forall build era. TxBodyContent build era -> TxUpdateProposal era
txMintValue :: forall build era. TxBodyContent build era -> TxMintValue build era
txScriptValidity :: forall build era. TxBodyContent build era -> TxScriptValidity era
txScriptValidity :: TxScriptValidity era
txMintValue :: TxMintValue ViewTx era
txUpdateProposal :: TxUpdateProposal era
txCertificates :: TxCertificates ViewTx era
txWithdrawals :: TxWithdrawals ViewTx era
txProtocolParams :: BuildTxWith ViewTx (Maybe ProtocolParameters)
txExtraKeyWits :: TxExtraKeyWitnesses era
txAuxScripts :: TxAuxScripts era
txMetadata :: TxMetadataInEra era
txValidityRange :: (TxValidityLowerBound era, TxValidityUpperBound era)
txFee :: TxFee era
txReturnCollateral :: TxReturnCollateral CtxTx era
txTotalCollateral :: TxTotalCollateral era
txOuts :: [TxOut CtxTx era]
txInsReference :: TxInsReference ViewTx era
txInsCollateral :: TxInsCollateral era
txIns :: TxIns ViewTx era
..}) [KeyWitness era]
_) EraInMode era CardanoMode
_) =
  (Integer, TxOut) -> (TxOut, TxOutRef)
mkOut ((Integer, TxOut) -> (TxOut, TxOutRef))
-> [(Integer, TxOut)] -> [(TxOut, TxOutRef)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer] -> [TxOut] -> [(Integer, TxOut)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Item [Integer]
0..] [TxOut]
plutusTxOuts
  where
    mkOut :: (Integer, TxOut) -> (TxOut, TxOutRef)
mkOut (Integer
i, TxOut
o) = (TxOut
o, TxId -> Integer -> TxOutRef
PV1.TxOutRef (TxId -> TxId
fromCardanoTxId (TxId -> TxId) -> TxId -> TxId
forall a b. (a -> b) -> a -> b
$ TxBody era -> TxId
forall era. TxBody era -> TxId
C.getTxId TxBody era
txBody) Integer
i)
    plutusTxOuts :: [TxOut]
plutusTxOuts = TxOut CtxTx era -> TxOut
forall era. TxOut CtxTx era -> TxOut
fromCardanoTxOutToPV1TxInfoTxOut (TxOut CtxTx era -> TxOut) -> [TxOut CtxTx era] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOut CtxTx era]
txOuts

unspentOutputsTx :: SomeCardanoApiTx -> Map PV1.TxOutRef PV1.TxOut
unspentOutputsTx :: SomeCardanoApiTx -> Map TxOutRef TxOut
unspentOutputsTx SomeCardanoApiTx
tx = [(TxOutRef, TxOut)] -> Map TxOutRef TxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxOutRef, TxOut)] -> Map TxOutRef TxOut)
-> [(TxOutRef, TxOut)] -> Map TxOutRef TxOut
forall a b. (a -> b) -> a -> b
$ (TxOut, TxOutRef) -> (TxOutRef, TxOut)
forall a b. (a, b) -> (b, a)
swap ((TxOut, TxOutRef) -> (TxOutRef, TxOut))
-> [(TxOut, TxOutRef)] -> [(TxOutRef, TxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeCardanoApiTx -> [(TxOut, TxOutRef)]
txOutRefs SomeCardanoApiTx
tx

-- | Given a 'C.TxScriptValidity era', if the @era@ supports scripts, return a
-- @True@ or @False@ depending on script validity. If the @era@ does not support
-- scripts, always return @True@.
fromTxScriptValidity :: C.TxScriptValidity era -> Bool
fromTxScriptValidity :: TxScriptValidity era -> Bool
fromTxScriptValidity (C.TxScriptValidity TxScriptValiditySupportedInEra era
C.TxScriptValiditySupportedInAlonzoEra ScriptValidity
C.ScriptValid)    = Bool
True
fromTxScriptValidity (C.TxScriptValidity TxScriptValiditySupportedInEra era
C.TxScriptValiditySupportedInAlonzoEra ScriptValidity
C.ScriptInvalid)  = Bool
False
fromTxScriptValidity (C.TxScriptValidity TxScriptValiditySupportedInEra era
C.TxScriptValiditySupportedInBabbageEra ScriptValidity
C.ScriptValid)   = Bool
True
fromTxScriptValidity (C.TxScriptValidity TxScriptValiditySupportedInEra era
C.TxScriptValiditySupportedInBabbageEra ScriptValidity
C.ScriptInvalid) = Bool
False
fromTxScriptValidity TxScriptValidity era
C.TxScriptValidityNone                                                       = Bool
True

toTxScriptValidity :: C.ShelleyBasedEra era -> Bool -> C.TxScriptValidity era
toTxScriptValidity :: ShelleyBasedEra era -> Bool -> TxScriptValidity era
toTxScriptValidity ShelleyBasedEra era
C.ShelleyBasedEraAlonzo Bool
True  = TxScriptValiditySupportedInEra AlonzoEra
-> ScriptValidity -> TxScriptValidity AlonzoEra
forall era.
TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
C.TxScriptValidity TxScriptValiditySupportedInEra AlonzoEra
C.TxScriptValiditySupportedInAlonzoEra ScriptValidity
C.ScriptValid
toTxScriptValidity ShelleyBasedEra era
C.ShelleyBasedEraAlonzo Bool
False = TxScriptValiditySupportedInEra AlonzoEra
-> ScriptValidity -> TxScriptValidity AlonzoEra
forall era.
TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
C.TxScriptValidity TxScriptValiditySupportedInEra AlonzoEra
C.TxScriptValiditySupportedInAlonzoEra ScriptValidity
C.ScriptInvalid
toTxScriptValidity ShelleyBasedEra era
C.ShelleyBasedEraBabbage Bool
True  = TxScriptValiditySupportedInEra BabbageEra
-> ScriptValidity -> TxScriptValidity BabbageEra
forall era.
TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
C.TxScriptValidity TxScriptValiditySupportedInEra BabbageEra
C.TxScriptValiditySupportedInBabbageEra ScriptValidity
C.ScriptValid
toTxScriptValidity ShelleyBasedEra era
C.ShelleyBasedEraBabbage Bool
False = TxScriptValiditySupportedInEra BabbageEra
-> ScriptValidity -> TxScriptValidity BabbageEra
forall era.
TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
C.TxScriptValidity TxScriptValiditySupportedInEra BabbageEra
C.TxScriptValiditySupportedInBabbageEra ScriptValidity
C.ScriptInvalid
toTxScriptValidity ShelleyBasedEra era
_ Bool
_ = TxScriptValidity era
forall era. TxScriptValidity era
C.TxScriptValidityNone

-- | Given a 'C.TxBody from a 'C.Tx era', return the datums and redeemers along
-- with their hashes.
scriptDataFromCardanoTxBody
  :: C.TxBody era
  -> (Map P.DatumHash P.Datum, PV1.Redeemers)
scriptDataFromCardanoTxBody :: TxBody era -> (Map DatumHash Datum, Redeemers)
scriptDataFromCardanoTxBody C.ByronTxBody {} = (Map DatumHash Datum
forall a. Monoid a => a
mempty, Redeemers
forall a. Monoid a => a
mempty)
scriptDataFromCardanoTxBody (C.ShelleyTxBody ShelleyBasedEra era
_ TxBody (ShelleyLedgerEra era)
_ [Script (ShelleyLedgerEra era)]
_ TxBodyScriptData era
C.TxBodyNoScriptData Maybe (AuxiliaryData (ShelleyLedgerEra era))
_ TxScriptValidity era
_) =
  (Map DatumHash Datum
forall a. Monoid a => a
mempty, Redeemers
forall a. Monoid a => a
mempty)
scriptDataFromCardanoTxBody
  (C.ShelleyTxBody ShelleyBasedEra era
_ TxBody (ShelleyLedgerEra era)
_ [Script (ShelleyLedgerEra era)]
_ (C.TxBodyScriptData ScriptDataSupportedInEra era
_ (Alonzo.TxDats' dats) (Alonzo.Redeemers' reds)) Maybe (AuxiliaryData (ShelleyLedgerEra era))
_ TxScriptValidity era
_) =

  let datums :: Map DatumHash Datum
datums = [(DatumHash, Datum)] -> Map DatumHash Datum
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
             ([(DatumHash, Datum)] -> Map DatumHash Datum)
-> [(DatumHash, Datum)] -> Map DatumHash Datum
forall a b. (a -> b) -> a -> b
$ (Data (ShelleyLedgerEra era) -> (DatumHash, Datum))
-> [Data (ShelleyLedgerEra era)] -> [(DatumHash, Datum)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( (\Datum
d -> (Datum -> DatumHash
P.datumHash Datum
d, Datum
d))
                    (Datum -> (DatumHash, Datum))
-> (Data (ShelleyLedgerEra era) -> Datum)
-> Data (ShelleyLedgerEra era)
-> (DatumHash, Datum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Datum
P.Datum
                    (BuiltinData -> Datum)
-> (Data (ShelleyLedgerEra era) -> BuiltinData)
-> Data (ShelleyLedgerEra era)
-> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptData -> BuiltinData
fromCardanoScriptData
                    (ScriptData -> BuiltinData)
-> (Data (ShelleyLedgerEra era) -> ScriptData)
-> Data (ShelleyLedgerEra era)
-> BuiltinData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data (ShelleyLedgerEra era) -> ScriptData
forall ledgerera. Data ledgerera -> ScriptData
C.fromAlonzoData
                    )
             ([Data (ShelleyLedgerEra era)] -> [(DatumHash, Datum)])
-> [Data (ShelleyLedgerEra era)] -> [(DatumHash, Datum)]
forall a b. (a -> b) -> a -> b
$ Map
  (DataHash (Crypto (ShelleyLedgerEra era)))
  (Data (ShelleyLedgerEra era))
-> [Data (ShelleyLedgerEra era)]
forall k a. Map k a -> [a]
Map.elems Map
  (DataHash (Crypto (ShelleyLedgerEra era)))
  (Data (ShelleyLedgerEra era))
dats
      redeemers :: Redeemers
redeemers = [(RedeemerPtr, Redeemer)] -> Redeemers
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                ([(RedeemerPtr, Redeemer)] -> Redeemers)
-> [(RedeemerPtr, Redeemer)] -> Redeemers
forall a b. (a -> b) -> a -> b
$ ((RdmrPtr, (Data (ShelleyLedgerEra era), ExUnits))
 -> (RedeemerPtr, Redeemer))
-> [(RdmrPtr, (Data (ShelleyLedgerEra era), ExUnits))]
-> [(RedeemerPtr, Redeemer)]
forall a b. (a -> b) -> [a] -> [b]
map (\(RdmrPtr
ptr, (Data (ShelleyLedgerEra era), ExUnits)
rdmr) ->
                        ( RdmrPtr -> RedeemerPtr
redeemerPtrFromCardanoRdmrPtr RdmrPtr
ptr
                        , BuiltinData -> Redeemer
P.Redeemer
                         (BuiltinData -> Redeemer) -> BuiltinData -> Redeemer
forall a b. (a -> b) -> a -> b
$ ScriptData -> BuiltinData
fromCardanoScriptData
                         (ScriptData -> BuiltinData) -> ScriptData -> BuiltinData
forall a b. (a -> b) -> a -> b
$ Data (ShelleyLedgerEra era) -> ScriptData
forall ledgerera. Data ledgerera -> ScriptData
C.fromAlonzoData
                         (Data (ShelleyLedgerEra era) -> ScriptData)
-> Data (ShelleyLedgerEra era) -> ScriptData
forall a b. (a -> b) -> a -> b
$ (Data (ShelleyLedgerEra era), ExUnits)
-> Data (ShelleyLedgerEra era)
forall a b. (a, b) -> a
fst (Data (ShelleyLedgerEra era), ExUnits)
rdmr
                        )
                      )
                ([(RdmrPtr, (Data (ShelleyLedgerEra era), ExUnits))]
 -> [(RedeemerPtr, Redeemer)])
-> [(RdmrPtr, (Data (ShelleyLedgerEra era), ExUnits))]
-> [(RedeemerPtr, Redeemer)]
forall a b. (a -> b) -> a -> b
$ Map RdmrPtr (Data (ShelleyLedgerEra era), ExUnits)
-> [(RdmrPtr, (Data (ShelleyLedgerEra era), ExUnits))]
forall k a. Map k a -> [(k, a)]
Map.toList Map RdmrPtr (Data (ShelleyLedgerEra era), ExUnits)
reds
   in (Map DatumHash Datum
datums, Redeemers
redeemers)

redeemerPtrFromCardanoRdmrPtr :: Alonzo.RdmrPtr -> PV1.RedeemerPtr
redeemerPtrFromCardanoRdmrPtr :: RdmrPtr -> RedeemerPtr
redeemerPtrFromCardanoRdmrPtr (Alonzo.RdmrPtr Tag
rdmrTag Word64
ptr) = ScriptTag -> Integer -> RedeemerPtr
PV1.RedeemerPtr ScriptTag
t (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
ptr)
  where
    t :: ScriptTag
t = case Tag
rdmrTag of
      Tag
Alonzo.Spend -> ScriptTag
PV1.Spend
      Tag
Alonzo.Mint  -> ScriptTag
PV1.Mint
      Tag
Alonzo.Cert  -> ScriptTag
PV1.Cert
      Tag
Alonzo.Rewrd -> ScriptTag
PV1.Reward

-- | Extract plutus scripts from a Cardano API tx body.
--
-- Note that Plutus scripts are only supported in Alonzo era and onwards.
plutusScriptsFromTxBody :: C.TxBody era -> Map P.ScriptHash (P.Versioned P.Script)
plutusScriptsFromTxBody :: TxBody era -> Map ScriptHash (Versioned Script)
plutusScriptsFromTxBody C.ByronTxBody {} = Map ScriptHash (Versioned Script)
forall a. Monoid a => a
mempty
plutusScriptsFromTxBody (C.ShelleyTxBody ShelleyBasedEra era
shelleyBasedEra TxBody (ShelleyLedgerEra era)
_ [Script (ShelleyLedgerEra era)]
scripts TxBodyScriptData era
_ Maybe (AuxiliaryData (ShelleyLedgerEra era))
_ TxScriptValidity era
_) =
  [(ScriptHash, Versioned Script)]
-> Map ScriptHash (Versioned Script)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ScriptHash, Versioned Script)]
 -> Map ScriptHash (Versioned Script))
-> [(ScriptHash, Versioned Script)]
-> Map ScriptHash (Versioned Script)
forall a b. (a -> b) -> a -> b
$ (Script (ShelleyLedgerEra era)
 -> Maybe (ScriptHash, Versioned Script))
-> [Script (ShelleyLedgerEra era)]
-> [(ScriptHash, Versioned Script)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ShelleyBasedEra era
-> Script (ShelleyLedgerEra era)
-> Maybe (ScriptHash, Versioned Script)
forall era.
ShelleyBasedEra era
-> Script (ShelleyLedgerEra era)
-> Maybe (ScriptHash, Versioned Script)
fromLedgerScript ShelleyBasedEra era
shelleyBasedEra) [Script (ShelleyLedgerEra era)]
scripts
--
-- | Convert a script from a Cardano api in shelley based era to a Plutus script along with it's hash.
--
-- Note that Plutus scripts are only supported in Alonzo era and onwards.
fromLedgerScript
  :: C.ShelleyBasedEra era
  -> Ledger.Script (C.ShelleyLedgerEra era)
  -> Maybe (P.ScriptHash, P.Versioned P.Script)
fromLedgerScript :: ShelleyBasedEra era
-> Script (ShelleyLedgerEra era)
-> Maybe (ScriptHash, Versioned Script)
fromLedgerScript ShelleyBasedEra era
C.ShelleyBasedEraShelley Script (ShelleyLedgerEra era)
_      = Maybe (ScriptHash, Versioned Script)
forall a. Maybe a
Nothing
fromLedgerScript ShelleyBasedEra era
C.ShelleyBasedEraAllegra Script (ShelleyLedgerEra era)
_      = Maybe (ScriptHash, Versioned Script)
forall a. Maybe a
Nothing
fromLedgerScript ShelleyBasedEra era
C.ShelleyBasedEraMary Script (ShelleyLedgerEra era)
_         = Maybe (ScriptHash, Versioned Script)
forall a. Maybe a
Nothing
fromLedgerScript ShelleyBasedEra era
C.ShelleyBasedEraAlonzo Script (ShelleyLedgerEra era)
script  = Script (AlonzoEra StandardCrypto)
-> Maybe (ScriptHash, Versioned Script)
forall a. Script a -> Maybe (ScriptHash, Versioned Script)
fromLedgerPlutusScript Script (AlonzoEra StandardCrypto)
Script (ShelleyLedgerEra era)
script
fromLedgerScript ShelleyBasedEra era
C.ShelleyBasedEraBabbage Script (ShelleyLedgerEra era)
script = Script (BabbageEra StandardCrypto)
-> Maybe (ScriptHash, Versioned Script)
forall a. Script a -> Maybe (ScriptHash, Versioned Script)
fromLedgerPlutusScript Script (BabbageEra StandardCrypto)
Script (ShelleyLedgerEra era)
script

-- | Convert a `cardano-ledger` Plutus script from the Alonzo era and onwards to
-- a 'Script' along with it's hash.
fromLedgerPlutusScript :: Alonzo.Script a -> Maybe (P.ScriptHash, P.Versioned P.Script)
fromLedgerPlutusScript :: Script a -> Maybe (ScriptHash, Versioned Script)
fromLedgerPlutusScript Alonzo.TimelockScript {} = Maybe (ScriptHash, Versioned Script)
forall a. Maybe a
Nothing
fromLedgerPlutusScript (Alonzo.PlutusScript Language
Alonzo.PlutusV1 ShortByteString
bs) =
  let hash :: ScriptHash
hash = ScriptHash -> ScriptHash
PV1.fromCardanoHash
           (ScriptHash -> ScriptHash) -> ScriptHash -> ScriptHash
forall a b. (a -> b) -> a -> b
$ Script PlutusScriptV1 -> ScriptHash
forall lang. Script lang -> ScriptHash
C.hashScript
           (Script PlutusScriptV1 -> ScriptHash)
-> Script PlutusScriptV1 -> ScriptHash
forall a b. (a -> b) -> a -> b
$ PlutusScriptVersion PlutusScriptV1
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
C.PlutusScript PlutusScriptVersion PlutusScriptV1
C.PlutusScriptV1 (PlutusScript PlutusScriptV1 -> Script PlutusScriptV1)
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusScript PlutusScriptV1
forall lang. ShortByteString -> PlutusScript lang
C.PlutusScriptSerialised ShortByteString
bs
      script :: Either DeserialiseFailure (ScriptHash, Versioned Script)
script = (Script -> (ScriptHash, Versioned Script))
-> Either DeserialiseFailure Script
-> Either DeserialiseFailure (ScriptHash, Versioned Script)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Script
s -> (ScriptHash
hash, Script -> Language -> Versioned Script
forall script. script -> Language -> Versioned script
P.Versioned Script
s Language
P.PlutusV1))
             (Either DeserialiseFailure Script
 -> Either DeserialiseFailure (ScriptHash, Versioned Script))
-> Either DeserialiseFailure Script
-> Either DeserialiseFailure (ScriptHash, Versioned Script)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DeserialiseFailure Script
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail
             (ByteString -> Either DeserialiseFailure Script)
-> ByteString -> Either DeserialiseFailure Script
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict
             (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
SBS.fromShort ShortByteString
bs
  in (DeserialiseFailure -> Maybe (ScriptHash, Versioned Script))
-> ((ScriptHash, Versioned Script)
    -> Maybe (ScriptHash, Versioned Script))
-> Either DeserialiseFailure (ScriptHash, Versioned Script)
-> Maybe (ScriptHash, Versioned Script)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (ScriptHash, Versioned Script)
-> DeserialiseFailure -> Maybe (ScriptHash, Versioned Script)
forall a b. a -> b -> a
const Maybe (ScriptHash, Versioned Script)
forall a. Maybe a
Nothing) (ScriptHash, Versioned Script)
-> Maybe (ScriptHash, Versioned Script)
forall a. a -> Maybe a
Just Either DeserialiseFailure (ScriptHash, Versioned Script)
script
fromLedgerPlutusScript (Alonzo.PlutusScript Language
Alonzo.PlutusV2 ShortByteString
bs) =
  let hash :: ScriptHash
hash = ScriptHash -> ScriptHash
PV1.fromCardanoHash
           (ScriptHash -> ScriptHash) -> ScriptHash -> ScriptHash
forall a b. (a -> b) -> a -> b
$ Script PlutusScriptV2 -> ScriptHash
forall lang. Script lang -> ScriptHash
C.hashScript
           (Script PlutusScriptV2 -> ScriptHash)
-> Script PlutusScriptV2 -> ScriptHash
forall a b. (a -> b) -> a -> b
$ PlutusScriptVersion PlutusScriptV2
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
C.PlutusScript PlutusScriptVersion PlutusScriptV2
C.PlutusScriptV2 (PlutusScript PlutusScriptV2 -> Script PlutusScriptV2)
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusScript PlutusScriptV2
forall lang. ShortByteString -> PlutusScript lang
C.PlutusScriptSerialised ShortByteString
bs
      script :: Either DeserialiseFailure (ScriptHash, Versioned Script)
script = (Script -> (ScriptHash, Versioned Script))
-> Either DeserialiseFailure Script
-> Either DeserialiseFailure (ScriptHash, Versioned Script)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Script
s -> (ScriptHash
hash, Script -> Language -> Versioned Script
forall script. script -> Language -> Versioned script
P.Versioned Script
s Language
P.PlutusV2))
             (Either DeserialiseFailure Script
 -> Either DeserialiseFailure (ScriptHash, Versioned Script))
-> Either DeserialiseFailure Script
-> Either DeserialiseFailure (ScriptHash, Versioned Script)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DeserialiseFailure Script
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail
             (ByteString -> Either DeserialiseFailure Script)
-> ByteString -> Either DeserialiseFailure Script
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict
             (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
SBS.fromShort ShortByteString
bs
   in (DeserialiseFailure -> Maybe (ScriptHash, Versioned Script))
-> ((ScriptHash, Versioned Script)
    -> Maybe (ScriptHash, Versioned Script))
-> Either DeserialiseFailure (ScriptHash, Versioned Script)
-> Maybe (ScriptHash, Versioned Script)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (ScriptHash, Versioned Script)
-> DeserialiseFailure -> Maybe (ScriptHash, Versioned Script)
forall a b. a -> b -> a
const Maybe (ScriptHash, Versioned Script)
forall a. Maybe a
Nothing) (ScriptHash, Versioned Script)
-> Maybe (ScriptHash, Versioned Script)
forall a. a -> Maybe a
Just Either DeserialiseFailure (ScriptHash, Versioned Script)
script

makeTransactionBody
    :: Maybe (Babbage.PParams (Babbage.BabbageEra StandardCrypto))
    -> Map Alonzo.RdmrPtr Alonzo.ExUnits
    -> CardanoBuildTx
    -> Either ToCardanoError (C.TxBody C.BabbageEra)
makeTransactionBody :: Maybe (PParams (BabbageEra StandardCrypto))
-> Map RdmrPtr ExUnits
-> CardanoBuildTx
-> Either ToCardanoError (TxBody BabbageEra)
makeTransactionBody Maybe (PParams (BabbageEra StandardCrypto))
pparams Map RdmrPtr ExUnits
exUnits (CardanoBuildTx TxBodyContent BuildTx BabbageEra
txBodyContent) =
  (TxBodyError -> ToCardanoError)
-> Either TxBodyError (TxBody BabbageEra)
-> Either ToCardanoError (TxBody BabbageEra)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> ToCardanoError
TxBodyError (String -> ToCardanoError)
-> (TxBodyError -> String) -> TxBodyError -> ToCardanoError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBodyError -> String
forall e. Error e => e -> String
C.displayError) (Either TxBodyError (TxBody BabbageEra)
 -> Either ToCardanoError (TxBody BabbageEra))
-> Either TxBodyError (TxBody BabbageEra)
-> Either ToCardanoError (TxBody BabbageEra)
forall a b. (a -> b) -> a -> b
$ Maybe (PParams (BabbageEra StandardCrypto))
-> Map RdmrPtr ExUnits
-> TxBodyContent BuildTx BabbageEra
-> Either TxBodyError (TxBody BabbageEra)
makeTransactionBody' Maybe (PParams (BabbageEra StandardCrypto))
pparams Map RdmrPtr ExUnits
exUnits TxBodyContent BuildTx BabbageEra
txBodyContent

fromCardanoTxIn :: C.TxIn -> PV1.TxOutRef
fromCardanoTxIn :: TxIn -> TxOutRef
fromCardanoTxIn (C.TxIn TxId
txId (C.TxIx Word
txIx)) = TxId -> Integer -> TxOutRef
PV1.TxOutRef (TxId -> TxId
fromCardanoTxId TxId
txId) (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
txIx)

toCardanoTxIn :: PV1.TxOutRef -> Either ToCardanoError C.TxIn
toCardanoTxIn :: TxOutRef -> Either ToCardanoError TxIn
toCardanoTxIn (PV1.TxOutRef TxId
txId Integer
txIx) = TxId -> TxIx -> TxIn
C.TxIn (TxId -> TxIx -> TxIn)
-> Either ToCardanoError TxId
-> Either ToCardanoError (TxIx -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxId -> Either ToCardanoError TxId
toCardanoTxId TxId
txId Either ToCardanoError (TxIx -> TxIn)
-> Either ToCardanoError TxIx -> Either ToCardanoError TxIn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxIx -> Either ToCardanoError TxIx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> TxIx
C.TxIx (Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
txIx))

fromCardanoTxId :: C.TxId -> PV1.TxId
fromCardanoTxId :: TxId -> TxId
fromCardanoTxId TxId
txId = BuiltinByteString -> TxId
PV1.TxId (BuiltinByteString -> TxId) -> BuiltinByteString -> TxId
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ TxId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes TxId
txId

toCardanoTxId :: PV1.TxId -> Either ToCardanoError C.TxId
toCardanoTxId :: TxId -> Either ToCardanoError TxId
toCardanoTxId (PV1.TxId BuiltinByteString
bs) =
    String -> Either ToCardanoError TxId -> Either ToCardanoError TxId
forall t.
String -> Either ToCardanoError t -> Either ToCardanoError t
tag String
"toCardanoTxId"
    (Either ToCardanoError TxId -> Either ToCardanoError TxId)
-> Either ToCardanoError TxId -> Either ToCardanoError TxId
forall a b. (a -> b) -> a -> b
$ AsType TxId -> ByteString -> Either ToCardanoError TxId
forall t.
SerialiseAsRawBytes t =>
AsType t -> ByteString -> Either ToCardanoError t
deserialiseFromRawBytes AsType TxId
C.AsTxId (ByteString -> Either ToCardanoError TxId)
-> ByteString -> Either ToCardanoError TxId
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
bs

-- TODO Handle reference script once 'P.TxOut' supports it (or when we use
-- exclusively 'C.TxOut' in all the codebase).
fromCardanoTxOutToPV1TxInfoTxOut :: C.TxOut C.CtxTx era -> PV1.TxOut
fromCardanoTxOutToPV1TxInfoTxOut :: TxOut CtxTx era -> TxOut
fromCardanoTxOutToPV1TxInfoTxOut (C.TxOut AddressInEra era
addr TxOutValue era
value TxOutDatum CtxTx era
datumHash ReferenceScript era
_) =
    Address -> Value -> Maybe DatumHash -> TxOut
PV1.TxOut
    (AddressInEra era -> Address
forall era. AddressInEra era -> Address
fromCardanoAddressInEra AddressInEra era
addr)
    (TxOutValue era -> Value
forall era. TxOutValue era -> Value
fromCardanoTxOutValue TxOutValue era
value)
    (TxOutDatum CtxTx era -> Maybe DatumHash
forall era. TxOutDatum CtxTx era -> Maybe DatumHash
fromCardanoTxOutDatumHash TxOutDatum CtxTx era
datumHash)

fromCardanoTxOutToPV2TxInfoTxOut :: C.TxOut C.CtxTx era -> PV2.TxOut
fromCardanoTxOutToPV2TxInfoTxOut :: TxOut CtxTx era -> TxOut
fromCardanoTxOutToPV2TxInfoTxOut (C.TxOut AddressInEra era
addr TxOutValue era
value TxOutDatum CtxTx era
datum ReferenceScript era
refScript) =
    Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut
PV2.TxOut
    (AddressInEra era -> Address
forall era. AddressInEra era -> Address
fromCardanoAddressInEra AddressInEra era
addr)
    (TxOutValue era -> Value
forall era. TxOutValue era -> Value
fromCardanoTxOutValue TxOutValue era
value)
    (TxOutDatum CtxTx era -> OutputDatum
forall era. TxOutDatum CtxTx era -> OutputDatum
fromCardanoTxOutDatum TxOutDatum CtxTx era
datum)
    (ReferenceScript era -> Maybe ScriptHash
forall era. ReferenceScript era -> Maybe ScriptHash
refScriptToScriptHash ReferenceScript era
refScript)

refScriptToScriptHash :: C.ReferenceScript era -> Maybe PV2.ScriptHash
refScriptToScriptHash :: ReferenceScript era -> Maybe ScriptHash
refScriptToScriptHash ReferenceScript era
C.ReferenceScriptNone = Maybe ScriptHash
forall a. Maybe a
Nothing
refScriptToScriptHash (C.ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ (C.ScriptInAnyLang ScriptLanguage lang
_ Script lang
s)) =
    let (PV2.ValidatorHash BuiltinByteString
h) = ScriptHash -> ValidatorHash
fromCardanoScriptHash (ScriptHash -> ValidatorHash) -> ScriptHash -> ValidatorHash
forall a b. (a -> b) -> a -> b
$ Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
C.hashScript Script lang
s
     in ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just (ScriptHash -> Maybe ScriptHash) -> ScriptHash -> Maybe ScriptHash
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> ScriptHash
PV2.ScriptHash BuiltinByteString
h

toCardanoTxOut
    :: C.NetworkId
    -> PV2.TxOut
    -> Either ToCardanoError (C.TxOut C.CtxTx C.BabbageEra)
toCardanoTxOut :: NetworkId
-> TxOut -> Either ToCardanoError (TxOut CtxTx BabbageEra)
toCardanoTxOut NetworkId
networkId (PV2.TxOut Address
addr Value
value OutputDatum
datum Maybe ScriptHash
_rsHash) =
    AddressInEra BabbageEra
-> TxOutValue BabbageEra
-> TxOutDatum CtxTx BabbageEra
-> ReferenceScript BabbageEra
-> TxOut CtxTx BabbageEra
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
C.TxOut (AddressInEra BabbageEra
 -> TxOutValue BabbageEra
 -> TxOutDatum CtxTx BabbageEra
 -> ReferenceScript BabbageEra
 -> TxOut CtxTx BabbageEra)
-> Either ToCardanoError (AddressInEra BabbageEra)
-> Either
     ToCardanoError
     (TxOutValue BabbageEra
      -> TxOutDatum CtxTx BabbageEra
      -> ReferenceScript BabbageEra
      -> TxOut CtxTx BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NetworkId
-> Address -> Either ToCardanoError (AddressInEra BabbageEra)
toCardanoAddressInEra NetworkId
networkId Address
addr
            Either
  ToCardanoError
  (TxOutValue BabbageEra
   -> TxOutDatum CtxTx BabbageEra
   -> ReferenceScript BabbageEra
   -> TxOut CtxTx BabbageEra)
-> Either ToCardanoError (TxOutValue BabbageEra)
-> Either
     ToCardanoError
     (TxOutDatum CtxTx BabbageEra
      -> ReferenceScript BabbageEra -> TxOut CtxTx BabbageEra)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Either ToCardanoError (TxOutValue BabbageEra)
toCardanoTxOutValue Value
value
            Either
  ToCardanoError
  (TxOutDatum CtxTx BabbageEra
   -> ReferenceScript BabbageEra -> TxOut CtxTx BabbageEra)
-> Either ToCardanoError (TxOutDatum CtxTx BabbageEra)
-> Either
     ToCardanoError
     (ReferenceScript BabbageEra -> TxOut CtxTx BabbageEra)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OutputDatum -> Either ToCardanoError (TxOutDatum CtxTx BabbageEra)
toCardanoTxOutDatum OutputDatum
datum
            Either
  ToCardanoError
  (ReferenceScript BabbageEra -> TxOut CtxTx BabbageEra)
-> Either ToCardanoError (ReferenceScript BabbageEra)
-> Either ToCardanoError (TxOut CtxTx BabbageEra)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReferenceScript BabbageEra
-> Either ToCardanoError (ReferenceScript BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReferenceScript BabbageEra
forall era. ReferenceScript era
C.ReferenceScriptNone -- Not possible from just a hash

{-# DEPRECATED fromCardanoAddressInEra "we now use Cardano address internally, if you need a plutus address use 'Ledger.Address.toPlutusAddress' "#-}
fromCardanoAddressInEra :: C.AddressInEra era -> P.Address
fromCardanoAddressInEra :: AddressInEra era -> Address
fromCardanoAddressInEra = AddressInEra era -> Address
forall era. AddressInEra era -> Address
P.toPlutusAddress

{-# DEPRECATED fromCardanoAddress "Shouldn't be used as we use Cardano address internally now" #-}
fromCardanoAddress :: C.Address addrtype -> P.Address
fromCardanoAddress :: Address addrtype -> Address
fromCardanoAddress (C.ByronAddress Address
address) =
    Credential -> Maybe StakingCredential -> Address
P.Address Credential
plutusCredential Maybe StakingCredential
forall a. Maybe a
Nothing
    where
      plutusCredential :: Credential.Credential
      plutusCredential :: Credential
plutusCredential =
          PubKeyHash -> Credential
Credential.PubKeyCredential
        (PubKeyHash -> Credential) -> PubKeyHash -> Credential
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> PubKeyHash
PV1.PubKeyHash
        (BuiltinByteString -> PubKeyHash)
-> BuiltinByteString -> PubKeyHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin
        (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Address -> ByteString
addrToBase58 Address
address
fromCardanoAddress (C.ShelleyAddress Network
_ PaymentCredential StandardCrypto
paymentCredential StakeReference StandardCrypto
stakeAddressReference) =
    Credential -> Maybe StakingCredential -> Address
P.Address (PaymentCredential -> Credential
fromCardanoPaymentCredential (PaymentCredential StandardCrypto -> PaymentCredential
C.fromShelleyPaymentCredential PaymentCredential StandardCrypto
paymentCredential))
        (Maybe StakingCredential -> Address)
-> Maybe StakingCredential -> Address
forall a b. (a -> b) -> a -> b
$ StakeAddressReference -> Maybe StakingCredential
fromCardanoStakeAddressReference (StakeReference StandardCrypto -> StakeAddressReference
C.fromShelleyStakeReference StakeReference StandardCrypto
stakeAddressReference)

toCardanoAddressInEra :: C.NetworkId -> P.Address -> Either ToCardanoError (C.AddressInEra C.BabbageEra)
toCardanoAddressInEra :: NetworkId
-> Address -> Either ToCardanoError (AddressInEra BabbageEra)
toCardanoAddressInEra NetworkId
networkId (P.Address Credential
addressCredential Maybe StakingCredential
addressStakingCredential) =
    AddressTypeInEra ShelleyAddr BabbageEra
-> Address ShelleyAddr -> AddressInEra BabbageEra
forall addrtype era.
AddressTypeInEra addrtype era
-> Address addrtype -> AddressInEra era
C.AddressInEra (ShelleyBasedEra BabbageEra
-> AddressTypeInEra ShelleyAddr BabbageEra
forall era. ShelleyBasedEra era -> AddressTypeInEra ShelleyAddr era
C.ShelleyAddressInEra ShelleyBasedEra BabbageEra
C.ShelleyBasedEraBabbage) (Address ShelleyAddr -> AddressInEra BabbageEra)
-> Either ToCardanoError (Address ShelleyAddr)
-> Either ToCardanoError (AddressInEra BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
C.makeShelleyAddress NetworkId
networkId
            (PaymentCredential -> StakeAddressReference -> Address ShelleyAddr)
-> Either ToCardanoError PaymentCredential
-> Either
     ToCardanoError (StakeAddressReference -> Address ShelleyAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential -> Either ToCardanoError PaymentCredential
toCardanoPaymentCredential Credential
addressCredential
            Either
  ToCardanoError (StakeAddressReference -> Address ShelleyAddr)
-> Either ToCardanoError StakeAddressReference
-> Either ToCardanoError (Address ShelleyAddr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe StakingCredential
-> Either ToCardanoError StakeAddressReference
toCardanoStakeAddressReference Maybe StakingCredential
addressStakingCredential)

{-# DEPRECATED fromCardanoPaymentCredential "Shouldn't be used as we use Cardano address internally now" #-}
fromCardanoPaymentCredential :: C.PaymentCredential -> Credential.Credential
fromCardanoPaymentCredential :: PaymentCredential -> Credential
fromCardanoPaymentCredential (C.PaymentCredentialByKey Hash PaymentKey
paymentKeyHash) = PubKeyHash -> Credential
Credential.PubKeyCredential (Hash PaymentKey -> PubKeyHash
fromCardanoPaymentKeyHash Hash PaymentKey
paymentKeyHash)
fromCardanoPaymentCredential (C.PaymentCredentialByScript ScriptHash
scriptHash) = ValidatorHash -> Credential
Credential.ScriptCredential (ScriptHash -> ValidatorHash
fromCardanoScriptHash ScriptHash
scriptHash)

toCardanoPaymentCredential :: Credential.Credential -> Either ToCardanoError C.PaymentCredential
toCardanoPaymentCredential :: Credential -> Either ToCardanoError PaymentCredential
toCardanoPaymentCredential (Credential.PubKeyCredential PubKeyHash
pubKeyHash) = Hash PaymentKey -> PaymentCredential
C.PaymentCredentialByKey (Hash PaymentKey -> PaymentCredential)
-> Either ToCardanoError (Hash PaymentKey)
-> Either ToCardanoError PaymentCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PaymentPubKeyHash -> Either ToCardanoError (Hash PaymentKey)
toCardanoPaymentKeyHash (PubKeyHash -> PaymentPubKeyHash
P.PaymentPubKeyHash PubKeyHash
pubKeyHash)
toCardanoPaymentCredential (Credential.ScriptCredential ValidatorHash
validatorHash) = ScriptHash -> PaymentCredential
C.PaymentCredentialByScript (ScriptHash -> PaymentCredential)
-> Either ToCardanoError ScriptHash
-> Either ToCardanoError PaymentCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValidatorHash -> Either ToCardanoError ScriptHash
toCardanoScriptHash ValidatorHash
validatorHash

{-# DEPRECATED fromCardanoPaymentKeyHash "Shouldn't be used as we use Cardano address internally now" #-}
fromCardanoPaymentKeyHash :: C.Hash C.PaymentKey -> PV1.PubKeyHash
fromCardanoPaymentKeyHash :: Hash PaymentKey -> PubKeyHash
fromCardanoPaymentKeyHash Hash PaymentKey
paymentKeyHash = BuiltinByteString -> PubKeyHash
PV1.PubKeyHash (BuiltinByteString -> PubKeyHash)
-> BuiltinByteString -> PubKeyHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Hash PaymentKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes Hash PaymentKey
paymentKeyHash

toCardanoPaymentKeyHash :: P.PaymentPubKeyHash -> Either ToCardanoError (C.Hash C.PaymentKey)
toCardanoPaymentKeyHash :: PaymentPubKeyHash -> Either ToCardanoError (Hash PaymentKey)
toCardanoPaymentKeyHash (P.PaymentPubKeyHash (PV1.PubKeyHash BuiltinByteString
bs)) =
    let bsx :: ByteString
bsx = BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
bs
        tg :: String
tg = String
"toCardanoPaymentKeyHash (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bsx) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" bytes)"
    in String
-> Either ToCardanoError (Hash PaymentKey)
-> Either ToCardanoError (Hash PaymentKey)
forall t.
String -> Either ToCardanoError t -> Either ToCardanoError t
tag String
tg (Either ToCardanoError (Hash PaymentKey)
 -> Either ToCardanoError (Hash PaymentKey))
-> Either ToCardanoError (Hash PaymentKey)
-> Either ToCardanoError (Hash PaymentKey)
forall a b. (a -> b) -> a -> b
$ AsType (Hash PaymentKey)
-> ByteString -> Either ToCardanoError (Hash PaymentKey)
forall t.
SerialiseAsRawBytes t =>
AsType t -> ByteString -> Either ToCardanoError t
deserialiseFromRawBytes (AsType PaymentKey -> AsType (Hash PaymentKey)
forall a. AsType a -> AsType (Hash a)
C.AsHash AsType PaymentKey
C.AsPaymentKey) ByteString
bsx

{-# DEPRECATED fromCardanoScriptHash "Shouldn't be used as we use Cardano address internally now" #-}
fromCardanoScriptHash :: C.ScriptHash -> P.ValidatorHash
fromCardanoScriptHash :: ScriptHash -> ValidatorHash
fromCardanoScriptHash ScriptHash
scriptHash = BuiltinByteString -> ValidatorHash
P.ValidatorHash (BuiltinByteString -> ValidatorHash)
-> BuiltinByteString -> ValidatorHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ ScriptHash -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes ScriptHash
scriptHash

toCardanoScriptHash :: P.ValidatorHash -> Either ToCardanoError C.ScriptHash
toCardanoScriptHash :: ValidatorHash -> Either ToCardanoError ScriptHash
toCardanoScriptHash (P.ValidatorHash BuiltinByteString
bs) = String
-> Either ToCardanoError ScriptHash
-> Either ToCardanoError ScriptHash
forall t.
String -> Either ToCardanoError t -> Either ToCardanoError t
tag String
"toCardanoScriptHash" (Either ToCardanoError ScriptHash
 -> Either ToCardanoError ScriptHash)
-> Either ToCardanoError ScriptHash
-> Either ToCardanoError ScriptHash
forall a b. (a -> b) -> a -> b
$ AsType ScriptHash -> ByteString -> Either ToCardanoError ScriptHash
forall t.
SerialiseAsRawBytes t =>
AsType t -> ByteString -> Either ToCardanoError t
deserialiseFromRawBytes AsType ScriptHash
C.AsScriptHash (ByteString -> Either ToCardanoError ScriptHash)
-> ByteString -> Either ToCardanoError ScriptHash
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
bs

{-# DEPRECATED fromCardanoStakeAddressReference "Shouldn't be used as we use Cardano address internally now" #-}
fromCardanoStakeAddressReference :: C.StakeAddressReference -> Maybe Credential.StakingCredential
fromCardanoStakeAddressReference :: StakeAddressReference -> Maybe StakingCredential
fromCardanoStakeAddressReference StakeAddressReference
C.NoStakeAddress = Maybe StakingCredential
forall a. Maybe a
Nothing
fromCardanoStakeAddressReference (C.StakeAddressByValue StakeCredential
stakeCredential) =
    StakingCredential -> Maybe StakingCredential
forall a. a -> Maybe a
Just (Credential -> StakingCredential
Credential.StakingHash (Credential -> StakingCredential)
-> Credential -> StakingCredential
forall a b. (a -> b) -> a -> b
$ StakeCredential -> Credential
fromCardanoStakeCredential StakeCredential
stakeCredential)
fromCardanoStakeAddressReference C.StakeAddressByPointer{} = Maybe StakingCredential
forall a. Maybe a
Nothing

toCardanoStakeAddressReference :: Maybe Credential.StakingCredential -> Either ToCardanoError C.StakeAddressReference
toCardanoStakeAddressReference :: Maybe StakingCredential
-> Either ToCardanoError StakeAddressReference
toCardanoStakeAddressReference Maybe StakingCredential
Nothing = StakeAddressReference
-> Either ToCardanoError StakeAddressReference
forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeAddressReference
C.NoStakeAddress
toCardanoStakeAddressReference (Just (Credential.StakingHash Credential
credential)) =
    StakeCredential -> StakeAddressReference
C.StakeAddressByValue (StakeCredential -> StakeAddressReference)
-> Either ToCardanoError StakeCredential
-> Either ToCardanoError StakeAddressReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential -> Either ToCardanoError StakeCredential
toCardanoStakeCredential Credential
credential
toCardanoStakeAddressReference (Just Credential.StakingPtr{}) = ToCardanoError -> Either ToCardanoError StakeAddressReference
forall a b. a -> Either a b
Left ToCardanoError
StakingPointersNotSupported

{-# DEPRECATED fromCardanoStakeCredential "Shouldn't be used as we use Cardano address internally now" #-}
fromCardanoStakeCredential :: C.StakeCredential -> Credential.Credential
fromCardanoStakeCredential :: StakeCredential -> Credential
fromCardanoStakeCredential (C.StakeCredentialByKey Hash StakeKey
stakeKeyHash) = PubKeyHash -> Credential
Credential.PubKeyCredential (Hash StakeKey -> PubKeyHash
fromCardanoStakeKeyHash Hash StakeKey
stakeKeyHash)
fromCardanoStakeCredential (C.StakeCredentialByScript ScriptHash
scriptHash) = ValidatorHash -> Credential
Credential.ScriptCredential (ScriptHash -> ValidatorHash
fromCardanoScriptHash ScriptHash
scriptHash)

toCardanoStakeCredential :: Credential.Credential -> Either ToCardanoError C.StakeCredential
toCardanoStakeCredential :: Credential -> Either ToCardanoError StakeCredential
toCardanoStakeCredential (Credential.PubKeyCredential PubKeyHash
pubKeyHash) = Hash StakeKey -> StakeCredential
C.StakeCredentialByKey (Hash StakeKey -> StakeCredential)
-> Either ToCardanoError (Hash StakeKey)
-> Either ToCardanoError StakeCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PubKeyHash -> Either ToCardanoError (Hash StakeKey)
toCardanoStakeKeyHash PubKeyHash
pubKeyHash
toCardanoStakeCredential (Credential.ScriptCredential ValidatorHash
validatorHash) = ScriptHash -> StakeCredential
C.StakeCredentialByScript (ScriptHash -> StakeCredential)
-> Either ToCardanoError ScriptHash
-> Either ToCardanoError StakeCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValidatorHash -> Either ToCardanoError ScriptHash
toCardanoScriptHash ValidatorHash
validatorHash

fromCardanoStakeKeyHash :: C.Hash C.StakeKey -> PV1.PubKeyHash
fromCardanoStakeKeyHash :: Hash StakeKey -> PubKeyHash
fromCardanoStakeKeyHash Hash StakeKey
stakeKeyHash = BuiltinByteString -> PubKeyHash
PV1.PubKeyHash (BuiltinByteString -> PubKeyHash)
-> BuiltinByteString -> PubKeyHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ Hash StakeKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes Hash StakeKey
stakeKeyHash

toCardanoStakeKeyHash :: PV1.PubKeyHash -> Either ToCardanoError (C.Hash C.StakeKey)
toCardanoStakeKeyHash :: PubKeyHash -> Either ToCardanoError (Hash StakeKey)
toCardanoStakeKeyHash (PV1.PubKeyHash BuiltinByteString
bs) = String
-> Either ToCardanoError (Hash StakeKey)
-> Either ToCardanoError (Hash StakeKey)
forall t.
String -> Either ToCardanoError t -> Either ToCardanoError t
tag String
"toCardanoStakeKeyHash" (Either ToCardanoError (Hash StakeKey)
 -> Either ToCardanoError (Hash StakeKey))
-> Either ToCardanoError (Hash StakeKey)
-> Either ToCardanoError (Hash StakeKey)
forall a b. (a -> b) -> a -> b
$ AsType (Hash StakeKey)
-> ByteString -> Either ToCardanoError (Hash StakeKey)
forall t.
SerialiseAsRawBytes t =>
AsType t -> ByteString -> Either ToCardanoError t
deserialiseFromRawBytes (AsType StakeKey -> AsType (Hash StakeKey)
forall a. AsType a -> AsType (Hash a)
C.AsHash AsType StakeKey
C.AsStakeKey) (BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
bs)

fromCardanoTxOutValue :: C.TxOutValue era -> PV1.Value
fromCardanoTxOutValue :: TxOutValue era -> Value
fromCardanoTxOutValue (C.TxOutAdaOnly OnlyAdaSupportedInEra era
_ Lovelace
lovelace) = Lovelace -> Value
fromCardanoLovelace Lovelace
lovelace
fromCardanoTxOutValue (C.TxOutValue MultiAssetSupportedInEra era
_ Value
value)      = Value -> Value
fromCardanoValue Value
value

toCardanoTxOutValue :: PV1.Value -> Either ToCardanoError (C.TxOutValue C.BabbageEra)
toCardanoTxOutValue :: Value -> Either ToCardanoError (TxOutValue BabbageEra)
toCardanoTxOutValue Value
value = MultiAssetSupportedInEra BabbageEra
-> Value -> TxOutValue BabbageEra
forall era. MultiAssetSupportedInEra era -> Value -> TxOutValue era
C.TxOutValue MultiAssetSupportedInEra BabbageEra
C.MultiAssetInBabbageEra (Value -> TxOutValue BabbageEra)
-> Either ToCardanoError Value
-> Either ToCardanoError (TxOutValue BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either ToCardanoError Value
toCardanoValue Value
value

fromCardanoTxOutDatumHash :: C.TxOutDatum C.CtxTx era -> Maybe P.DatumHash
fromCardanoTxOutDatumHash :: TxOutDatum CtxTx era -> Maybe DatumHash
fromCardanoTxOutDatumHash TxOutDatum CtxTx era
C.TxOutDatumNone       = Maybe DatumHash
forall a. Maybe a
Nothing
fromCardanoTxOutDatumHash (C.TxOutDatumHash ScriptDataSupportedInEra era
_ Hash ScriptData
h) =
    DatumHash -> Maybe DatumHash
forall a. a -> Maybe a
Just (DatumHash -> Maybe DatumHash) -> DatumHash -> Maybe DatumHash
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> DatumHash
P.DatumHash (BuiltinByteString -> DatumHash) -> BuiltinByteString -> DatumHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (Hash ScriptData -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes Hash ScriptData
h)
fromCardanoTxOutDatumHash (C.TxOutDatumInTx ScriptDataSupportedInEra era
_ ScriptData
d) =
    DatumHash -> Maybe DatumHash
forall a. a -> Maybe a
Just (DatumHash -> Maybe DatumHash) -> DatumHash -> Maybe DatumHash
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> DatumHash
P.DatumHash (BuiltinByteString -> DatumHash) -> BuiltinByteString -> DatumHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (Hash ScriptData -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes (ScriptData -> Hash ScriptData
C.hashScriptData ScriptData
d))
fromCardanoTxOutDatumHash (C.TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ ScriptData
d) =
    DatumHash -> Maybe DatumHash
forall a. a -> Maybe a
Just (DatumHash -> Maybe DatumHash) -> DatumHash -> Maybe DatumHash
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> DatumHash
P.DatumHash (BuiltinByteString -> DatumHash) -> BuiltinByteString -> DatumHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (Hash ScriptData -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes (ScriptData -> Hash ScriptData
C.hashScriptData ScriptData
d))

fromCardanoTxOutDatum :: C.TxOutDatum C.CtxTx era -> PV2.OutputDatum
fromCardanoTxOutDatum :: TxOutDatum CtxTx era -> OutputDatum
fromCardanoTxOutDatum TxOutDatum CtxTx era
C.TxOutDatumNone       =
    OutputDatum
PV2.NoOutputDatum
fromCardanoTxOutDatum (C.TxOutDatumHash ScriptDataSupportedInEra era
_ Hash ScriptData
h) =
    DatumHash -> OutputDatum
PV2.OutputDatumHash (DatumHash -> OutputDatum) -> DatumHash -> OutputDatum
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> DatumHash
PV2.DatumHash (BuiltinByteString -> DatumHash) -> BuiltinByteString -> DatumHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (Hash ScriptData -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes Hash ScriptData
h)
fromCardanoTxOutDatum (C.TxOutDatumInTx ScriptDataSupportedInEra era
_ ScriptData
d) =
    DatumHash -> OutputDatum
PV2.OutputDatumHash (DatumHash -> OutputDatum) -> DatumHash -> OutputDatum
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> DatumHash
PV2.DatumHash (BuiltinByteString -> DatumHash) -> BuiltinByteString -> DatumHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (Hash ScriptData -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes (ScriptData -> Hash ScriptData
C.hashScriptData ScriptData
d))
fromCardanoTxOutDatum (C.TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ ScriptData
d) =
    Datum -> OutputDatum
PV2.OutputDatum (Datum -> OutputDatum) -> Datum -> OutputDatum
forall a b. (a -> b) -> a -> b
$ BuiltinData -> Datum
PV2.Datum (BuiltinData -> Datum) -> BuiltinData -> Datum
forall a b. (a -> b) -> a -> b
$ ScriptData -> BuiltinData
fromCardanoScriptData ScriptData
d

toCardanoTxOutNoDatum  :: C.TxOutDatum C.CtxTx C.BabbageEra
toCardanoTxOutNoDatum :: TxOutDatum CtxTx BabbageEra
toCardanoTxOutNoDatum = TxOutDatum CtxTx BabbageEra
forall ctx era. TxOutDatum ctx era
C.TxOutDatumNone

toCardanoTxOutDatumInTx :: PV2.Datum -> C.TxOutDatum C.CtxTx C.BabbageEra
toCardanoTxOutDatumInTx :: Datum -> TxOutDatum CtxTx BabbageEra
toCardanoTxOutDatumInTx =
    ScriptDataSupportedInEra BabbageEra
-> ScriptData -> TxOutDatum CtxTx BabbageEra
forall era.
ScriptDataSupportedInEra era -> ScriptData -> TxOutDatum CtxTx era
C.TxOutDatumInTx ScriptDataSupportedInEra BabbageEra
C.ScriptDataInBabbageEra (ScriptData -> TxOutDatum CtxTx BabbageEra)
-> (Datum -> ScriptData) -> Datum -> TxOutDatum CtxTx BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> ScriptData
C.fromPlutusData (Data -> ScriptData) -> (Datum -> Data) -> Datum -> ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Data
PV2.builtinDataToData (BuiltinData -> Data) -> (Datum -> BuiltinData) -> Datum -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> BuiltinData
PV2.getDatum

toCardanoTxOutDatumInline :: PV2.Datum -> C.TxOutDatum C.CtxTx C.BabbageEra
toCardanoTxOutDatumInline :: Datum -> TxOutDatum CtxTx BabbageEra
toCardanoTxOutDatumInline =
      ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
-> ScriptData -> TxOutDatum CtxTx BabbageEra
forall era ctx.
ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ScriptData -> TxOutDatum ctx era
C.TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
C.ReferenceTxInsScriptsInlineDatumsInBabbageEra
    (ScriptData -> TxOutDatum CtxTx BabbageEra)
-> (Datum -> ScriptData) -> Datum -> TxOutDatum CtxTx BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> ScriptData
C.fromPlutusData (Data -> ScriptData) -> (Datum -> Data) -> Datum -> ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Data
PV2.builtinDataToData (BuiltinData -> Data) -> (Datum -> BuiltinData) -> Datum -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> BuiltinData
PV2.getDatum

toCardanoTxOutDatumHashFromDatum :: PV2.Datum -> C.TxOutDatum ctx C.BabbageEra
toCardanoTxOutDatumHashFromDatum :: Datum -> TxOutDatum ctx BabbageEra
toCardanoTxOutDatumHashFromDatum =
      ScriptDataSupportedInEra BabbageEra
-> Hash ScriptData -> TxOutDatum ctx BabbageEra
forall era ctx.
ScriptDataSupportedInEra era
-> Hash ScriptData -> TxOutDatum ctx era
C.TxOutDatumHash ScriptDataSupportedInEra BabbageEra
C.ScriptDataInBabbageEra
    (Hash ScriptData -> TxOutDatum ctx BabbageEra)
-> (Datum -> Hash ScriptData) -> Datum -> TxOutDatum ctx BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptData -> Hash ScriptData
C.hashScriptData
    (ScriptData -> Hash ScriptData)
-> (Datum -> ScriptData) -> Datum -> Hash ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> ScriptData
C.fromPlutusData
    (Data -> ScriptData) -> (Datum -> Data) -> Datum -> ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Data
PV2.builtinDataToData
    (BuiltinData -> Data) -> (Datum -> BuiltinData) -> Datum -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> BuiltinData
PV2.getDatum

toCardanoTxOutDatumHash :: P.DatumHash -> Either ToCardanoError (C.TxOutDatum ctx C.BabbageEra)
toCardanoTxOutDatumHash :: DatumHash -> Either ToCardanoError (TxOutDatum ctx BabbageEra)
toCardanoTxOutDatumHash DatumHash
datumHash = ScriptDataSupportedInEra BabbageEra
-> Hash ScriptData -> TxOutDatum ctx BabbageEra
forall era ctx.
ScriptDataSupportedInEra era
-> Hash ScriptData -> TxOutDatum ctx era
C.TxOutDatumHash ScriptDataSupportedInEra BabbageEra
C.ScriptDataInBabbageEra (Hash ScriptData -> TxOutDatum ctx BabbageEra)
-> Either ToCardanoError (Hash ScriptData)
-> Either ToCardanoError (TxOutDatum ctx BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatumHash -> Either ToCardanoError (Hash ScriptData)
toCardanoScriptDataHash DatumHash
datumHash

toCardanoTxOutDatum :: PV2.OutputDatum -> Either ToCardanoError (C.TxOutDatum C.CtxTx C.BabbageEra)
toCardanoTxOutDatum :: OutputDatum -> Either ToCardanoError (TxOutDatum CtxTx BabbageEra)
toCardanoTxOutDatum OutputDatum
PV2.NoOutputDatum        = TxOutDatum CtxTx BabbageEra
-> Either ToCardanoError (TxOutDatum CtxTx BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxOutDatum CtxTx BabbageEra
toCardanoTxOutNoDatum
toCardanoTxOutDatum (PV2.OutputDatum Datum
d)      = TxOutDatum CtxTx BabbageEra
-> Either ToCardanoError (TxOutDatum CtxTx BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOutDatum CtxTx BabbageEra
 -> Either ToCardanoError (TxOutDatum CtxTx BabbageEra))
-> TxOutDatum CtxTx BabbageEra
-> Either ToCardanoError (TxOutDatum CtxTx BabbageEra)
forall a b. (a -> b) -> a -> b
$ Datum -> TxOutDatum CtxTx BabbageEra
toCardanoTxOutDatumInline Datum
d
toCardanoTxOutDatum (PV2.OutputDatumHash DatumHash
dh) = DatumHash -> Either ToCardanoError (TxOutDatum CtxTx BabbageEra)
forall ctx.
DatumHash -> Either ToCardanoError (TxOutDatum ctx BabbageEra)
toCardanoTxOutDatumHash DatumHash
dh

toCardanoScriptDataHash :: P.DatumHash -> Either ToCardanoError (C.Hash C.ScriptData)
toCardanoScriptDataHash :: DatumHash -> Either ToCardanoError (Hash ScriptData)
toCardanoScriptDataHash (P.DatumHash BuiltinByteString
bs) =
    String
-> Either ToCardanoError (Hash ScriptData)
-> Either ToCardanoError (Hash ScriptData)
forall t.
String -> Either ToCardanoError t -> Either ToCardanoError t
tag String
"toCardanoTxOutDatumHash" (AsType (Hash ScriptData)
-> ByteString -> Either ToCardanoError (Hash ScriptData)
forall t.
SerialiseAsRawBytes t =>
AsType t -> ByteString -> Either ToCardanoError t
deserialiseFromRawBytes (AsType ScriptData -> AsType (Hash ScriptData)
forall a. AsType a -> AsType (Hash a)
C.AsHash AsType ScriptData
C.AsScriptData) (BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
bs))

fromCardanoMintValue :: C.TxMintValue build era -> PV1.Value
fromCardanoMintValue :: TxMintValue build era -> Value
fromCardanoMintValue TxMintValue build era
C.TxMintNone              = Value
forall a. Monoid a => a
mempty
fromCardanoMintValue (C.TxMintValue MultiAssetSupportedInEra era
_ Value
value BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era))
_) = Value -> Value
fromCardanoValue Value
value


adaToCardanoValue :: P.Ada -> C.Value
adaToCardanoValue :: Ada -> Value
adaToCardanoValue (P.Lovelace Integer
n) = [(AssetId, Quantity)] -> Value
C.valueFromList [(AssetId
C.AdaAssetId, Integer -> Quantity
C.Quantity Integer
n)]

fromCardanoValue :: C.Value -> Value.Value
fromCardanoValue :: Value -> Value
fromCardanoValue (Value -> [(AssetId, Quantity)]
C.valueToList -> [(AssetId, Quantity)]
list) =
    ((AssetId, Quantity) -> Value) -> [(AssetId, Quantity)] -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (AssetId, Quantity) -> Value
fromSingleton [(AssetId, Quantity)]
list
  where
    fromSingleton :: (AssetId, Quantity) -> Value
fromSingleton (AssetId -> AssetClass
fromCardanoAssetId -> AssetClass
assetClass, C.Quantity Integer
quantity) =
        AssetClass -> Integer -> Value
Value.assetClassValue AssetClass
assetClass Integer
quantity

toCardanoValue :: Value.Value -> Either ToCardanoError C.Value
toCardanoValue :: Value -> Either ToCardanoError Value
toCardanoValue =
    ([(AssetId, Quantity)] -> Value)
-> Either ToCardanoError [(AssetId, Quantity)]
-> Either ToCardanoError Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(AssetId, Quantity)] -> Value
C.valueFromList (Either ToCardanoError [(AssetId, Quantity)]
 -> Either ToCardanoError Value)
-> (Value -> Either ToCardanoError [(AssetId, Quantity)])
-> Value
-> Either ToCardanoError Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CurrencySymbol, TokenName, Integer)
 -> Either ToCardanoError (AssetId, Quantity))
-> [(CurrencySymbol, TokenName, Integer)]
-> Either ToCardanoError [(AssetId, Quantity)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (CurrencySymbol, TokenName, Integer)
-> Either ToCardanoError (AssetId, Quantity)
toSingleton ([(CurrencySymbol, TokenName, Integer)]
 -> Either ToCardanoError [(AssetId, Quantity)])
-> (Value -> [(CurrencySymbol, TokenName, Integer)])
-> Value
-> Either ToCardanoError [(AssetId, Quantity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [(CurrencySymbol, TokenName, Integer)]
Value.flattenValue
  where
    toSingleton :: (CurrencySymbol, TokenName, Integer)
-> Either ToCardanoError (AssetId, Quantity)
toSingleton (CurrencySymbol
cs, TokenName
tn, Integer
q) =
        AssetClass -> Either ToCardanoError AssetId
toCardanoAssetId (CurrencySymbol -> TokenName -> AssetClass
Value.assetClass CurrencySymbol
cs TokenName
tn) Either ToCardanoError AssetId
-> (AssetId -> (AssetId, Quantity))
-> Either ToCardanoError (AssetId, Quantity)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (, Integer -> Quantity
C.Quantity Integer
q)

fromCardanoPolicyId :: C.PolicyId -> P.MintingPolicyHash
fromCardanoPolicyId :: PolicyId -> MintingPolicyHash
fromCardanoPolicyId (C.PolicyId ScriptHash
scriptHash) = BuiltinByteString -> MintingPolicyHash
P.MintingPolicyHash (BuiltinByteString -> MintingPolicyHash)
-> BuiltinByteString -> MintingPolicyHash
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin (ScriptHash -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes ScriptHash
scriptHash)

toCardanoPolicyId :: P.MintingPolicyHash -> Either ToCardanoError C.PolicyId
toCardanoPolicyId :: MintingPolicyHash -> Either ToCardanoError PolicyId
toCardanoPolicyId (P.MintingPolicyHash BuiltinByteString
bs) =
    String
-> Either ToCardanoError PolicyId -> Either ToCardanoError PolicyId
forall t.
String -> Either ToCardanoError t -> Either ToCardanoError t
tag String
"toCardanoPolicyId" (Either ToCardanoError PolicyId -> Either ToCardanoError PolicyId)
-> Either ToCardanoError PolicyId -> Either ToCardanoError PolicyId
forall a b. (a -> b) -> a -> b
$
        String
-> Either ToCardanoError PolicyId -> Either ToCardanoError PolicyId
forall t.
String -> Either ToCardanoError t -> Either ToCardanoError t
tag (Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length (BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
bs)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" bytes")
            (AsType PolicyId -> ByteString -> Either ToCardanoError PolicyId
forall t.
SerialiseAsRawBytes t =>
AsType t -> ByteString -> Either ToCardanoError t
deserialiseFromRawBytes AsType PolicyId
C.AsPolicyId (BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
bs))

fromCardanoAssetName :: C.AssetName -> Value.TokenName
fromCardanoAssetName :: AssetName -> TokenName
fromCardanoAssetName (C.AssetName ByteString
bs) = BuiltinByteString -> TokenName
Value.TokenName (BuiltinByteString -> TokenName) -> BuiltinByteString -> TokenName
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
PlutusTx.toBuiltin ByteString
bs

toCardanoAssetName :: Value.TokenName -> Either ToCardanoError C.AssetName
toCardanoAssetName :: TokenName -> Either ToCardanoError AssetName
toCardanoAssetName (Value.TokenName BuiltinByteString
bs) =
    String
-> Either ToCardanoError AssetName
-> Either ToCardanoError AssetName
forall t.
String -> Either ToCardanoError t -> Either ToCardanoError t
tag String
"toCardanoAssetName" (Either ToCardanoError AssetName
 -> Either ToCardanoError AssetName)
-> Either ToCardanoError AssetName
-> Either ToCardanoError AssetName
forall a b. (a -> b) -> a -> b
$
        String
-> Either ToCardanoError AssetName
-> Either ToCardanoError AssetName
forall t.
String -> Either ToCardanoError t -> Either ToCardanoError t
tag (Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length (BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
bs)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" bytes")
            (AsType AssetName -> ByteString -> Either ToCardanoError AssetName
forall t.
SerialiseAsRawBytes t =>
AsType t -> ByteString -> Either ToCardanoError t
deserialiseFromRawBytes AsType AssetName
C.AsAssetName (BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
bs))

fromCardanoAssetId :: C.AssetId -> Value.AssetClass
fromCardanoAssetId :: AssetId -> AssetClass
fromCardanoAssetId AssetId
C.AdaAssetId = CurrencySymbol -> TokenName -> AssetClass
Value.assetClass CurrencySymbol
Ada.adaSymbol TokenName
Ada.adaToken
fromCardanoAssetId (C.AssetId PolicyId
policyId AssetName
assetName) =
    CurrencySymbol -> TokenName -> AssetClass
Value.assetClass
        (MintingPolicyHash -> CurrencySymbol
Value.mpsSymbol (MintingPolicyHash -> CurrencySymbol)
-> (PolicyId -> MintingPolicyHash) -> PolicyId -> CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolicyId -> MintingPolicyHash
fromCardanoPolicyId (PolicyId -> CurrencySymbol) -> PolicyId -> CurrencySymbol
forall a b. (a -> b) -> a -> b
$ PolicyId
policyId)
        (AssetName -> TokenName
fromCardanoAssetName AssetName
assetName)

toCardanoAssetId :: Value.AssetClass -> Either ToCardanoError C.AssetId
toCardanoAssetId :: AssetClass -> Either ToCardanoError AssetId
toCardanoAssetId (Value.AssetClass (CurrencySymbol
currencySymbol, TokenName
tokenName))
    | CurrencySymbol
currencySymbol CurrencySymbol -> CurrencySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CurrencySymbol
Ada.adaSymbol Bool -> Bool -> Bool
&& TokenName
tokenName TokenName -> TokenName -> Bool
forall a. Eq a => a -> a -> Bool
== TokenName
Ada.adaToken =
        AssetId -> Either ToCardanoError AssetId
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssetId
C.AdaAssetId
    | Bool
otherwise =
        PolicyId -> AssetName -> AssetId
C.AssetId
            (PolicyId -> AssetName -> AssetId)
-> Either ToCardanoError PolicyId
-> Either ToCardanoError (AssetName -> AssetId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MintingPolicyHash -> Either ToCardanoError PolicyId
toCardanoPolicyId (CurrencySymbol -> MintingPolicyHash
Value.currencyMPSHash CurrencySymbol
currencySymbol)
            Either ToCardanoError (AssetName -> AssetId)
-> Either ToCardanoError AssetName -> Either ToCardanoError AssetId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TokenName -> Either ToCardanoError AssetName
toCardanoAssetName TokenName
tokenName

fromCardanoFee :: C.TxFee era -> PV1.Value
fromCardanoFee :: TxFee era -> Value
fromCardanoFee (C.TxFeeImplicit TxFeesImplicitInEra era
_)          = Value
forall a. Monoid a => a
mempty
fromCardanoFee (C.TxFeeExplicit TxFeesExplicitInEra era
_ Lovelace
lovelace) = Lovelace -> Value
fromCardanoLovelace Lovelace
lovelace

toCardanoFee :: PV1.Value -> Either ToCardanoError (C.TxFee C.BabbageEra)
toCardanoFee :: Value -> Either ToCardanoError (TxFee BabbageEra)
toCardanoFee Value
value = TxFeesExplicitInEra BabbageEra -> Lovelace -> TxFee BabbageEra
forall era. TxFeesExplicitInEra era -> Lovelace -> TxFee era
C.TxFeeExplicit TxFeesExplicitInEra BabbageEra
C.TxFeesExplicitInBabbageEra (Lovelace -> TxFee BabbageEra)
-> Either ToCardanoError Lovelace
-> Either ToCardanoError (TxFee BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either ToCardanoError Lovelace
toCardanoLovelace Value
value

fromCardanoLovelace :: C.Lovelace -> PV1.Value
fromCardanoLovelace :: Lovelace -> Value
fromCardanoLovelace (Lovelace -> Quantity
C.lovelaceToQuantity -> C.Quantity Integer
lovelace) = Integer -> Value
Ada.lovelaceValueOf Integer
lovelace

toCardanoLovelace :: PV1.Value -> Either ToCardanoError C.Lovelace
toCardanoLovelace :: Value -> Either ToCardanoError Lovelace
toCardanoLovelace Value
value =
    if Value
value Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Value
Ada.lovelaceValueOf Integer
lovelace
        then Lovelace -> Either ToCardanoError Lovelace
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lovelace -> Either ToCardanoError Lovelace)
-> (Integer -> Lovelace)
-> Integer
-> Either ToCardanoError Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity -> Lovelace
C.quantityToLovelace (Quantity -> Lovelace)
-> (Integer -> Quantity) -> Integer -> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Quantity
C.Quantity (Integer -> Either ToCardanoError Lovelace)
-> Integer -> Either ToCardanoError Lovelace
forall a b. (a -> b) -> a -> b
$ Integer
lovelace
        else ToCardanoError -> Either ToCardanoError Lovelace
forall a b. a -> Either a b
Left ToCardanoError
ValueNotPureAda
    where
        Ada.Lovelace Integer
lovelace = Value -> Ada
Ada.fromValue Value
value

fromCardanoValidityRange :: (C.TxValidityLowerBound era, C.TxValidityUpperBound era) -> P.SlotRange
fromCardanoValidityRange :: (TxValidityLowerBound era, TxValidityUpperBound era) -> SlotRange
fromCardanoValidityRange (TxValidityLowerBound era
l, TxValidityUpperBound era
u) = LowerBound Slot -> UpperBound Slot -> SlotRange
forall a. LowerBound a -> UpperBound a -> Interval a
PV1.Interval (TxValidityLowerBound era -> LowerBound Slot
forall era. TxValidityLowerBound era -> LowerBound Slot
fromCardanoValidityLowerBound TxValidityLowerBound era
l) (TxValidityUpperBound era -> UpperBound Slot
forall era. TxValidityUpperBound era -> UpperBound Slot
fromCardanoValidityUpperBound TxValidityUpperBound era
u)

toCardanoValidityRange
    :: P.SlotRange -> Either ToCardanoError (C.TxValidityLowerBound C.BabbageEra, C.TxValidityUpperBound C.BabbageEra)
toCardanoValidityRange :: SlotRange
-> Either
     ToCardanoError
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
toCardanoValidityRange (PV1.Interval LowerBound Slot
l UpperBound Slot
u) = (,) (TxValidityLowerBound BabbageEra
 -> TxValidityUpperBound BabbageEra
 -> (TxValidityLowerBound BabbageEra,
     TxValidityUpperBound BabbageEra))
-> Either ToCardanoError (TxValidityLowerBound BabbageEra)
-> Either
     ToCardanoError
     (TxValidityUpperBound BabbageEra
      -> (TxValidityLowerBound BabbageEra,
          TxValidityUpperBound BabbageEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LowerBound Slot
-> Either ToCardanoError (TxValidityLowerBound BabbageEra)
toCardanoValidityLowerBound LowerBound Slot
l Either
  ToCardanoError
  (TxValidityUpperBound BabbageEra
   -> (TxValidityLowerBound BabbageEra,
       TxValidityUpperBound BabbageEra))
-> Either ToCardanoError (TxValidityUpperBound BabbageEra)
-> Either
     ToCardanoError
     (TxValidityLowerBound BabbageEra, TxValidityUpperBound BabbageEra)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UpperBound Slot
-> Either ToCardanoError (TxValidityUpperBound BabbageEra)
toCardanoValidityUpperBound UpperBound Slot
u

fromCardanoValidityLowerBound :: C.TxValidityLowerBound era -> PV1.LowerBound P.Slot
fromCardanoValidityLowerBound :: TxValidityLowerBound era -> LowerBound Slot
fromCardanoValidityLowerBound TxValidityLowerBound era
C.TxValidityNoLowerBound = Extended Slot -> Bool -> LowerBound Slot
forall a. Extended a -> Bool -> LowerBound a
PV1.LowerBound Extended Slot
forall a. Extended a
PV1.NegInf Bool
True
fromCardanoValidityLowerBound (C.TxValidityLowerBound ValidityLowerBoundSupportedInEra era
_ SlotNo
slotNo) = Extended Slot -> Bool -> LowerBound Slot
forall a. Extended a -> Bool -> LowerBound a
PV1.LowerBound (Slot -> Extended Slot
forall a. a -> Extended a
PV1.Finite (Slot -> Extended Slot) -> Slot -> Extended Slot
forall a b. (a -> b) -> a -> b
$ SlotNo -> Slot
fromCardanoSlotNo SlotNo
slotNo) Bool
True

toCardanoValidityLowerBound :: PV1.LowerBound P.Slot -> Either ToCardanoError (C.TxValidityLowerBound C.BabbageEra)
toCardanoValidityLowerBound :: LowerBound Slot
-> Either ToCardanoError (TxValidityLowerBound BabbageEra)
toCardanoValidityLowerBound (PV1.LowerBound Extended Slot
PV1.NegInf Bool
_) = TxValidityLowerBound BabbageEra
-> Either ToCardanoError (TxValidityLowerBound BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxValidityLowerBound BabbageEra
forall era. TxValidityLowerBound era
C.TxValidityNoLowerBound
toCardanoValidityLowerBound (PV1.LowerBound (PV1.Finite Slot
slotNo) Bool
closed)
    = TxValidityLowerBound BabbageEra
-> Either ToCardanoError (TxValidityLowerBound BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxValidityLowerBound BabbageEra
 -> Either ToCardanoError (TxValidityLowerBound BabbageEra))
-> (Slot -> TxValidityLowerBound BabbageEra)
-> Slot
-> Either ToCardanoError (TxValidityLowerBound BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidityLowerBoundSupportedInEra BabbageEra
-> SlotNo -> TxValidityLowerBound BabbageEra
forall era.
ValidityLowerBoundSupportedInEra era
-> SlotNo -> TxValidityLowerBound era
C.TxValidityLowerBound ValidityLowerBoundSupportedInEra BabbageEra
C.ValidityLowerBoundInBabbageEra
    (SlotNo -> TxValidityLowerBound BabbageEra)
-> (Slot -> SlotNo) -> Slot -> TxValidityLowerBound BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slot -> SlotNo
toCardanoSlotNo
    (Slot -> Either ToCardanoError (TxValidityLowerBound BabbageEra))
-> Slot -> Either ToCardanoError (TxValidityLowerBound BabbageEra)
forall a b. (a -> b) -> a -> b
$ if Slot
slotNo Slot -> Slot -> Bool
forall a. Ord a => a -> a -> Bool
< Slot
0 then Slot
0 else if Bool
closed then Slot
slotNo else Slot
slotNo Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
+ Slot
1
toCardanoValidityLowerBound (PV1.LowerBound Extended Slot
PV1.PosInf Bool
_) = ToCardanoError
-> Either ToCardanoError (TxValidityLowerBound BabbageEra)
forall a b. a -> Either a b
Left ToCardanoError
InvalidValidityRange

fromCardanoValidityUpperBound :: C.TxValidityUpperBound era -> PV1.UpperBound P.Slot
fromCardanoValidityUpperBound :: TxValidityUpperBound era -> UpperBound Slot
fromCardanoValidityUpperBound (C.TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra era
_) = Extended Slot -> Bool -> UpperBound Slot
forall a. Extended a -> Bool -> UpperBound a
PV1.UpperBound Extended Slot
forall a. Extended a
PV1.PosInf Bool
True
fromCardanoValidityUpperBound (C.TxValidityUpperBound ValidityUpperBoundSupportedInEra era
_ SlotNo
slotNo) = Extended Slot -> Bool -> UpperBound Slot
forall a. Extended a -> Bool -> UpperBound a
PV1.UpperBound (Slot -> Extended Slot
forall a. a -> Extended a
PV1.Finite (Slot -> Extended Slot) -> Slot -> Extended Slot
forall a b. (a -> b) -> a -> b
$ SlotNo -> Slot
fromCardanoSlotNo SlotNo
slotNo) Bool
False

toCardanoValidityUpperBound :: PV1.UpperBound P.Slot -> Either ToCardanoError (C.TxValidityUpperBound C.BabbageEra)
toCardanoValidityUpperBound :: UpperBound Slot
-> Either ToCardanoError (TxValidityUpperBound BabbageEra)
toCardanoValidityUpperBound (PV1.UpperBound Extended Slot
PV1.PosInf Bool
_) = TxValidityUpperBound BabbageEra
-> Either ToCardanoError (TxValidityUpperBound BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxValidityUpperBound BabbageEra
 -> Either ToCardanoError (TxValidityUpperBound BabbageEra))
-> TxValidityUpperBound BabbageEra
-> Either ToCardanoError (TxValidityUpperBound BabbageEra)
forall a b. (a -> b) -> a -> b
$ ValidityNoUpperBoundSupportedInEra BabbageEra
-> TxValidityUpperBound BabbageEra
forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
C.TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra BabbageEra
C.ValidityNoUpperBoundInBabbageEra
toCardanoValidityUpperBound (PV1.UpperBound (PV1.Finite Slot
slotNo) Bool
closed)
    = TxValidityUpperBound BabbageEra
-> Either ToCardanoError (TxValidityUpperBound BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxValidityUpperBound BabbageEra
 -> Either ToCardanoError (TxValidityUpperBound BabbageEra))
-> (Slot -> TxValidityUpperBound BabbageEra)
-> Slot
-> Either ToCardanoError (TxValidityUpperBound BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidityUpperBoundSupportedInEra BabbageEra
-> SlotNo -> TxValidityUpperBound BabbageEra
forall era.
ValidityUpperBoundSupportedInEra era
-> SlotNo -> TxValidityUpperBound era
C.TxValidityUpperBound ValidityUpperBoundSupportedInEra BabbageEra
C.ValidityUpperBoundInBabbageEra (SlotNo -> TxValidityUpperBound BabbageEra)
-> (Slot -> SlotNo) -> Slot -> TxValidityUpperBound BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slot -> SlotNo
toCardanoSlotNo (Slot -> Either ToCardanoError (TxValidityUpperBound BabbageEra))
-> Slot -> Either ToCardanoError (TxValidityUpperBound BabbageEra)
forall a b. (a -> b) -> a -> b
$ if Bool
closed then Slot
slotNo Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
+ Slot
1 else Slot
slotNo
toCardanoValidityUpperBound (PV1.UpperBound Extended Slot
PV1.NegInf Bool
_) = ToCardanoError
-> Either ToCardanoError (TxValidityUpperBound BabbageEra)
forall a b. a -> Either a b
Left ToCardanoError
InvalidValidityRange

fromCardanoSlotNo :: C.SlotNo -> P.Slot
fromCardanoSlotNo :: SlotNo -> Slot
fromCardanoSlotNo (C.SlotNo Word64
w64) = Integer -> Slot
P.Slot (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
w64)

toCardanoSlotNo :: P.Slot -> C.SlotNo
toCardanoSlotNo :: Slot -> SlotNo
toCardanoSlotNo (P.Slot Integer
i) = Word64 -> SlotNo
C.SlotNo (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
i)

fromCardanoScriptData :: C.ScriptData -> PV1.BuiltinData
fromCardanoScriptData :: ScriptData -> BuiltinData
fromCardanoScriptData = Data -> BuiltinData
PV1.dataToBuiltinData (Data -> BuiltinData)
-> (ScriptData -> Data) -> ScriptData -> BuiltinData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptData -> Data
C.toPlutusData

toCardanoScriptData :: PV1.BuiltinData -> C.ScriptData
toCardanoScriptData :: BuiltinData -> ScriptData
toCardanoScriptData = Data -> ScriptData
C.fromPlutusData (Data -> ScriptData)
-> (BuiltinData -> Data) -> BuiltinData -> ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Data
PV1.builtinDataToData

fromCardanoScriptInEra :: C.ScriptInEra era -> Maybe (P.Versioned P.Script)
fromCardanoScriptInEra :: ScriptInEra era -> Maybe (Versioned Script)
fromCardanoScriptInEra (C.ScriptInEra ScriptLanguageInEra lang era
C.PlutusScriptV1InAlonzo (C.PlutusScript PlutusScriptVersion lang
C.PlutusScriptV1 PlutusScript lang
script)) =
    Versioned Script -> Maybe (Versioned Script)
forall a. a -> Maybe a
Just (Script -> Language -> Versioned Script
forall script. script -> Language -> Versioned script
P.Versioned (PlutusScript lang -> Script
forall lang. HasTypeProxy lang => PlutusScript lang -> Script
fromCardanoPlutusScript PlutusScript lang
script) Language
P.PlutusV1)
fromCardanoScriptInEra (C.ScriptInEra ScriptLanguageInEra lang era
C.PlutusScriptV1InBabbage (C.PlutusScript PlutusScriptVersion lang
C.PlutusScriptV1 PlutusScript lang
script)) =
    Versioned Script -> Maybe (Versioned Script)
forall a. a -> Maybe a
Just (Script -> Language -> Versioned Script
forall script. script -> Language -> Versioned script
P.Versioned (PlutusScript lang -> Script
forall lang. HasTypeProxy lang => PlutusScript lang -> Script
fromCardanoPlutusScript PlutusScript lang
script) Language
P.PlutusV1)
fromCardanoScriptInEra (C.ScriptInEra ScriptLanguageInEra lang era
C.PlutusScriptV2InBabbage (C.PlutusScript PlutusScriptVersion lang
C.PlutusScriptV2 PlutusScript lang
script)) =
    Versioned Script -> Maybe (Versioned Script)
forall a. a -> Maybe a
Just (Script -> Language -> Versioned Script
forall script. script -> Language -> Versioned script
P.Versioned (PlutusScript lang -> Script
forall lang. HasTypeProxy lang => PlutusScript lang -> Script
fromCardanoPlutusScript PlutusScript lang
script) Language
P.PlutusV2)
fromCardanoScriptInEra (C.ScriptInEra ScriptLanguageInEra lang era
_ C.SimpleScript{}) = Maybe (Versioned Script)
forall a. Maybe a
Nothing

toCardanoScriptInEra :: P.Versioned P.Script -> Either ToCardanoError (C.ScriptInEra C.BabbageEra)
toCardanoScriptInEra :: Versioned Script -> Either ToCardanoError (ScriptInEra BabbageEra)
toCardanoScriptInEra (P.Versioned Script
script Language
P.PlutusV1) = ScriptLanguageInEra PlutusScriptV1 BabbageEra
-> Script PlutusScriptV1 -> ScriptInEra BabbageEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
C.ScriptInEra ScriptLanguageInEra PlutusScriptV1 BabbageEra
C.PlutusScriptV1InBabbage (Script PlutusScriptV1 -> ScriptInEra BabbageEra)
-> (PlutusScript PlutusScriptV1 -> Script PlutusScriptV1)
-> PlutusScript PlutusScriptV1
-> ScriptInEra BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptVersion PlutusScriptV1
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
C.PlutusScript PlutusScriptVersion PlutusScriptV1
C.PlutusScriptV1 (PlutusScript PlutusScriptV1 -> ScriptInEra BabbageEra)
-> Either ToCardanoError (PlutusScript PlutusScriptV1)
-> Either ToCardanoError (ScriptInEra BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (PlutusScript PlutusScriptV1)
-> Script -> Either ToCardanoError (PlutusScript PlutusScriptV1)
forall plutusScript.
SerialiseAsRawBytes plutusScript =>
AsType plutusScript -> Script -> Either ToCardanoError plutusScript
toCardanoPlutusScript (AsType PlutusScriptV1 -> AsType (PlutusScript PlutusScriptV1)
forall lang. AsType lang -> AsType (PlutusScript lang)
C.AsPlutusScript AsType PlutusScriptV1
C.AsPlutusScriptV1) Script
script
toCardanoScriptInEra (P.Versioned Script
script Language
P.PlutusV2) = ScriptLanguageInEra PlutusScriptV2 BabbageEra
-> Script PlutusScriptV2 -> ScriptInEra BabbageEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
C.ScriptInEra ScriptLanguageInEra PlutusScriptV2 BabbageEra
C.PlutusScriptV2InBabbage (Script PlutusScriptV2 -> ScriptInEra BabbageEra)
-> (PlutusScript PlutusScriptV2 -> Script PlutusScriptV2)
-> PlutusScript PlutusScriptV2
-> ScriptInEra BabbageEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptVersion PlutusScriptV2
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
C.PlutusScript PlutusScriptVersion PlutusScriptV2
C.PlutusScriptV2 (PlutusScript PlutusScriptV2 -> ScriptInEra BabbageEra)
-> Either ToCardanoError (PlutusScript PlutusScriptV2)
-> Either ToCardanoError (ScriptInEra BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (PlutusScript PlutusScriptV2)
-> Script -> Either ToCardanoError (PlutusScript PlutusScriptV2)
forall plutusScript.
SerialiseAsRawBytes plutusScript =>
AsType plutusScript -> Script -> Either ToCardanoError plutusScript
toCardanoPlutusScript (AsType PlutusScriptV2 -> AsType (PlutusScript PlutusScriptV2)
forall lang. AsType lang -> AsType (PlutusScript lang)
C.AsPlutusScript AsType PlutusScriptV2
C.AsPlutusScriptV2) Script
script

fromCardanoPlutusScript :: C.HasTypeProxy lang => C.PlutusScript lang -> P.Script
fromCardanoPlutusScript :: PlutusScript lang -> Script
fromCardanoPlutusScript = ByteString -> Script
forall a. Serialise a => ByteString -> a
Codec.deserialise (ByteString -> Script)
-> (PlutusScript lang -> ByteString) -> PlutusScript lang -> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (PlutusScript lang -> ByteString)
-> PlutusScript lang
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScript lang -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes

toCardanoPlutusScript
    :: C.SerialiseAsRawBytes plutusScript
    => C.AsType plutusScript
    -> P.Script
    -> Either ToCardanoError plutusScript
toCardanoPlutusScript :: AsType plutusScript -> Script -> Either ToCardanoError plutusScript
toCardanoPlutusScript AsType plutusScript
asPlutusScriptType =
    String
-> Either ToCardanoError plutusScript
-> Either ToCardanoError plutusScript
forall t.
String -> Either ToCardanoError t -> Either ToCardanoError t
tag String
"toCardanoPlutusScript"
    (Either ToCardanoError plutusScript
 -> Either ToCardanoError plutusScript)
-> (Script -> Either ToCardanoError plutusScript)
-> Script
-> Either ToCardanoError plutusScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType plutusScript
-> ByteString -> Either ToCardanoError plutusScript
forall t.
SerialiseAsRawBytes t =>
AsType t -> ByteString -> Either ToCardanoError t
deserialiseFromRawBytes AsType plutusScript
asPlutusScriptType (ByteString -> Either ToCardanoError plutusScript)
-> (Script -> ByteString)
-> Script
-> Either ToCardanoError plutusScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Script -> ByteString) -> Script -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> ByteString
forall a. Serialise a => a -> ByteString
Codec.serialise

fromCardanoScriptInAnyLang :: C.ScriptInAnyLang -> Maybe (P.Versioned P.Script)
fromCardanoScriptInAnyLang :: ScriptInAnyLang -> Maybe (Versioned Script)
fromCardanoScriptInAnyLang (C.ScriptInAnyLang ScriptLanguage lang
_sl (C.SimpleScript SimpleScriptVersion lang
_ssv SimpleScript lang
_ss)) = Maybe (Versioned Script)
forall a. Maybe a
Nothing
fromCardanoScriptInAnyLang (C.ScriptInAnyLang ScriptLanguage lang
_sl (C.PlutusScript PlutusScriptVersion lang
psv PlutusScript lang
ps)) = Versioned Script -> Maybe (Versioned Script)
forall a. a -> Maybe a
Just (Versioned Script -> Maybe (Versioned Script))
-> Versioned Script -> Maybe (Versioned Script)
forall a b. (a -> b) -> a -> b
$ case PlutusScriptVersion lang
psv of
     PlutusScriptVersion lang
C.PlutusScriptV1 -> Script -> Language -> Versioned Script
forall script. script -> Language -> Versioned script
P.Versioned (PlutusScript lang -> Script
forall lang. HasTypeProxy lang => PlutusScript lang -> Script
fromCardanoPlutusScript PlutusScript lang
ps) Language
P.PlutusV1
     PlutusScriptVersion lang
C.PlutusScriptV2 -> Script -> Language -> Versioned Script
forall script. script -> Language -> Versioned script
P.Versioned (PlutusScript lang -> Script
forall lang. HasTypeProxy lang => PlutusScript lang -> Script
fromCardanoPlutusScript PlutusScript lang
ps) Language
P.PlutusV2

toCardanoScriptInAnyLang :: P.Versioned P.Script -> Either ToCardanoError C.ScriptInAnyLang
toCardanoScriptInAnyLang :: Versioned Script -> Either ToCardanoError ScriptInAnyLang
toCardanoScriptInAnyLang (P.Versioned Script
script Language
P.PlutusV1) =
  ScriptLanguage PlutusScriptV1
-> Script PlutusScriptV1 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
C.ScriptInAnyLang (PlutusScriptVersion PlutusScriptV1 -> ScriptLanguage PlutusScriptV1
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
C.PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
C.PlutusScriptV1) (Script PlutusScriptV1 -> ScriptInAnyLang)
-> (PlutusScript PlutusScriptV1 -> Script PlutusScriptV1)
-> PlutusScript PlutusScriptV1
-> ScriptInAnyLang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptVersion PlutusScriptV1
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
C.PlutusScript PlutusScriptVersion PlutusScriptV1
C.PlutusScriptV1
    (PlutusScript PlutusScriptV1 -> ScriptInAnyLang)
-> Either ToCardanoError (PlutusScript PlutusScriptV1)
-> Either ToCardanoError ScriptInAnyLang
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (PlutusScript PlutusScriptV1)
-> Script -> Either ToCardanoError (PlutusScript PlutusScriptV1)
forall plutusScript.
SerialiseAsRawBytes plutusScript =>
AsType plutusScript -> Script -> Either ToCardanoError plutusScript
toCardanoPlutusScript (AsType PlutusScriptV1 -> AsType (PlutusScript PlutusScriptV1)
forall lang. AsType lang -> AsType (PlutusScript lang)
C.AsPlutusScript AsType PlutusScriptV1
C.AsPlutusScriptV1) Script
script
toCardanoScriptInAnyLang (P.Versioned Script
script Language
P.PlutusV2) =
  ScriptLanguage PlutusScriptV2
-> Script PlutusScriptV2 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
C.ScriptInAnyLang (PlutusScriptVersion PlutusScriptV2 -> ScriptLanguage PlutusScriptV2
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
C.PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
C.PlutusScriptV2) (Script PlutusScriptV2 -> ScriptInAnyLang)
-> (PlutusScript PlutusScriptV2 -> Script PlutusScriptV2)
-> PlutusScript PlutusScriptV2
-> ScriptInAnyLang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptVersion PlutusScriptV2
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
C.PlutusScript PlutusScriptVersion PlutusScriptV2
C.PlutusScriptV2
    (PlutusScript PlutusScriptV2 -> ScriptInAnyLang)
-> Either ToCardanoError (PlutusScript PlutusScriptV2)
-> Either ToCardanoError ScriptInAnyLang
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (PlutusScript PlutusScriptV2)
-> Script -> Either ToCardanoError (PlutusScript PlutusScriptV2)
forall plutusScript.
SerialiseAsRawBytes plutusScript =>
AsType plutusScript -> Script -> Either ToCardanoError plutusScript
toCardanoPlutusScript (AsType PlutusScriptV2 -> AsType (PlutusScript PlutusScriptV2)
forall lang. AsType lang -> AsType (PlutusScript lang)
C.AsPlutusScript AsType PlutusScriptV2
C.AsPlutusScriptV2) Script
script

toCardanoReferenceScript :: Maybe (P.Versioned P.Script) -> Either ToCardanoError (C.ReferenceScript C.BabbageEra)
toCardanoReferenceScript :: Maybe (Versioned Script)
-> Either ToCardanoError (ReferenceScript BabbageEra)
toCardanoReferenceScript (Just Versioned Script
script) = ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
-> ScriptInAnyLang -> ReferenceScript BabbageEra
forall era.
ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ScriptInAnyLang -> ReferenceScript era
C.ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
C.ReferenceTxInsScriptsInlineDatumsInBabbageEra (ScriptInAnyLang -> ReferenceScript BabbageEra)
-> Either ToCardanoError ScriptInAnyLang
-> Either ToCardanoError (ReferenceScript BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned Script -> Either ToCardanoError ScriptInAnyLang
toCardanoScriptInAnyLang Versioned Script
script
toCardanoReferenceScript Maybe (Versioned Script)
Nothing = ReferenceScript BabbageEra
-> Either ToCardanoError (ReferenceScript BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReferenceScript BabbageEra
forall era. ReferenceScript era
C.ReferenceScriptNone

deserialiseFromRawBytes :: C.SerialiseAsRawBytes t => C.AsType t -> ByteString -> Either ToCardanoError t
deserialiseFromRawBytes :: AsType t -> ByteString -> Either ToCardanoError t
deserialiseFromRawBytes AsType t
asType = Either ToCardanoError t
-> (t -> Either ToCardanoError t)
-> Maybe t
-> Either ToCardanoError t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ToCardanoError -> Either ToCardanoError t
forall a b. a -> Either a b
Left ToCardanoError
DeserialisationError) t -> Either ToCardanoError t
forall a b. b -> Either a b
Right (Maybe t -> Either ToCardanoError t)
-> (ByteString -> Maybe t) -> ByteString -> Either ToCardanoError t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType t -> ByteString -> Maybe t
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
C.deserialiseFromRawBytes AsType t
asType

tag :: String -> Either ToCardanoError t -> Either ToCardanoError t
tag :: String -> Either ToCardanoError t -> Either ToCardanoError t
tag String
s = (ToCardanoError -> ToCardanoError)
-> Either ToCardanoError t -> Either ToCardanoError t
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> ToCardanoError -> ToCardanoError
Tag String
s)

data FromCardanoError
    = SimpleScriptsNotSupported
    deriving stock (Int -> FromCardanoError -> ShowS
[FromCardanoError] -> ShowS
FromCardanoError -> String
(Int -> FromCardanoError -> ShowS)
-> (FromCardanoError -> String)
-> ([FromCardanoError] -> ShowS)
-> Show FromCardanoError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromCardanoError] -> ShowS
$cshowList :: [FromCardanoError] -> ShowS
show :: FromCardanoError -> String
$cshow :: FromCardanoError -> String
showsPrec :: Int -> FromCardanoError -> ShowS
$cshowsPrec :: Int -> FromCardanoError -> ShowS
Show, FromCardanoError -> FromCardanoError -> Bool
(FromCardanoError -> FromCardanoError -> Bool)
-> (FromCardanoError -> FromCardanoError -> Bool)
-> Eq FromCardanoError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromCardanoError -> FromCardanoError -> Bool
$c/= :: FromCardanoError -> FromCardanoError -> Bool
== :: FromCardanoError -> FromCardanoError -> Bool
$c== :: FromCardanoError -> FromCardanoError -> Bool
Eq, (forall x. FromCardanoError -> Rep FromCardanoError x)
-> (forall x. Rep FromCardanoError x -> FromCardanoError)
-> Generic FromCardanoError
forall x. Rep FromCardanoError x -> FromCardanoError
forall x. FromCardanoError -> Rep FromCardanoError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FromCardanoError x -> FromCardanoError
$cfrom :: forall x. FromCardanoError -> Rep FromCardanoError x
Generic)
    deriving anyclass (Value -> Parser [FromCardanoError]
Value -> Parser FromCardanoError
(Value -> Parser FromCardanoError)
-> (Value -> Parser [FromCardanoError])
-> FromJSON FromCardanoError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FromCardanoError]
$cparseJSONList :: Value -> Parser [FromCardanoError]
parseJSON :: Value -> Parser FromCardanoError
$cparseJSON :: Value -> Parser FromCardanoError
FromJSON, [FromCardanoError] -> Encoding
[FromCardanoError] -> Value
FromCardanoError -> Encoding
FromCardanoError -> Value
(FromCardanoError -> Value)
-> (FromCardanoError -> Encoding)
-> ([FromCardanoError] -> Value)
-> ([FromCardanoError] -> Encoding)
-> ToJSON FromCardanoError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FromCardanoError] -> Encoding
$ctoEncodingList :: [FromCardanoError] -> Encoding
toJSONList :: [FromCardanoError] -> Value
$ctoJSONList :: [FromCardanoError] -> Value
toEncoding :: FromCardanoError -> Encoding
$ctoEncoding :: FromCardanoError -> Encoding
toJSON :: FromCardanoError -> Value
$ctoJSON :: FromCardanoError -> Value
ToJSON, TracingVerbosity -> FromCardanoError -> Object
FromCardanoError -> Object -> Text
(TracingVerbosity -> FromCardanoError -> Object)
-> (FromCardanoError -> Object -> Text)
-> ToObject FromCardanoError
forall a.
(TracingVerbosity -> a -> Object)
-> (a -> Object -> Text) -> ToObject a
textTransformer :: FromCardanoError -> Object -> Text
$ctextTransformer :: FromCardanoError -> Object -> Text
toObject :: TracingVerbosity -> FromCardanoError -> Object
$ctoObject :: TracingVerbosity -> FromCardanoError -> Object
ToObject)

instance Pretty FromCardanoError where
    pretty :: FromCardanoError -> Doc ann
pretty FromCardanoError
SimpleScriptsNotSupported        = Doc ann
"Simple scripts are not supported"

data ToCardanoError
    = TxBodyError String -- ^ A C.TxBodyError converted to String
    | DeserialisationError
    | InvalidValidityRange
    | ValueNotPureAda
    | OutputHasZeroAda
    | StakingPointersNotSupported
    | SimpleScriptsNotSupportedToCardano
    | MissingInputValidator
    | MissingDatum
    | MissingMintingPolicy
    | ScriptPurposeNotSupported PV1.ScriptTag
    | MissingMintingPolicyRedeemer
    | MissingStakeValidator
    | UnsupportedPlutusVersion P.Language
    | Tag String ToCardanoError
    deriving stock (Int -> ToCardanoError -> ShowS
[ToCardanoError] -> ShowS
ToCardanoError -> String
(Int -> ToCardanoError -> ShowS)
-> (ToCardanoError -> String)
-> ([ToCardanoError] -> ShowS)
-> Show ToCardanoError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToCardanoError] -> ShowS
$cshowList :: [ToCardanoError] -> ShowS
show :: ToCardanoError -> String
$cshow :: ToCardanoError -> String
showsPrec :: Int -> ToCardanoError -> ShowS
$cshowsPrec :: Int -> ToCardanoError -> ShowS
Show, ToCardanoError -> ToCardanoError -> Bool
(ToCardanoError -> ToCardanoError -> Bool)
-> (ToCardanoError -> ToCardanoError -> Bool) -> Eq ToCardanoError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ToCardanoError -> ToCardanoError -> Bool
$c/= :: ToCardanoError -> ToCardanoError -> Bool
== :: ToCardanoError -> ToCardanoError -> Bool
$c== :: ToCardanoError -> ToCardanoError -> Bool
Eq, (forall x. ToCardanoError -> Rep ToCardanoError x)
-> (forall x. Rep ToCardanoError x -> ToCardanoError)
-> Generic ToCardanoError
forall x. Rep ToCardanoError x -> ToCardanoError
forall x. ToCardanoError -> Rep ToCardanoError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ToCardanoError x -> ToCardanoError
$cfrom :: forall x. ToCardanoError -> Rep ToCardanoError x
Generic)
    deriving anyclass (Value -> Parser [ToCardanoError]
Value -> Parser ToCardanoError
(Value -> Parser ToCardanoError)
-> (Value -> Parser [ToCardanoError]) -> FromJSON ToCardanoError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ToCardanoError]
$cparseJSONList :: Value -> Parser [ToCardanoError]
parseJSON :: Value -> Parser ToCardanoError
$cparseJSON :: Value -> Parser ToCardanoError
FromJSON, [ToCardanoError] -> Encoding
[ToCardanoError] -> Value
ToCardanoError -> Encoding
ToCardanoError -> Value
(ToCardanoError -> Value)
-> (ToCardanoError -> Encoding)
-> ([ToCardanoError] -> Value)
-> ([ToCardanoError] -> Encoding)
-> ToJSON ToCardanoError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ToCardanoError] -> Encoding
$ctoEncodingList :: [ToCardanoError] -> Encoding
toJSONList :: [ToCardanoError] -> Value
$ctoJSONList :: [ToCardanoError] -> Value
toEncoding :: ToCardanoError -> Encoding
$ctoEncoding :: ToCardanoError -> Encoding
toJSON :: ToCardanoError -> Value
$ctoJSON :: ToCardanoError -> Value
ToJSON)

instance Pretty ToCardanoError where
    pretty :: ToCardanoError -> Doc ann
pretty (TxBodyError String
err)                  = Doc ann
"TxBodyError" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
err
    pretty ToCardanoError
DeserialisationError               = Doc ann
"ByteString deserialisation failed"
    pretty ToCardanoError
InvalidValidityRange               = Doc ann
"Invalid validity range"
    pretty ToCardanoError
ValueNotPureAda                    = Doc ann
"Fee values should only contain Ada"
    pretty ToCardanoError
OutputHasZeroAda                   = Doc ann
"Transaction outputs should not contain zero Ada"
    pretty ToCardanoError
StakingPointersNotSupported        = Doc ann
"Staking pointers are not supported"
    pretty ToCardanoError
SimpleScriptsNotSupportedToCardano = Doc ann
"Simple scripts are not supported"
    pretty ToCardanoError
MissingMintingPolicy               = Doc ann
"Missing minting policy"
    pretty (ScriptPurposeNotSupported ScriptTag
p)      = Doc ann
"Script purpose not supported:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ScriptTag -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow ScriptTag
p
    pretty ToCardanoError
MissingMintingPolicyRedeemer       = Doc ann
"Missing minting policy redeemer"
    pretty (UnsupportedPlutusVersion Language
v)       = Doc ann
"Plutus version not supported:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Language -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Language
v
    pretty ToCardanoError
MissingInputValidator              = Doc ann
"Missing input validator."
    pretty ToCardanoError
MissingDatum                       = Doc ann
"Missing required datum."
    pretty ToCardanoError
MissingStakeValidator              = Doc ann
"Missing stake validator."
    pretty (Tag String
t ToCardanoError
err)                        = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
t Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ToCardanoError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ToCardanoError
err

zeroExecutionUnits :: C.ExecutionUnits
zeroExecutionUnits :: ExecutionUnits
zeroExecutionUnits = Natural -> Natural -> ExecutionUnits
C.ExecutionUnits Natural
0 Natural
0