{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE OverloadedStrings  #-}

{-# OPTIONS_GHC -Wno-orphans #-}

{-|
This module contains functions related to versioning scripts and BuiltinData, or more specifially,
'Datum's and 'Redeemer's. These functions do not depend on a particular version of Plutus.
-}
module Plutus.Script.Utils.Scripts
    ( -- * Plutus language versioning
      Language (..)
    , Versioned (..)
      -- * Script hashing
    , scriptHash
    , validatorHash
    , mintingPolicyHash
    , stakeValidatorHash
      -- * Script utilities
    , scriptCurrencySymbol
      -- * Script data hashes
    , PV1.Datum
    , PV1.DatumHash
    , PV1.Redeemer
    , PV1.RedeemerHash
    , datumHash
    , redeemerHash
    , dataHash
    ) where

import Cardano.Api qualified as C.Api
import Cardano.Api.Shelley qualified as C.Api
import Cardano.Ledger.Alonzo.Language (Language (PlutusV1, PlutusV2))
import Codec.Serialise (Serialise, serialise)
import Data.Aeson (FromJSON, ToJSON)
import Data.ByteString.Lazy qualified as BSL
import Data.ByteString.Short qualified as SBS
import GHC.Generics (Generic)
import Plutus.V1.Ledger.Api qualified as PV1
import Plutus.V1.Ledger.Scripts qualified as PV1
import PlutusTx.Builtins qualified as Builtins
import Prettyprinter (Pretty (pretty))

deriving instance Serialise Language

instance Pretty Language where
  pretty :: Language -> Doc ann
pretty Language
PlutusV1 = Doc ann
"Plutus V1"
  pretty Language
PlutusV2 = Doc ann
"Plutus V2"

-- | A script of some kind with its Plutus language version
data Versioned script = Versioned { Versioned script -> script
unversioned :: script, Versioned script -> Language
version :: Language }
    deriving stock (Int -> Versioned script -> ShowS
[Versioned script] -> ShowS
Versioned script -> String
(Int -> Versioned script -> ShowS)
-> (Versioned script -> String)
-> ([Versioned script] -> ShowS)
-> Show (Versioned script)
forall script. Show script => Int -> Versioned script -> ShowS
forall script. Show script => [Versioned script] -> ShowS
forall script. Show script => Versioned script -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Versioned script] -> ShowS
$cshowList :: forall script. Show script => [Versioned script] -> ShowS
show :: Versioned script -> String
$cshow :: forall script. Show script => Versioned script -> String
showsPrec :: Int -> Versioned script -> ShowS
$cshowsPrec :: forall script. Show script => Int -> Versioned script -> ShowS
Show, Versioned script -> Versioned script -> Bool
(Versioned script -> Versioned script -> Bool)
-> (Versioned script -> Versioned script -> Bool)
-> Eq (Versioned script)
forall script.
Eq script =>
Versioned script -> Versioned script -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Versioned script -> Versioned script -> Bool
$c/= :: forall script.
Eq script =>
Versioned script -> Versioned script -> Bool
== :: Versioned script -> Versioned script -> Bool
$c== :: forall script.
Eq script =>
Versioned script -> Versioned script -> Bool
Eq, Eq (Versioned script)
Eq (Versioned script)
-> (Versioned script -> Versioned script -> Ordering)
-> (Versioned script -> Versioned script -> Bool)
-> (Versioned script -> Versioned script -> Bool)
-> (Versioned script -> Versioned script -> Bool)
-> (Versioned script -> Versioned script -> Bool)
-> (Versioned script -> Versioned script -> Versioned script)
-> (Versioned script -> Versioned script -> Versioned script)
-> Ord (Versioned script)
Versioned script -> Versioned script -> Bool
Versioned script -> Versioned script -> Ordering
Versioned script -> Versioned script -> Versioned script
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 script. Ord script => Eq (Versioned script)
forall script.
Ord script =>
Versioned script -> Versioned script -> Bool
forall script.
Ord script =>
Versioned script -> Versioned script -> Ordering
forall script.
Ord script =>
Versioned script -> Versioned script -> Versioned script
min :: Versioned script -> Versioned script -> Versioned script
$cmin :: forall script.
Ord script =>
Versioned script -> Versioned script -> Versioned script
max :: Versioned script -> Versioned script -> Versioned script
$cmax :: forall script.
Ord script =>
Versioned script -> Versioned script -> Versioned script
>= :: Versioned script -> Versioned script -> Bool
$c>= :: forall script.
Ord script =>
Versioned script -> Versioned script -> Bool
> :: Versioned script -> Versioned script -> Bool
$c> :: forall script.
Ord script =>
Versioned script -> Versioned script -> Bool
<= :: Versioned script -> Versioned script -> Bool
$c<= :: forall script.
Ord script =>
Versioned script -> Versioned script -> Bool
< :: Versioned script -> Versioned script -> Bool
$c< :: forall script.
Ord script =>
Versioned script -> Versioned script -> Bool
compare :: Versioned script -> Versioned script -> Ordering
$ccompare :: forall script.
Ord script =>
Versioned script -> Versioned script -> Ordering
$cp1Ord :: forall script. Ord script => Eq (Versioned script)
Ord, a -> Versioned b -> Versioned a
(a -> b) -> Versioned a -> Versioned b
(forall a b. (a -> b) -> Versioned a -> Versioned b)
-> (forall a b. a -> Versioned b -> Versioned a)
-> Functor Versioned
forall a b. a -> Versioned b -> Versioned a
forall a b. (a -> b) -> Versioned a -> Versioned b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Versioned b -> Versioned a
$c<$ :: forall a b. a -> Versioned b -> Versioned a
fmap :: (a -> b) -> Versioned a -> Versioned b
$cfmap :: forall a b. (a -> b) -> Versioned a -> Versioned b
Functor, (forall x. Versioned script -> Rep (Versioned script) x)
-> (forall x. Rep (Versioned script) x -> Versioned script)
-> Generic (Versioned script)
forall x. Rep (Versioned script) x -> Versioned script
forall x. Versioned script -> Rep (Versioned script) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall script x. Rep (Versioned script) x -> Versioned script
forall script x. Versioned script -> Rep (Versioned script) x
$cto :: forall script x. Rep (Versioned script) x -> Versioned script
$cfrom :: forall script x. Versioned script -> Rep (Versioned script) x
Generic)
    deriving anyclass ([Versioned script] -> Encoding
[Versioned script] -> Value
Versioned script -> Encoding
Versioned script -> Value
(Versioned script -> Value)
-> (Versioned script -> Encoding)
-> ([Versioned script] -> Value)
-> ([Versioned script] -> Encoding)
-> ToJSON (Versioned script)
forall script. ToJSON script => [Versioned script] -> Encoding
forall script. ToJSON script => [Versioned script] -> Value
forall script. ToJSON script => Versioned script -> Encoding
forall script. ToJSON script => Versioned script -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Versioned script] -> Encoding
$ctoEncodingList :: forall script. ToJSON script => [Versioned script] -> Encoding
toJSONList :: [Versioned script] -> Value
$ctoJSONList :: forall script. ToJSON script => [Versioned script] -> Value
toEncoding :: Versioned script -> Encoding
$ctoEncoding :: forall script. ToJSON script => Versioned script -> Encoding
toJSON :: Versioned script -> Value
$ctoJSON :: forall script. ToJSON script => Versioned script -> Value
ToJSON, Value -> Parser [Versioned script]
Value -> Parser (Versioned script)
(Value -> Parser (Versioned script))
-> (Value -> Parser [Versioned script])
-> FromJSON (Versioned script)
forall script.
FromJSON script =>
Value -> Parser [Versioned script]
forall script.
FromJSON script =>
Value -> Parser (Versioned script)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Versioned script]
$cparseJSONList :: forall script.
FromJSON script =>
Value -> Parser [Versioned script]
parseJSON :: Value -> Parser (Versioned script)
$cparseJSON :: forall script.
FromJSON script =>
Value -> Parser (Versioned script)
FromJSON, [Versioned script] -> Encoding
Versioned script -> Encoding
(Versioned script -> Encoding)
-> (forall s. Decoder s (Versioned script))
-> ([Versioned script] -> Encoding)
-> (forall s. Decoder s [Versioned script])
-> Serialise (Versioned script)
forall s. Decoder s [Versioned script]
forall s. Decoder s (Versioned script)
forall script. Serialise script => [Versioned script] -> Encoding
forall script. Serialise script => Versioned script -> Encoding
forall script s. Serialise script => Decoder s [Versioned script]
forall script s. Serialise script => Decoder s (Versioned script)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [Versioned script]
$cdecodeList :: forall script s. Serialise script => Decoder s [Versioned script]
encodeList :: [Versioned script] -> Encoding
$cencodeList :: forall script. Serialise script => [Versioned script] -> Encoding
decode :: Decoder s (Versioned script)
$cdecode :: forall script s. Serialise script => Decoder s (Versioned script)
encode :: Versioned script -> Encoding
$cencode :: forall script. Serialise script => Versioned script -> Encoding
Serialise)

