{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableSuperClasses #-}
-- Recursive definition constraints of `EraPlutusContext` and `EraPlutusTxInfo` lead to a wrongful
-- redundant constraint warning in the definition of `lookupTxInfoResult`.
--
-- Also `mkSupportedPlutusScript` has a constraint that is not required by the type system, but is
-- necessary for the safety of the function.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Cardano.Ledger.Alonzo.Plutus.Context (
  LedgerTxInfo (..),
  EraPlutusTxInfo (..),
  PlutusTxInfoResult (..),
  mkPlutusTxInfoFromResult,
  toPlutusTxInfoForPurpose,
  EraPlutusContext (..),
  toPlutusWithContext,
  lookupTxInfoResultImpossible,
  SupportedLanguage (..),
  mkSupportedLanguageM,
  supportedLanguages,
  mkSupportedPlutusScript,
  mkSupportedBinaryPlutusScript,

  -- * Language dependent translation
  PlutusTxInfo,
  PlutusTxCert,
  PlutusScriptPurpose,
  PlutusScriptContext,
  PlutusTxInInfo,
) where

import Cardano.Ledger.Alonzo.Era (AlonzoEra)
import Cardano.Ledger.Alonzo.Scripts (
  AlonzoEraScript (eraMaxLanguage, mkPlutusScript),
  AsIxItem (..),
  AsPurpose,
  PlutusPurpose,
  PlutusScript (..),
  hoistPlutusPurpose,
  toAsItem,
  toAsPurpose,
 )
import Cardano.Ledger.Alonzo.UTxO (AlonzoEraUTxO (getSpendingDatum))
import Cardano.Ledger.BaseTypes (ProtVer (..))
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Plutus (
  CostModel,
  Data,
  ExUnits,
  Language (..),
  Plutus (..),
  PlutusArgs,
  PlutusBinary,
  PlutusLanguage,
  PlutusRunnable,
  PlutusScriptContext,
  PlutusWithContext (..),
  SLanguage (..),
  asSLanguage,
  isLanguage,
  plutusLanguage,
 )
import Cardano.Ledger.State (UTxO (..))
import Cardano.Ledger.TxIn (TxIn)
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Control.DeepSeq (NFData)
import Control.Monad (join)
import Control.Monad.Trans.Fail.String (errorFail)
import Data.Aeson (ToJSON)
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Text (Text)
import GHC.Stack
import qualified PlutusLedgerApi.V1 as PV1
import qualified PlutusLedgerApi.V2 as PV2
import qualified PlutusLedgerApi.V3 as PV3

-- | All information that is necessary from the ledger to construct Plutus' TxInfo.
data LedgerTxInfo era where
  LedgerTxInfo ::
    { forall era. LedgerTxInfo era -> ProtVer
ltiProtVer :: !ProtVer
    , forall era. LedgerTxInfo era -> EpochInfo (Either Text)
ltiEpochInfo :: !(EpochInfo (Either Text))
    , forall era. LedgerTxInfo era -> SystemStart
ltiSystemStart :: !SystemStart
    , forall era. LedgerTxInfo era -> UTxO era
ltiUTxO :: !(UTxO era)
    , ()
ltiTx :: !(Tx level era)
    } ->
    LedgerTxInfo era

class
  ( PlutusLanguage l
  , EraPlutusContext era
  , EraTxLevel era
  , Eq (PlutusTxInfo l)
  , Show (PlutusTxInfo l)
  ) =>
  EraPlutusTxInfo (l :: Language) era
  where
  toPlutusTxCert ::
    proxy l ->
    ProtVer ->
    TxCert era ->
    Either (ContextError era) (PlutusTxCert l)

  toPlutusScriptPurpose ::
    proxy l ->
    ProtVer ->
    PlutusPurpose AsIxItem era ->
    Either (ContextError era) (PlutusScriptPurpose l)

  toPlutusTxInfo ::
    proxy l ->
    LedgerTxInfo era ->
    PlutusTxInfoResult l era

  toPlutusArgs ::
    proxy l ->
    ProtVer ->
    PlutusTxInfo l ->
    PlutusPurpose AsIxItem era ->
    Maybe (Data era) ->
    Data era ->
    Either (ContextError era) (PlutusArgs l)

  toPlutusTxInInfo ::
    proxy l ->
    UTxO era ->
    TxIn ->
    Either (ContextError era) (PlutusTxInInfo era l)

-- | This is the helper type that captures translation of `Tx` to `PlutusTxInfo`.
--
-- It is important to note that `TxInfo` is always the same per Plutus version for each `Tx`. This
-- invariant allows us to avoid duplicate computation by memoizing all possible `PlutusTxInfo`s per
-- transaction. Starting with Dijkstra era there is a slight complication introduced to this
-- invariant where top level transaction has a different `PlutusTxInfo` for "Guarding" purpose, when
-- compared to all other purposes. That is the reason why result is somewhat strange, namely a
-- function from `PlutusPurpose` to `PlutusTxInfo`. It is also done this way, instead of adding
-- `ScriptPurpose` as an argument to `toPlutusTxInfo` to preserve capability of memoization, hence
-- nested `Either`
newtype PlutusTxInfoResult l era
  = PlutusTxInfoResult
  { forall (l :: Language) era.
PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
unPlutusTxInfoResult ::
      Either
        (ContextError era)
        ( PlutusPurpose AsPurpose era ->
          Either (ContextError era) (PlutusTxInfo l)
        )
  }

-- | Given the prepared `PlutusTxInfoResult` and the purpose this function allows constructing the `PlutusTxInfo`, while memoizing the computation from  `PlutusTxInfoResult` for its subsequent uses.
mkPlutusTxInfoFromResult ::
  PlutusPurpose AsPurpose era ->
  PlutusTxInfoResult l era ->
  Either (ContextError era) (PlutusTxInfo l)
mkPlutusTxInfoFromResult :: forall era (l :: Language).
PlutusPurpose AsPurpose era
-> PlutusTxInfoResult l era
-> Either (ContextError era) (PlutusTxInfo l)
mkPlutusTxInfoFromResult PlutusPurpose AsPurpose era
sp (PlutusTxInfoResult Either
  (ContextError era)
  (PlutusPurpose AsPurpose era
   -> Either (ContextError era) (PlutusTxInfo l))
txInfoResult) =
  Either
  (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
-> Either (ContextError era) (PlutusTxInfo l)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either
   (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
 -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
-> Either (ContextError era) (PlutusTxInfo l)
forall a b. (a -> b) -> a -> b
$ ((PlutusPurpose AsPurpose era
 -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusPurpose AsPurpose era
-> Either (ContextError era) (PlutusTxInfo l)
forall a b. (a -> b) -> a -> b
$ PlutusPurpose AsPurpose era
sp) ((PlutusPurpose AsPurpose era
  -> Either (ContextError era) (PlutusTxInfo l))
 -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  (ContextError era)
  (PlutusPurpose AsPurpose era
   -> Either (ContextError era) (PlutusTxInfo l))
txInfoResult

-- | This is what `toPlutusTxInfo` would be without the intermediate `PlutusTxInfoResult`.
--
-- /Note/ - Using this function totally drops any memoization of `TxInfo`, as such use it only for
-- testing or tooling that doesn't care about performance.
toPlutusTxInfoForPurpose ::
  EraPlutusTxInfo l era =>
  proxy l ->
  LedgerTxInfo era ->
  PlutusPurpose AsPurpose era ->
  Either (ContextError era) (PlutusTxInfo l)
toPlutusTxInfoForPurpose :: forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era
-> PlutusPurpose AsPurpose era
-> Either (ContextError era) (PlutusTxInfo l)
toPlutusTxInfoForPurpose proxy l
proxy LedgerTxInfo era
lti PlutusPurpose AsPurpose era
sp =
  PlutusPurpose AsPurpose era
-> PlutusTxInfoResult l era
-> Either (ContextError era) (PlutusTxInfo l)
forall era (l :: Language).
PlutusPurpose AsPurpose era
-> PlutusTxInfoResult l era
-> Either (ContextError era) (PlutusTxInfo l)
mkPlutusTxInfoFromResult PlutusPurpose AsPurpose era
sp (PlutusTxInfoResult l era
 -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusTxInfoResult l era
-> Either (ContextError era) (PlutusTxInfo l)
forall a b. (a -> b) -> a -> b
$ proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (proxy :: Language -> *).
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
toPlutusTxInfo proxy l
proxy LedgerTxInfo era
lti

class
  ( AlonzoEraScript era
  , Eq (ContextError era)
  , Show (ContextError era)
  , NFData (ContextError era)
  , EncCBOR (ContextError era)
  , DecCBOR (ContextError era)
  , ToJSON (ContextError era)
  ) =>
  EraPlutusContext era
  where
  type ContextError era = (r :: Type) | r -> era

  -- | This data type family is used to memoize the results of `toPlutusTxInfo`, so the outcome can
  -- be shared between execution of different scripts with the same language version.
  data TxInfoResult era :: Type

  mkSupportedLanguage :: Language -> Maybe (SupportedLanguage era)

  -- | Construct `PlutusTxInfo` for all supported languages in this era.
  mkTxInfoResult :: LedgerTxInfo era -> TxInfoResult era

  -- | `TxInfo` for the same language can be shared between executions of every script of the same
  -- version in a single transaction.
  --
  -- /Note/ - The `EraPlutusTxInfo` is here only to enforce this function is not called with an
  -- unsupported plutus language version.
  lookupTxInfoResult ::
    EraPlutusTxInfo l era =>
    SLanguage l ->
    TxInfoResult era ->
    PlutusTxInfoResult l era

  mkPlutusWithContext ::
    PlutusScript era ->
    ScriptHash ->
    PlutusPurpose AsIxItem era ->
    LedgerTxInfo era ->
    TxInfoResult era ->
    (Data era, ExUnits) ->
    CostModel ->
    Either (ContextError era) PlutusWithContext

toPlutusWithContext ::
  forall l era.
  (EraPlutusTxInfo l era, AlonzoEraUTxO era) =>
  Either (Plutus l) (PlutusRunnable l) ->
  ScriptHash ->
  PlutusPurpose AsIxItem era ->
  LedgerTxInfo era ->
  TxInfoResult era ->
  (Data era, ExUnits) ->
  CostModel ->
  Either (ContextError era) PlutusWithContext
toPlutusWithContext :: forall (l :: Language) era.
(EraPlutusTxInfo l era, AlonzoEraUTxO era) =>
Either (Plutus l) (PlutusRunnable l)
-> ScriptHash
-> PlutusPurpose AsIxItem era
-> LedgerTxInfo era
-> TxInfoResult era
-> (Data era, ExUnits)
-> CostModel
-> Either (ContextError era) PlutusWithContext
toPlutusWithContext Either (Plutus l) (PlutusRunnable l)
script ScriptHash
scriptHash PlutusPurpose AsIxItem era
plutusPurpose lti :: LedgerTxInfo era
lti@LedgerTxInfo {Tx level era
ltiTx :: ()
ltiTx :: Tx level era
ltiTx} TxInfoResult era
txInfoResult (Data era
redeemerData, ExUnits
exUnits) CostModel
costModel = do
  let slang :: SLanguage l
slang = forall (l :: Language). PlutusLanguage l => SLanguage l
isLanguage @l
      maybeSpendingDatum :: Maybe (Data era)
maybeSpendingDatum =
        UTxO era
-> Tx level era -> PlutusPurpose AsItem era -> Maybe (Data era)
forall era (l :: TxLevel).
AlonzoEraUTxO era =>
UTxO era
-> Tx l era -> PlutusPurpose AsItem era -> Maybe (Data era)
forall (l :: TxLevel).
UTxO era
-> Tx l era -> PlutusPurpose AsItem era -> Maybe (Data era)
getSpendingDatum (LedgerTxInfo era -> UTxO era
forall era. LedgerTxInfo era -> UTxO era
ltiUTxO LedgerTxInfo era
lti) Tx level era
ltiTx ((forall ix it. AsIxItem ix it -> AsItem ix it)
-> PlutusPurpose AsIxItem era -> PlutusPurpose AsItem era
forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem PlutusPurpose AsIxItem era
plutusPurpose)
  mkTxInfo <- PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
forall (l :: Language) era.
PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
unPlutusTxInfoResult (PlutusTxInfoResult l era
 -> Either
      (ContextError era)
      (PlutusPurpose AsPurpose era
       -> Either (ContextError era) (PlutusTxInfo l)))
-> PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
forall a b. (a -> b) -> a -> b
$ SLanguage l -> TxInfoResult era -> PlutusTxInfoResult l era
forall era (l :: Language).
(EraPlutusContext era, EraPlutusTxInfo l era) =>
SLanguage l -> TxInfoResult era -> PlutusTxInfoResult l era
forall (l :: Language).
EraPlutusTxInfo l era =>
SLanguage l -> TxInfoResult era -> PlutusTxInfoResult l era
lookupTxInfoResult SLanguage l
slang TxInfoResult era
txInfoResult
  txInfo <- mkTxInfo $ hoistPlutusPurpose toAsPurpose plutusPurpose
  plutusArgs <-
    toPlutusArgs slang (ltiProtVer lti) txInfo plutusPurpose maybeSpendingDatum redeemerData
  pure $
    PlutusWithContext
      { pwcProtocolVersion = pvMajor (ltiProtVer lti)
      , pwcScript = script
      , pwcScriptHash = scriptHash
      , pwcArgs = plutusArgs
      , pwcExUnits = exUnits
      , pwcCostModel = costModel
      }

-- | Helper function to use when implementing `lookupTxInfoResult` for plutus languages that are not
-- supported by the era.
lookupTxInfoResultImpossible ::
  (HasCallStack, EraPlutusTxInfo l era) => SLanguage l -> PlutusTxInfoResult l era
lookupTxInfoResultImpossible :: forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
SLanguage l -> PlutusTxInfoResult l era
lookupTxInfoResultImpossible SLanguage l
slang =
  [Char] -> PlutusTxInfoResult l era
forall a. HasCallStack => [Char] -> a
error ([Char] -> PlutusTxInfoResult l era)
-> [Char] -> PlutusTxInfoResult l era
forall a b. (a -> b) -> a -> b
$ [Char]
"Impossible: Attempt to lookup TxInfoResult for an unsupported language: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> SLanguage l -> [Char]
forall a. Show a => a -> [Char]
show SLanguage l
slang

-- =============================================
-- Type families that specify Plutus types that are different from one version to another

type family PlutusTxCert (l :: Language) where
  PlutusTxCert 'PlutusV1 = PV1.DCert
  PlutusTxCert 'PlutusV2 = PV2.DCert
  PlutusTxCert 'PlutusV3 = PV3.TxCert
  PlutusTxCert 'PlutusV4 = PV3.TxCert

type family PlutusScriptPurpose (l :: Language) where
  PlutusScriptPurpose 'PlutusV1 = PV1.ScriptPurpose
  PlutusScriptPurpose 'PlutusV2 = PV2.ScriptPurpose
  PlutusScriptPurpose 'PlutusV3 = PV3.ScriptPurpose
  PlutusScriptPurpose 'PlutusV4 = PV3.ScriptPurpose

type family PlutusTxInfo (l :: Language) where
  PlutusTxInfo 'PlutusV1 = PV1.TxInfo
  PlutusTxInfo 'PlutusV2 = PV2.TxInfo
  PlutusTxInfo 'PlutusV3 = PV3.TxInfo
  PlutusTxInfo 'PlutusV4 = PV3.TxInfo

type family PlutusTxInInfo era (l :: Language) where
  -- This special case is here because Alonzo does not have a ContextError
  -- for the case where it encounters a Byron address in a TxIn
  PlutusTxInInfo AlonzoEra PlutusV1 = Maybe PV1.TxInInfo
  PlutusTxInInfo _ 'PlutusV1 = PV1.TxInInfo
  PlutusTxInInfo _ 'PlutusV2 = PV2.TxInInfo
  PlutusTxInInfo _ 'PlutusV3 = PV3.TxInInfo
  PlutusTxInInfo _ 'PlutusV4 = PV3.TxInInfo

-- | This is just like `mkPlutusScript`, except it is guaranteed to be total through the enforcement
-- of support by the type system and `EraPlutusTxInfo` type class instances for supported plutus
-- versions.
mkSupportedPlutusScript ::
  forall l era.
  (HasCallStack, EraPlutusTxInfo l era) =>
  Plutus l ->
  PlutusScript era
mkSupportedPlutusScript :: forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript Plutus l
plutus =
  case Plutus l -> Maybe (PlutusScript era)
forall era (l :: Language) (m :: * -> *).
(AlonzoEraScript era, PlutusLanguage l, MonadFail m) =>
Plutus l -> m (PlutusScript era)
forall (l :: Language) (m :: * -> *).
(PlutusLanguage l, MonadFail m) =>
Plutus l -> m (PlutusScript era)
mkPlutusScript Plutus l
plutus of
    Maybe (PlutusScript era)
Nothing ->
      [Char] -> PlutusScript era
forall a. HasCallStack => [Char] -> a
error ([Char] -> PlutusScript era) -> [Char] -> PlutusScript era
forall a b. (a -> b) -> a -> b
$
        [Char]
"Impossible: "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Plutus l -> [Char]
forall a. Show a => a -> [Char]
show Plutus l
plutus
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" language version should be supported by the "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ forall era. Era era => [Char]
eraName @era
    Just PlutusScript era
plutusScript -> PlutusScript era
plutusScript

-- | This is just like `mkBinaryPlutusScript`, except it is guaranteed to be total through the enforcement
-- of support by the type system and `EraPlutusTxInfo` type class instances (via calling `mkSupportedPlutusScript) for supported plutus
-- versions.
mkSupportedBinaryPlutusScript ::
  forall era.
  (HasCallStack, AlonzoEraScript era) =>
  SupportedLanguage era ->
  PlutusBinary ->
  PlutusScript era
mkSupportedBinaryPlutusScript :: forall era.
(HasCallStack, AlonzoEraScript era) =>
SupportedLanguage era -> PlutusBinary -> PlutusScript era
mkSupportedBinaryPlutusScript SupportedLanguage era
supportedLanguage PlutusBinary
plutus =
  case SupportedLanguage era
supportedLanguage of
    SupportedLanguage SLanguage l
sLang ->
      Plutus l -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (SLanguage l -> Plutus l -> Plutus l
forall (l :: Language) (proxy :: Language -> *).
SLanguage l -> proxy l -> proxy l
asSLanguage SLanguage l
sLang (PlutusBinary -> Plutus l
forall (l :: Language). PlutusBinary -> Plutus l
Plutus PlutusBinary
plutus))

data SupportedLanguage era where
  SupportedLanguage :: EraPlutusTxInfo l era => SLanguage l -> SupportedLanguage era

instance Show (SupportedLanguage era) where
  show :: SupportedLanguage era -> [Char]
show (SupportedLanguage SLanguage l
sLang) = [Char]
"(SupportedLanguage (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SLanguage l -> [Char]
forall a. Show a => a -> [Char]
show SLanguage l
sLang [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"))"

instance Eq (SupportedLanguage era) where
  SupportedLanguage SLanguage l
sLang1 == :: SupportedLanguage era -> SupportedLanguage era -> Bool
== SupportedLanguage SLanguage l
sLang2 =
    SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
sLang1 Language -> Language -> Bool
forall a. Eq a => a -> a -> Bool
== SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
sLang2

instance Ord (SupportedLanguage era) where
  compare :: SupportedLanguage era -> SupportedLanguage era -> Ordering
compare (SupportedLanguage SLanguage l
sLang1) (SupportedLanguage SLanguage l
sLang2) =
    Language -> Language -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
sLang1) (SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
sLang2)

instance Era era => EncCBOR (SupportedLanguage era) where
  encCBOR :: SupportedLanguage era -> Encoding
encCBOR (SupportedLanguage SLanguage l
sLang) = SLanguage l -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR SLanguage l
sLang

instance EraPlutusContext era => DecCBOR (SupportedLanguage era) where
  decCBOR :: forall s. Decoder s (SupportedLanguage era)
decCBOR = Decoder s Language
forall s. Decoder s Language
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s Language
-> (Language -> Decoder s (SupportedLanguage era))
-> Decoder s (SupportedLanguage era)
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Language -> Decoder s (SupportedLanguage era)
forall era (m :: * -> *).
(EraPlutusContext era, MonadFail m) =>
Language -> m (SupportedLanguage era)
mkSupportedLanguageM

supportedLanguages ::
  forall era.
  (HasCallStack, EraPlutusContext era) =>
  NonEmpty (SupportedLanguage era)
supportedLanguages :: forall era.
(HasCallStack, EraPlutusContext era) =>
NonEmpty (SupportedLanguage era)
supportedLanguages =
  let langs :: [SupportedLanguage era]
langs =
        [ Fail (SupportedLanguage era) -> SupportedLanguage era
forall a. HasCallStack => Fail a -> a
errorFail (Language -> Fail (SupportedLanguage era)
forall era (m :: * -> *).
(EraPlutusContext era, MonadFail m) =>
Language -> m (SupportedLanguage era)
mkSupportedLanguageM Language
lang)
        | Language
lang <- [Language
forall a. Bounded a => a
minBound .. forall era. AlonzoEraScript era => Language
eraMaxLanguage @era]
        ]
   in case [SupportedLanguage era] -> Maybe (NonEmpty (SupportedLanguage era))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [SupportedLanguage era]
langs of
        Maybe (NonEmpty (SupportedLanguage era))
Nothing -> [Char] -> NonEmpty (SupportedLanguage era)
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible: there are no supported languages"
        Just NonEmpty (SupportedLanguage era)
neLangs -> NonEmpty (SupportedLanguage era)
neLangs

mkSupportedLanguageM ::
  forall era m.
  (EraPlutusContext era, MonadFail m) =>
  Language ->
  m (SupportedLanguage era)
mkSupportedLanguageM :: forall era (m :: * -> *).
(EraPlutusContext era, MonadFail m) =>
Language -> m (SupportedLanguage era)
mkSupportedLanguageM Language
lang =
  case Language -> Maybe (SupportedLanguage era)
forall era.
EraPlutusContext era =>
Language -> Maybe (SupportedLanguage era)
mkSupportedLanguage Language
lang of
    Maybe (SupportedLanguage era)
Nothing -> [Char] -> m (SupportedLanguage era)
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m (SupportedLanguage era))
-> [Char] -> m (SupportedLanguage era)
forall a b. (a -> b) -> a -> b
$ Language -> [Char]
forall a. Show a => a -> [Char]
show Language
lang [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" language is not supported in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ forall era. Era era => [Char]
eraName @era
    Just SupportedLanguage era
supportedLanguage -> SupportedLanguage era -> m (SupportedLanguage era)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SupportedLanguage era
supportedLanguage