-- | This module exposes the generation of witnesses and reward account
module Cooked.MockChain.GenerateTx.Witness
  ( toRewardAccount,
    toScriptWitness,
  )
where

import Cardano.Api.Shelley qualified as Cardano hiding (Testnet)
import Cardano.Ledger.Address qualified as Cardano
import Cardano.Ledger.BaseTypes qualified as Cardano
import Cardano.Ledger.Credential qualified as Cardano
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx.Common
import Cooked.Output
import Cooked.Skeleton
import Ledger.Tx.CardanoAPI qualified as Ledger
import Optics.Core
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api

-- | Translates a given credential to a reward account.
toRewardAccount :: (MonadBlockChainBalancing m) => Api.Credential -> m Cardano.RewardAccount
toRewardAccount :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
Credential -> m RewardAccount
toRewardAccount Credential
cred =
  Network -> Credential 'Staking -> RewardAccount
Cardano.RewardAccount Network
Cardano.Testnet (Credential 'Staking -> RewardAccount)
-> m (Credential 'Staking) -> m RewardAccount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Credential
cred of
    Api.ScriptCredential ScriptHash
scriptHash -> do
      Cardano.ScriptHash ScriptHash
cHash <-
        String -> Either ToCardanoError ScriptHash -> m ScriptHash
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Either ToCardanoError a -> m a
throwOnToCardanoError
          String
"toRewardAccount: Unable to convert script hash."
          (ScriptHash -> Either ToCardanoError ScriptHash
Ledger.toCardanoScriptHash ScriptHash
scriptHash)
      Credential 'Staking -> m (Credential 'Staking)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Credential 'Staking -> m (Credential 'Staking))
-> Credential 'Staking -> m (Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ ScriptHash -> Credential 'Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
Cardano.ScriptHashObj ScriptHash
cHash
    Api.PubKeyCredential PubKeyHash
pubkeyHash -> do
      Cardano.StakeKeyHash KeyHash 'Staking
pkHash <-
        String
-> Either ToCardanoError (Hash StakeKey) -> m (Hash StakeKey)
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Either ToCardanoError a -> m a
throwOnToCardanoError
          String
"toRewardAccount: Unable to convert private key hash."
          (PubKeyHash -> Either ToCardanoError (Hash StakeKey)
Ledger.toCardanoStakeKeyHash PubKeyHash
pubkeyHash)
      Credential 'Staking -> m (Credential 'Staking)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Credential 'Staking -> m (Credential 'Staking))
-> Credential 'Staking -> m (Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
Cardano.KeyHashObj KeyHash 'Staking
pkHash

-- | Translates a script and a reference script utxo into either a plutus script
-- or a reference input containing the right script
toPlutusScriptOrReferenceInput :: (MonadBlockChainBalancing m) => Script.Versioned Script.Script -> Maybe Api.TxOutRef -> m (Cardano.PlutusScriptOrReferenceInput lang)
toPlutusScriptOrReferenceInput :: forall (m :: * -> *) lang.
MonadBlockChainBalancing m =>
Versioned Script
-> Maybe TxOutRef -> m (PlutusScriptOrReferenceInput lang)
toPlutusScriptOrReferenceInput (Script.Versioned (Script.Script SerialisedScript
script) Language
_) Maybe TxOutRef
Nothing = PlutusScriptOrReferenceInput lang
-> m (PlutusScriptOrReferenceInput lang)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlutusScriptOrReferenceInput lang
 -> m (PlutusScriptOrReferenceInput lang))
-> PlutusScriptOrReferenceInput lang
-> m (PlutusScriptOrReferenceInput lang)
forall a b. (a -> b) -> a -> b
$ PlutusScript lang -> PlutusScriptOrReferenceInput lang
forall lang. PlutusScript lang -> PlutusScriptOrReferenceInput lang
Cardano.PScript (PlutusScript lang -> PlutusScriptOrReferenceInput lang)
-> PlutusScript lang -> PlutusScriptOrReferenceInput lang
forall a b. (a -> b) -> a -> b
$ SerialisedScript -> PlutusScript lang
forall lang. SerialisedScript -> PlutusScript lang
Cardano.PlutusScriptSerialised SerialisedScript
script
toPlutusScriptOrReferenceInput (Versioned Script -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash -> ScriptHash
scriptHash) (Just TxOutRef
scriptOutRef) = do
  ((TxOut
-> Optic' A_Lens NoIx TxOut (Maybe ScriptHash) -> Maybe ScriptHash
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx TxOut (Maybe ScriptHash)
Lens' TxOut (Maybe (ReferenceScriptType TxOut))
forall o.
IsAbstractOutput o =>
Lens' o (Maybe (ReferenceScriptType o))
outputReferenceScriptL) -> Maybe ScriptHash
mScriptHash) <-
    String -> Maybe TxOut -> m TxOut
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Maybe a -> m a
throwOnMaybe String
"toPlutusScriptOrReferenceInput: Can't resolve reference script utxo." (Maybe TxOut -> m TxOut) -> m (Maybe TxOut) -> m TxOut
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TxOutRef -> m (Maybe TxOut)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe TxOut)
txOutByRef TxOutRef
scriptOutRef
  case Maybe ScriptHash