instance Pretty script => Pretty (Versioned script) where
    pretty :: Versioned script -> Doc ann
pretty Versioned{script
unversioned :: script
unversioned :: forall script. Versioned script -> script
unversioned,Language
version :: Language
version :: forall script. Versioned script -> Language
version} = script -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty script
unversioned Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" (" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Language -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Language
version Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
")"

-- | Hash a 'Versioned' 'Script'
scriptHash :: Versioned PV1.Script -> PV1.ScriptHash
scriptHash :: Versioned Script -> ScriptHash
scriptHash (Versioned Script
script Language
lang) =
    BuiltinByteString -> ScriptHash
PV1.ScriptHash
    (BuiltinByteString -> ScriptHash)
-> (Script -> BuiltinByteString) -> Script -> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
Builtins.toBuiltin
    (ByteString -> BuiltinByteString)
-> (Script -> ByteString) -> Script -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.Api.serialiseToRawBytes
    (ScriptHash -> ByteString)
-> (Script -> ScriptHash) -> Script -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> ShortByteString -> ScriptHash
hashInner Language
lang
    (ShortByteString -> ScriptHash)
-> (Script -> ShortByteString) -> Script -> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort
    (ByteString -> ShortByteString)
-> (Script -> ByteString) -> Script -> ShortByteString
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
serialise
    (Script -> ScriptHash) -> Script -> ScriptHash
