{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Figure 3: Functions related to scripts
--   Babbage Specification
module Cardano.Ledger.Babbage.Scripts (
  AlonzoScript (..),
  isPlutusScript,
  PlutusScript (..),
)
where

import Cardano.Ledger.Allegra.Scripts
import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.Scripts (
  AlonzoPlutusPurpose (..),
  AlonzoScript (..),
  PlutusScript (..),
  alonzoScriptPrefixTag,
  isPlutusScript,
 )
import Cardano.Ledger.Babbage.Era
import Cardano.Ledger.Babbage.TxCert ()
import Cardano.Ledger.Plutus.Language
import Cardano.Ledger.Shelley.Scripts (ShelleyEraScript (..))
import Control.DeepSeq (NFData (..), rwhnf)
import GHC.Generics
import NoThunks.Class (NoThunks (..))

instance EraScript BabbageEra where
  type Script BabbageEra = AlonzoScript BabbageEra
  type NativeScript BabbageEra = Timelock BabbageEra

  upgradeScript :: EraScript (PreviousEra BabbageEra) =>
Script (PreviousEra BabbageEra) -> Script BabbageEra
upgradeScript = \case
    TimelockScript Timelock AlonzoEra
ts -> forall era. Timelock era -> AlonzoScript era
TimelockScript forall a b. (a -> b) -> a -> b
$ forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock Timelock AlonzoEra
ts
    PlutusScript (AlonzoPlutusV1 Plutus 'PlutusV1
ps) -> forall era. PlutusScript era -> AlonzoScript era
PlutusScript forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV1 -> PlutusScript BabbageEra
BabbagePlutusV1 Plutus 'PlutusV1
ps

  scriptPrefixTag :: Script BabbageEra -> ByteString
scriptPrefixTag = forall era.
(AlonzoEraScript era, AlonzoScript era ~ Script era) =>
Script era -> ByteString
alonzoScriptPrefixTag

  getNativeScript :: Script BabbageEra -> Maybe (NativeScript BabbageEra)
getNativeScript = \case
    TimelockScript Timelock BabbageEra
ts -> forall a. a -> Maybe a
Just Timelock BabbageEra
ts
    Script BabbageEra
_ -> forall a. Maybe a
Nothing

  fromNativeScript :: NativeScript BabbageEra -> Script BabbageEra
fromNativeScript = forall era. Timelock era -> AlonzoScript era
TimelockScript

instance AlonzoEraScript BabbageEra where
  data PlutusScript BabbageEra
    = BabbagePlutusV1 !(Plutus 'PlutusV1)
    | BabbagePlutusV2 !(Plutus 'PlutusV2)
    deriving (PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
$c/= :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
== :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
$c== :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
Eq, Eq (PlutusScript BabbageEra)
PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
PlutusScript BabbageEra -> PlutusScript BabbageEra -> Ordering
PlutusScript BabbageEra
-> PlutusScript BabbageEra -> PlutusScript BabbageEra
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PlutusScript BabbageEra
-> PlutusScript BabbageEra -> PlutusScript BabbageEra
$cmin :: PlutusScript BabbageEra
-> PlutusScript BabbageEra -> PlutusScript BabbageEra
max :: PlutusScript BabbageEra
-> PlutusScript BabbageEra -> PlutusScript BabbageEra
$cmax :: PlutusScript BabbageEra
-> PlutusScript BabbageEra -> PlutusScript BabbageEra
>= :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
$c>= :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
> :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
$c> :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
<= :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
$c<= :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
< :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
$c< :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Bool
compare :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Ordering
$ccompare :: PlutusScript BabbageEra -> PlutusScript BabbageEra -> Ordering
Ord, Int -> PlutusScript BabbageEra -> ShowS
[PlutusScript BabbageEra] -> ShowS
PlutusScript BabbageEra -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusScript BabbageEra] -> ShowS
$cshowList :: [PlutusScript BabbageEra] -> ShowS
show :: PlutusScript BabbageEra -> String
$cshow :: PlutusScript BabbageEra -> String
showsPrec :: Int -> PlutusScript BabbageEra -> ShowS
$cshowsPrec :: Int -> PlutusScript BabbageEra -> ShowS
Show, forall x.
Rep (PlutusScript BabbageEra) x -> PlutusScript BabbageEra
forall x.
PlutusScript BabbageEra -> Rep (PlutusScript BabbageEra) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (PlutusScript BabbageEra) x -> PlutusScript BabbageEra
$cfrom :: forall x.
PlutusScript BabbageEra -> Rep (PlutusScript BabbageEra) x
Generic)
  type PlutusPurpose f BabbageEra = AlonzoPlutusPurpose f BabbageEra

  eraMaxLanguage :: Language
eraMaxLanguage = Language
PlutusV2

  mkPlutusScript :: forall (l :: Language).
PlutusLanguage l =>
Plutus l -> Maybe (PlutusScript BabbageEra)
mkPlutusScript Plutus l
plutus =
    case forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> SLanguage l
plutusSLanguage Plutus l
plutus of
      SLanguage l
SPlutusV1 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV1 -> PlutusScript BabbageEra
BabbagePlutusV1 Plutus l
plutus
      SLanguage l
SPlutusV2 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV2 -> PlutusScript BabbageEra
BabbagePlutusV2 Plutus l
plutus
      SLanguage l
_ -> forall a. Maybe a
Nothing

  withPlutusScript :: forall a.
PlutusScript BabbageEra
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
withPlutusScript (BabbagePlutusV1 Plutus 'PlutusV1
plutus) forall (l :: Language). PlutusLanguage l => Plutus l -> a
f = forall (l :: Language). PlutusLanguage l => Plutus l -> a
f Plutus 'PlutusV1
plutus
  withPlutusScript (BabbagePlutusV2 Plutus 'PlutusV2
plutus) forall (l :: Language). PlutusLanguage l => Plutus l -> a
f = forall (l :: Language). PlutusLanguage l => Plutus l -> a
f Plutus 'PlutusV2
plutus

  hoistPlutusPurpose :: forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g BabbageEra -> PlutusPurpose f BabbageEra
hoistPlutusPurpose forall ix it. g ix it -> f ix it
f = \case
    AlonzoSpending g Word32 TxIn
x -> forall (f :: * -> * -> *) era.
f Word32 TxIn -> AlonzoPlutusPurpose f era
AlonzoSpending forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 TxIn
x
    AlonzoMinting g Word32 PolicyID
x -> forall (f :: * -> * -> *) era.
f Word32 PolicyID -> AlonzoPlutusPurpose f era
AlonzoMinting forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 PolicyID
x
    AlonzoCertifying g Word32 (TxCert BabbageEra)
x -> forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (TxCert BabbageEra)
x
    AlonzoRewarding g Word32 RewardAccount
x -> forall (f :: * -> * -> *) era.
f Word32 RewardAccount -> AlonzoPlutusPurpose f era
AlonzoRewarding forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 RewardAccount
x

  mkSpendingPurpose :: forall (f :: * -> * -> *).
f Word32 TxIn -> PlutusPurpose f BabbageEra
mkSpendingPurpose = forall (f :: * -> * -> *) era.
f Word32 TxIn -> AlonzoPlutusPurpose f era
AlonzoSpending

  toSpendingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f BabbageEra -> Maybe (f Word32 TxIn)
toSpendingPurpose (AlonzoSpending f Word32 TxIn
i) = forall a. a -> Maybe a
Just f Word32 TxIn
i
  toSpendingPurpose PlutusPurpose f BabbageEra
_ = forall a. Maybe a
Nothing

  mkMintingPurpose :: forall (f :: * -> * -> *).
f Word32 PolicyID -> PlutusPurpose f BabbageEra
mkMintingPurpose = forall (f :: * -> * -> *) era.
f Word32 PolicyID -> AlonzoPlutusPurpose f era
AlonzoMinting

  toMintingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f BabbageEra -> Maybe (f Word32 PolicyID)
toMintingPurpose (AlonzoMinting f Word32 PolicyID
i) = forall a. a -> Maybe a
Just f Word32 PolicyID
i
  toMintingPurpose PlutusPurpose f BabbageEra
_ = forall a. Maybe a
Nothing

  mkCertifyingPurpose :: forall (f :: * -> * -> *).
f Word32 (TxCert BabbageEra) -> PlutusPurpose f BabbageEra
mkCertifyingPurpose = forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying

  toCertifyingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f BabbageEra -> Maybe (f Word32 (TxCert BabbageEra))
toCertifyingPurpose (AlonzoCertifying f Word32 (TxCert BabbageEra)
i) = forall a. a -> Maybe a
Just f Word32 (TxCert BabbageEra)
i
  toCertifyingPurpose PlutusPurpose f BabbageEra
_ = forall a. Maybe a
Nothing

  mkRewardingPurpose :: forall (f :: * -> * -> *).
f Word32 RewardAccount -> PlutusPurpose f BabbageEra
mkRewardingPurpose = forall (f :: * -> * -> *) era.
f Word32 RewardAccount -> AlonzoPlutusPurpose f era
AlonzoRewarding

  toRewardingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f BabbageEra -> Maybe (f Word32 RewardAccount)
toRewardingPurpose (AlonzoRewarding f Word32 RewardAccount
i) = forall a. a -> Maybe a
Just f Word32 RewardAccount
i
  toRewardingPurpose PlutusPurpose f BabbageEra
_ = forall a. Maybe a
Nothing

  upgradePlutusPurposeAsIx :: AlonzoEraScript (PreviousEra BabbageEra) =>
PlutusPurpose AsIx (PreviousEra BabbageEra)
-> PlutusPurpose AsIx BabbageEra
upgradePlutusPurposeAsIx = \case
    AlonzoMinting (AsIx Word32
ix) -> forall (f :: * -> * -> *) era.
f Word32 PolicyID -> AlonzoPlutusPurpose f era
AlonzoMinting (forall ix it. ix -> AsIx ix it
AsIx Word32
ix)
    AlonzoSpending (AsIx Word32
ix) -> forall (f :: * -> * -> *) era.
f Word32 TxIn -> AlonzoPlutusPurpose f era
AlonzoSpending (forall ix it. ix -> AsIx ix it
AsIx Word32
ix)
    AlonzoRewarding (AsIx Word32
ix) -> forall (f :: * -> * -> *) era.
f Word32 RewardAccount -> AlonzoPlutusPurpose f era
AlonzoRewarding (forall ix it. ix -> AsIx ix it
AsIx Word32
ix)
    AlonzoCertifying (AsIx Word32
ix) -> forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying (forall ix it. ix -> AsIx ix it
AsIx Word32
ix)

instance ShelleyEraScript BabbageEra where
  mkRequireSignature :: KeyHash 'Witness -> NativeScript BabbageEra
mkRequireSignature = forall era. Era era => KeyHash 'Witness -> Timelock era
mkRequireSignatureTimelock
  getRequireSignature :: NativeScript BabbageEra -> Maybe (KeyHash 'Witness)
getRequireSignature = forall era. Era era => Timelock era -> Maybe (KeyHash 'Witness)
getRequireSignatureTimelock

  mkRequireAllOf :: StrictSeq (NativeScript BabbageEra) -> NativeScript BabbageEra
mkRequireAllOf = forall era. Era era => StrictSeq (Timelock era) -> Timelock era
mkRequireAllOfTimelock
  getRequireAllOf :: NativeScript BabbageEra
-> Maybe (StrictSeq (NativeScript BabbageEra))
getRequireAllOf = forall era.
Era era =>
Timelock era -> Maybe (StrictSeq (Timelock era))
getRequireAllOfTimelock

  mkRequireAnyOf :: StrictSeq (NativeScript BabbageEra) -> NativeScript BabbageEra
mkRequireAnyOf = forall era. Era era => StrictSeq (Timelock era) -> Timelock era
mkRequireAnyOfTimelock
  getRequireAnyOf :: NativeScript BabbageEra
-> Maybe (StrictSeq (NativeScript BabbageEra))
getRequireAnyOf = forall era.
Era era =>
Timelock era -> Maybe (StrictSeq (Timelock era))
getRequireAnyOfTimelock

  mkRequireMOf :: Int
-> StrictSeq (NativeScript BabbageEra) -> NativeScript BabbageEra
mkRequireMOf = forall era.
Era era =>
Int -> StrictSeq (Timelock era) -> Timelock era
mkRequireMOfTimelock
  getRequireMOf :: NativeScript BabbageEra
-> Maybe (Int, StrictSeq (NativeScript BabbageEra))
getRequireMOf = forall era.
Era era =>
Timelock era -> Maybe (Int, StrictSeq (Timelock era))
getRequireMOfTimelock

instance AllegraEraScript BabbageEra where
  mkTimeStart :: SlotNo -> NativeScript BabbageEra
mkTimeStart = forall era. Era era => SlotNo -> Timelock era
mkTimeStartTimelock
  getTimeStart :: NativeScript BabbageEra -> Maybe SlotNo
getTimeStart = forall era. Era era => Timelock era -> Maybe SlotNo
getTimeStartTimelock

  mkTimeExpire :: SlotNo -> NativeScript BabbageEra
mkTimeExpire = forall era. Era era => SlotNo -> Timelock era
mkTimeExpireTimelock
  getTimeExpire :: NativeScript BabbageEra -> Maybe SlotNo
getTimeExpire = forall era. Era era => Timelock era -> Maybe SlotNo
getTimeExpireTimelock

instance NFData (PlutusScript BabbageEra) where
  rnf :: PlutusScript BabbageEra -> ()
rnf = forall a. a -> ()
rwhnf
instance NoThunks (PlutusScript BabbageEra)
instance SafeToHash (PlutusScript BabbageEra) where
  originalBytes :: PlutusScript BabbageEra -> ByteString
originalBytes PlutusScript BabbageEra
ps = forall era a.
AlonzoEraScript era =>
PlutusScript era
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
withPlutusScript PlutusScript BabbageEra
ps forall t. SafeToHash t => t -> ByteString
originalBytes