mScriptHash of
    Maybe ScriptHash
Nothing -> String -> m (PlutusScriptOrReferenceInput lang)
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> m a
throwOnString String
"toPlutusScriptOrReferenceInput: No reference script found in utxo."
    Just ScriptHash
scriptHash' | ScriptHash
scriptHash ScriptHash -> ScriptHash -> Bool
forall a. Eq a => a -> a -> Bool
/= ScriptHash
scriptHash' -> String -> m (PlutusScriptOrReferenceInput lang)
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> m a
throwOnString String
"toPlutusScriptOrReferenceInput: Wrong reference script hash."
    Maybe ScriptHash
_ ->
      TxIn -> PlutusScriptOrReferenceInput lang
forall lang. TxIn -> PlutusScriptOrReferenceInput lang
Cardano.PReferenceScript
        (TxIn -> PlutusScriptOrReferenceInput lang)
-> m TxIn -> m (PlutusScriptOrReferenceInput lang)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either ToCardanoError TxIn -> m TxIn
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Either ToCardanoError a -> m a
throwOnToCardanoError
          String
"toPlutusScriptOrReferenceInput: Unable to translate reference script utxo."
          (TxOutRef -> Either ToCardanoError TxIn
Ledger.toCardanoTxIn TxOutRef
scriptOutRef)

-- | Translates a script with its associated redeemer and datum to a script
-- witness.
toScriptWitness :: (MonadBlockChainBalancing m, Script.ToVersioned Script.Script a) => a -> TxSkelRedeemer -> Cardano.ScriptDatum b -> m (Cardano.ScriptWitness b Cardano.ConwayEra)
toScriptWitness :: forall (m :: * -> *) a b.
(MonadBlockChainBalancing m, ToVersioned Script a) =>
a
-> TxSkelRedeemer -> ScriptDatum b -> m (ScriptWitness b ConwayEra)
toScriptWitness (a -> Versioned Script
forall s a. ToVersioned s a => a -> Versioned s
Script.toVersioned -> script :: Versioned Script
script@(Script.Versioned Script
_ Language
version)) (TxSkelRedeemer {redeemer
Bool
Maybe TxOutRef
txSkelRedeemerContent :: redeemer
txSkelRedeemerReferenceInput :: Maybe TxOutRef
txSkelRedeemerAutoFill :: Bool
txSkelRedeemerContent :: ()
txSkelRedeemerReferenceInput :: TxSkelRedeemer -> Maybe TxOutRef
txSkelRedeemerAutoFill :: TxSkelRedeemer -> Bool
..}) ScriptDatum b
datum =
  let scriptData :: HashableScriptData
scriptData = BuiltinData -> HashableScriptData
Ledger.toCardanoScriptData (BuiltinData -> HashableScriptData)
-> BuiltinData -> HashableScriptData
forall a b. (a -> b) -> a -> b
$ redeemer -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData redeemer
txSkelRedeemerContent
   in case Language
version of
        Language
Script.PlutusV1 ->
          (\PlutusScriptOrReferenceInput PlutusScriptV1
x -> ScriptLanguageInEra PlutusScriptV1 ConwayEra
-> PlutusScriptVersion PlutusScriptV1
-> PlutusScriptOrReferenceInput PlutusScriptV1
-> ScriptDatum b
-> HashableScriptData
-> ExecutionUnits
-> ScriptWitness b ConwayEra
forall lang era witctx.
IsPlutusScriptLanguage lang =>
ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptDatum witctx
-> HashableScriptData
-> ExecutionUnits
-> ScriptWitness witctx era
Cardano.PlutusScriptWitness ScriptLanguageInEra PlutusScriptV1 ConwayEra
Cardano.PlutusScriptV1InConway PlutusScriptVersion PlutusScriptV1
Cardano.PlutusScriptV1 PlutusScriptOrReferenceInput PlutusScriptV1
x ScriptDatum b
datum HashableScriptData
scriptData ExecutionUnits
Ledger.zeroExecutionUnits)
            (PlutusScriptOrReferenceInput PlutusScriptV1
 -> ScriptWitness b ConwayEra)
