{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# 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.Crypto
import Cardano.Ledger.Plutus.Language
import Cardano.Ledger.SafeHash (SafeToHash (..))
import Cardano.Ledger.Shelley.Scripts (ShelleyEraScript (..))
import Control.DeepSeq (NFData (..), rwhnf)
import GHC.Generics
import NoThunks.Class (NoThunks (..))

instance Crypto c => EraScript (BabbageEra c) where
  type Script (BabbageEra c) = AlonzoScript (BabbageEra c)
  type NativeScript (BabbageEra c) = Timelock (BabbageEra c)

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

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

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

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

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

  eraMaxLanguage :: Language
eraMaxLanguage = Language
PlutusV2

  mkPlutusScript :: forall (l :: Language).
PlutusLanguage l =>
Plutus l -> Maybe (PlutusScript (BabbageEra c))
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
$ forall c. Plutus 'PlutusV1 -> PlutusScript (BabbageEra c)
BabbagePlutusV1 Plutus l
plutus
      SLanguage l
SPlutusV2 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. Plutus 'PlutusV2 -> PlutusScript (BabbageEra c)
BabbagePlutusV2 Plutus l
plutus
      SLanguage l
_ -> forall a. Maybe a
Nothing

  withPlutusScript :: forall a.
PlutusScript (BabbageEra c)
-> (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 c) -> PlutusPurpose f (BabbageEra c)
hoistPlutusPurpose forall ix it. g ix it -> f ix it
f = \case
    AlonzoSpending g Word32 (TxIn (EraCrypto (BabbageEra c)))
x -> forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoSpending forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (TxIn (EraCrypto (BabbageEra c)))
x
    AlonzoMinting g Word32 (PolicyID (EraCrypto (BabbageEra c)))
x -> forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoMinting forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (PolicyID (EraCrypto (BabbageEra c)))
x
    AlonzoCertifying g Word32 (TxCert (BabbageEra c))
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 c))
x
    AlonzoRewarding g Word32 (RewardAccount (EraCrypto (BabbageEra c)))
x -> forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> AlonzoPlutusPurpose f era
AlonzoRewarding forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (RewardAccount (EraCrypto (BabbageEra c)))
x

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

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

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

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

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

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

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

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

  upgradePlutusPurposeAsIx :: AlonzoEraScript (PreviousEra (BabbageEra c)) =>
PlutusPurpose AsIx (PreviousEra (BabbageEra c))
-> PlutusPurpose AsIx (BabbageEra c)
upgradePlutusPurposeAsIx = \case
    AlonzoMinting (AsIx Word32
ix) -> forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoMinting (forall ix it. ix -> AsIx ix it
AsIx Word32
ix)
    AlonzoSpending (AsIx Word32
ix) -> forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoSpending (forall ix it. ix -> AsIx ix it
AsIx Word32
ix)
    AlonzoRewarding (AsIx Word32
ix) -> forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> 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 Crypto c => ShelleyEraScript (BabbageEra c) where
  {-# SPECIALIZE instance ShelleyEraScript (BabbageEra StandardCrypto) #-}

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

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

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

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

instance Crypto c => AllegraEraScript (BabbageEra c) where
  {-# SPECIALIZE instance AllegraEraScript (BabbageEra StandardCrypto) #-}

  mkTimeStart :: SlotNo -> NativeScript (BabbageEra c)
mkTimeStart = forall era. Era era => SlotNo -> Timelock era
mkTimeStartTimelock
  getTimeStart :: NativeScript (BabbageEra c) -> Maybe SlotNo
getTimeStart = forall era. Era era => Timelock era -> Maybe SlotNo
getTimeStartTimelock

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

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