forall a b. (a -> b) -> a -> b
$ Script
script
    where
      hashInner :: Language -> ShortByteString -> ScriptHash
hashInner Language
PlutusV1 = Script PlutusScriptV1 -> ScriptHash
forall lang. Script lang -> ScriptHash
C.Api.hashScript (Script PlutusScriptV1 -> ScriptHash)
-> (ShortByteString -> Script PlutusScriptV1)
-> ShortByteString
-> ScriptHash
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.Api.PlutusScript PlutusScriptVersion PlutusScriptV1
C.Api.PlutusScriptV1 (PlutusScript PlutusScriptV1 -> Script PlutusScriptV1)
-> (ShortByteString -> PlutusScript PlutusScriptV1)
-> ShortByteString
-> Script PlutusScriptV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PlutusScript PlutusScriptV1
forall lang. ShortByteString -> PlutusScript lang
C.Api.PlutusScriptSerialised
      hashInner Language
PlutusV2 = Script PlutusScriptV2 -> ScriptHash
forall lang. Script lang -> ScriptHash
C.Api.hashScript (Script PlutusScriptV2 -> ScriptHash)
-> (ShortByteString -> Script PlutusScriptV2)
-> ShortByteString
-> ScriptHash
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.Api.PlutusScript PlutusScriptVersion PlutusScriptV2
C.Api.PlutusScriptV2 (PlutusScript PlutusScriptV2 -> Script PlutusScriptV2)
-> (ShortByteString -> PlutusScript PlutusScriptV2)
-> ShortByteString
-> Script PlutusScriptV2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PlutusScript PlutusScriptV2
forall lang. ShortByteString -> PlutusScript lang
C.Api.PlutusScriptSerialised