-> m (PlutusScriptOrReferenceInput PlutusScriptV1)
-> m (ScriptWitness b ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned Script
-> Maybe TxOutRef
-> m (PlutusScriptOrReferenceInput PlutusScriptV1)
forall (m :: * -> *) lang.
MonadBlockChainBalancing m =>
Versioned Script
-> Maybe TxOutRef -> m (PlutusScriptOrReferenceInput lang)
toPlutusScriptOrReferenceInput Versioned Script
script Maybe TxOutRef
txSkelRedeemerReferenceInput
        Language
Script.PlutusV2 ->
          (\PlutusScriptOrReferenceInput PlutusScriptV2
x -> ScriptLanguageInEra PlutusScriptV2 ConwayEra
-> PlutusScriptVersion PlutusScriptV2
-> PlutusScriptOrReferenceInput PlutusScriptV2
-> ScriptDatum b
-> HashableScriptData
-> ExecutionUnits
-> ScriptWitness b ConwayEra
forall lang era witctx.
IsPlutusScriptLanguage lang =>
ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptDatum witctx
-> HashableScriptData
-> ExecutionUnits
-> ScriptWitness witctx era
Cardano.PlutusScriptWitness ScriptLanguageInEra PlutusScriptV2 ConwayEra
Cardano.PlutusScriptV2InConway PlutusScriptVersion PlutusScriptV2
Cardano.PlutusScriptV2 PlutusScriptOrReferenceInput PlutusScriptV2
x ScriptDatum b
datum HashableScriptData
scriptData ExecutionUnits
Ledger.zeroExecutionUnits)
            (PlutusScriptOrReferenceInput PlutusScriptV2
 -> ScriptWitness b ConwayEra)
-> m (PlutusScriptOrReferenceInput PlutusScriptV2)
-> m (ScriptWitness b ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned Script
-> Maybe TxOutRef
-> m (PlutusScriptOrReferenceInput PlutusScriptV2)
forall (m :: * -> *) lang.
MonadBlockChainBalancing m =>
Versioned Script
-> Maybe TxOutRef -> m (PlutusScriptOrReferenceInput lang)
toPlutusScriptOrReferenceInput Versioned Script
script Maybe TxOutRef
txSkelRedeemerReferenceInput
        Language
Script.PlutusV3 ->
          (\PlutusScriptOrReferenceInput PlutusScriptV3
x -> ScriptLanguageInEra PlutusScriptV3 ConwayEra
-> PlutusScriptVersion PlutusScriptV3
-> PlutusScriptOrReferenceInput PlutusScriptV3
-> ScriptDatum b
-> HashableScriptData
-> ExecutionUnits
-> ScriptWitness b ConwayEra
forall lang era witctx.
IsPlutusScriptLanguage lang =>
ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptDatum witctx
-> HashableScriptData
-> ExecutionUnits
-> ScriptWitness witctx era
Cardano.PlutusScriptWitness ScriptLanguageInEra PlutusScriptV3 ConwayEra
Cardano.PlutusScriptV3InConway PlutusScriptVersion PlutusScriptV3
Cardano.PlutusScriptV3 PlutusScriptOrReferenceInput PlutusScriptV3
x ScriptDatum b
datum HashableScriptData
scriptData ExecutionUnits
Ledger.zeroExecutionUnits)
            (PlutusScriptOrReferenceInput PlutusScriptV3
 -> ScriptWitness b ConwayEra)
-> m (PlutusScriptOrReferenceInput PlutusScriptV3)
-> m (ScriptWitness b ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned Script
-> Maybe TxOutRef
-> m (PlutusScriptOrReferenceInput PlutusScriptV3)
forall (m :: * -> *) lang.
MonadBlockChainBalancing m =>
Versioned Script
-> Maybe TxOutRef -> m (PlutusScriptOrReferenceInput lang)
toPlutusScriptOrReferenceInput Versioned Script
script Maybe TxOutRef
txSkelRedeemerReferenceInput