-- | Hash a 'Versioned' 'PV1.Validator' script.
validatorHash :: Versioned PV1.Validator -> PV1.ValidatorHash
validatorHash :: Versioned Validator -> ValidatorHash
validatorHash =
    BuiltinByteString -> ValidatorHash
PV1.ValidatorHash
  (BuiltinByteString -> ValidatorHash)
-> (Versioned Validator -> BuiltinByteString)
-> Versioned Validator
-> ValidatorHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> BuiltinByteString
PV1.getScriptHash
  (ScriptHash -> BuiltinByteString)
-> (Versioned Validator -> ScriptHash)
-> Versioned Validator
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versioned Script -> ScriptHash
scriptHash
  (Versioned Script -> ScriptHash)
-> (Versioned Validator -> Versioned Script)
-> Versioned Validator
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Validator -> Script) -> Versioned Validator -> Versioned Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Validator -> Script
PV1.getValidator

-- | Hash a 'Versioned' 'PV1.MintingPolicy' script.
mintingPolicyHash :: Versioned PV1.MintingPolicy -> PV1.MintingPolicyHash
mintingPolicyHash :: Versioned MintingPolicy -> MintingPolicyHash
mintingPolicyHash =
    BuiltinByteString -> MintingPolicyHash
PV1.MintingPolicyHash
  (BuiltinByteString -> MintingPolicyHash)
-> (Versioned MintingPolicy -> BuiltinByteString)
-> Versioned MintingPolicy
-> MintingPolicyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> BuiltinByteString
PV1.getScriptHash
  (ScriptHash -> BuiltinByteString)
-> (Versioned MintingPolicy -> ScriptHash)
-> Versioned MintingPolicy
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versioned Script -> ScriptHash
scriptHash
  (Versioned Script -> ScriptHash)
-> (Versioned MintingPolicy -> Versioned Script)
-> Versioned MintingPolicy
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MintingPolicy -> Script)
-> Versioned MintingPolicy -> Versioned Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MintingPolicy -> Script
PV1.getMintingPolicy

-- | Hash a 'Versioned' 'PV1.StakeValidator' script.
stakeValidatorHash :: Versioned PV1.StakeValidator -> PV1.StakeValidatorHash
stakeValidatorHash :: Versioned StakeValidator -> StakeValidatorHash
stakeValidatorHash =
    BuiltinByteString -> StakeValidatorHash
PV1.StakeValidatorHash
  (BuiltinByteString -> StakeValidatorHash)
-> (Versioned StakeValidator -> BuiltinByteString)
-> Versioned StakeValidator
-> StakeValidatorHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> BuiltinByteString
PV1.getScriptHash
  (ScriptHash -> BuiltinByteString)
-> (Versioned StakeValidator -> ScriptHash)
-> Versioned StakeValidator
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versioned Script -> ScriptHash
scriptHash
  (Versioned Script -> ScriptHash)
-> (Versioned StakeValidator -> Versioned Script)
-> Versioned StakeValidator
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StakeValidator -> Script)
-> Versioned StakeValidator -> Versioned Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StakeValidator -> Script
PV1.getStakeValidator

{-# INLINABLE scriptCurrencySymbol #-}
-- | The 'CurrencySymbol' of a 'MintingPolicy'.
scriptCurrencySymbol :: Versioned PV1.MintingPolicy -> PV1.CurrencySymbol
scriptCurrencySymbol :: Versioned MintingPolicy -> CurrencySymbol
scriptCurrencySymbol Versioned MintingPolicy
scrpt =
    let (PV1.MintingPolicyHash BuiltinByteString
hsh) = Versioned MintingPolicy -> MintingPolicyHash
mintingPolicyHash Versioned MintingPolicy
scrpt in BuiltinByteString -> CurrencySymbol
PV1.CurrencySymbol BuiltinByteString
hsh

-- | Hash a 'PV1.Datum builtin data.
datumHash :: PV1.Datum -> PV1.DatumHash
datumHash :: Datum -> DatumHash
datumHash = BuiltinByteString -> DatumHash
PV1.DatumHash (BuiltinByteString -> DatumHash)
-> (Datum -> BuiltinByteString) -> Datum -> DatumHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> BuiltinByteString
dataHash (BuiltinData -> BuiltinByteString)
-> (Datum -> BuiltinData) -> Datum -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> BuiltinData
PV1.getDatum

-- | Hash a 'PV1.Redeemer' builtin data.
redeemerHash :: PV1.Redeemer -> PV1.RedeemerHash
redeemerHash :: Redeemer -> RedeemerHash
redeemerHash = BuiltinByteString -> RedeemerHash
PV1.RedeemerHash (BuiltinByteString -> RedeemerHash)
-> (Redeemer -> BuiltinByteString) -> Redeemer -> RedeemerHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> BuiltinByteString
dataHash (BuiltinData -> BuiltinByteString)
-> (Redeemer -> BuiltinData) -> Redeemer -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redeemer -> BuiltinData
PV1.getRedeemer

-- | Hash a 'Builtins.BuiltinData'
dataHash :: Builtins.BuiltinData -> Builtins.BuiltinByteString
dataHash :: BuiltinData -> BuiltinByteString
dataHash =
    ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
Builtins.toBuiltin
    (ByteString -> BuiltinByteString)
-> (BuiltinData -> ByteString) -> BuiltinData -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ScriptData -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.Api.serialiseToRawBytes
    (Hash ScriptData -> ByteString)
-> (BuiltinData -> Hash ScriptData) -> BuiltinData -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptData -> Hash ScriptData
C.Api.hashScriptData
    (ScriptData -> Hash ScriptData)
-> (BuiltinData -> ScriptData) -> BuiltinData -> Hash ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> ScriptData
toCardanoAPIData

-- | Convert a 'Builtins.BuiltinsData' value to a 'cardano-api' script
--   data value.
--
-- For why we depend on `cardano-api`,
-- see note [Hash computation of datums, redeemers and scripts]
toCardanoAPIData :: Builtins.BuiltinData -> C.Api.ScriptData
toCardanoAPIData :: BuiltinData -> ScriptData
toCardanoAPIData = Data -> ScriptData
C.Api.fromPlutusData (Data -> ScriptData)
-> (BuiltinData -> Data) -> BuiltinData -> ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Data
Builtins.builtinDataToData

{- Note [Hash computation of datums, redeemers and scripts]

We have three options for computing the hash (each with advantages and drawbacks):

1- Depend on `cardano-api` and use it's `Scripts.hashScriptData` and `Scripts.hashScript`
functions.
The good: most simplest way to compute the hashes.
The bad: this package has an additional pretty large dependency.

2- Depend on `cardano-ledger` instead and use their `hashScriptData` and `hashScript`.
The good: smaller footprint than `cardano-api`.
The bad: a lower-lever library than `cardano-api`.

3- Depend on `cardano-crypto-class`, and reimplement ourselves the hashing functions
from `cardano-ledger`.
The good: the lowest dependency footprint.
The bad: code duplication.

However, we expect that most Plutus script devs depending on this package will
also probably depend on `cardano-api`, so the dependency on `cardano-api` should
(probably) be an non-issue.

If this becomes an issue, we'll change the implementation.
-}