From 5842e38024cfd76d5e6f9381c856fc2b2f42e7cd Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 8 Nov 2024 18:18:28 +0100 Subject: [PATCH] Add getScriptWitnessScript, getScriptWitnessReferenceInput, getScriptWitnessReferenceInputOrScript functions --- cardano-api/internal/Cardano/Api/Script.hs | 57 +++++++++------------ cardano-api/internal/Cardano/Api/Tx/Body.hs | 14 ++--- cardano-api/src/Cardano/Api.hs | 4 +- 3 files changed, 33 insertions(+), 42 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs index a20a33f8e4..3ec18daa52 100644 --- a/cardano-api/internal/Cardano/Api/Script.hs +++ b/cardano-api/internal/Cardano/Api/Script.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} @@ -47,7 +48,6 @@ module Cardano.Api.Script -- * Reference scripts , ReferenceScript (..) , refScriptToShelleyScript - , getScriptWitnessReferenceInput -- * Use of a script in an era as a witness , WitCtxTxIn @@ -56,13 +56,15 @@ module Cardano.Api.Script , WitCtx (..) , WitCtxMaybe (..) , ScriptWitness (..) + , getScriptWitnessReferenceInput + , getScriptWitnessScript + , getScriptWitnessReferenceInputOrScript , Witness (..) , KeyWitnessInCtx (..) , ScriptWitnessInCtx (..) , IsScriptWitnessInCtx (..) , ScriptDatum (..) , ScriptRedeemer - , scriptWitnessScript -- ** Languages supported in each era , ScriptLanguageInEra (..) @@ -694,10 +696,7 @@ instance Show a => Show (WitCtxMaybe p w a) where -- or to mint tokens. This datatype encapsulates this concept. data PlutusScriptOrReferenceInput lang = PScript (PlutusScript lang) - | -- | Needed to construct the redeemer pointer map - -- in the case of minting reference scripts where we don't - -- have direct access to the script - PReferenceScript TxIn + | PReferenceScript TxIn deriving (Eq, Show) data SimpleScriptOrReferenceInput lang @@ -705,14 +704,6 @@ data SimpleScriptOrReferenceInput lang | SReferenceScript TxIn deriving (Eq, Show) -getScriptWitnessReferenceInput :: ScriptWitness witctx era -> Maybe TxIn -getScriptWitnessReferenceInput (SimpleScriptWitness _ (SReferenceScript txIn)) = - Just txIn -getScriptWitnessReferenceInput (PlutusScriptWitness _ _ (PReferenceScript txIn) _ _ _) = - Just txIn -getScriptWitnessReferenceInput (SimpleScriptWitness _ (SScript _)) = Nothing -getScriptWitnessReferenceInput (PlutusScriptWitness _ _ (PScript _) _ _ _) = Nothing - -- | A /use/ of a script within a transaction body to witness that something is -- being used in an authorised manner. That can be -- @@ -792,28 +783,26 @@ deriving instance Eq (ScriptDatum witctx) deriving instance Show (ScriptDatum witctx) --- We cannot always extract a script from a script witness due to reference scripts. +getScriptWitnessReferenceInput :: ScriptWitness witctx era -> Maybe TxIn +getScriptWitnessReferenceInput = either (const Nothing) Just . getScriptWitnessReferenceInputOrScript + +getScriptWitnessScript :: ScriptWitness witctx era -> Maybe (ScriptInEra era) +getScriptWitnessScript = either Just (const Nothing) . getScriptWitnessReferenceInputOrScript + +-- | We cannot always extract a script from a script witness due to reference scripts. -- Reference scripts exist in the UTxO, so without access to the UTxO we cannot -- retrieve the script. -scriptWitnessScript :: ScriptWitness witctx era -> Maybe (ScriptInEra era) -scriptWitnessScript (SimpleScriptWitness SimpleScriptInShelley (SScript script)) = - Just $ ScriptInEra SimpleScriptInShelley (SimpleScript script) -scriptWitnessScript (SimpleScriptWitness SimpleScriptInAllegra (SScript script)) = - Just $ ScriptInEra SimpleScriptInAllegra (SimpleScript script) -scriptWitnessScript (SimpleScriptWitness SimpleScriptInMary (SScript script)) = - Just $ ScriptInEra SimpleScriptInMary (SimpleScript script) -scriptWitnessScript (SimpleScriptWitness SimpleScriptInAlonzo (SScript script)) = - Just $ ScriptInEra SimpleScriptInAlonzo (SimpleScript script) -scriptWitnessScript (SimpleScriptWitness SimpleScriptInBabbage (SScript script)) = - Just $ ScriptInEra SimpleScriptInBabbage (SimpleScript script) -scriptWitnessScript (SimpleScriptWitness SimpleScriptInConway (SScript script)) = - Just $ ScriptInEra SimpleScriptInConway (SimpleScript script) -scriptWitnessScript (PlutusScriptWitness langInEra version (PScript script) _ _ _) = - Just $ ScriptInEra langInEra (PlutusScript version script) -scriptWitnessScript (SimpleScriptWitness _ (SReferenceScript _)) = - Nothing -scriptWitnessScript (PlutusScriptWitness _ _ (PReferenceScript _) _ _ _) = - Nothing +-- So in the cases for script reference, the result contains @Right TxIn@. +getScriptWitnessReferenceInputOrScript :: ScriptWitness witctx era -> Either (ScriptInEra era) TxIn +getScriptWitnessReferenceInputOrScript = \case + SimpleScriptWitness (s :: (ScriptLanguageInEra SimpleScript' era)) (SScript script) -> + Left $ ScriptInEra s (SimpleScript script) + PlutusScriptWitness langInEra version (PScript script) _ _ _ -> + Left $ ScriptInEra langInEra (PlutusScript version script) + SimpleScriptWitness _ (SReferenceScript txIn) -> + Right txIn + PlutusScriptWitness _ _ (PReferenceScript txIn) _ _ _ -> + Right txIn -- ---------------------------------------------------------------------------- -- The kind of witness to use, key (signature) or script diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index 0e2d563e19..e1bdfd3e0f 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -2495,7 +2495,7 @@ convScripts -> [Ledger.Script ledgerera] convScripts scriptWitnesses = catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- scriptWitnesses ] @@ -2665,7 +2665,7 @@ makeShelleyTransactionBody scripts_ :: [Ledger.Script StandardShelley] scripts_ = catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- collectTxBodyScriptWitnesses sbe txbodycontent ] @@ -2710,7 +2710,7 @@ makeShelleyTransactionBody scripts_ :: [Ledger.Script StandardAllegra] scripts_ = catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- collectTxBodyScriptWitnesses sbe txbodycontent ] @@ -2759,7 +2759,7 @@ makeShelleyTransactionBody scripts = List.nub $ catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- collectTxBodyScriptWitnesses sbe txbodycontent ] @@ -2824,7 +2824,7 @@ makeShelleyTransactionBody scripts = List.nub $ catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- witnesses ] @@ -2945,7 +2945,7 @@ makeShelleyTransactionBody scripts = List.nub $ catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- witnesses ] @@ -3084,7 +3084,7 @@ makeShelleyTransactionBody scripts :: [Ledger.Script StandardConway] scripts = catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- witnesses ] diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index d44b167a5e..1de86bce07 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -531,13 +531,15 @@ module Cardano.Api , WitCtx (..) , WitCtxMaybe (..) , ScriptWitness (..) + , getScriptWitnessScript + , getScriptWitnessReferenceInput + , getScriptWitnessReferenceInputOrScript , Witness (..) , KeyWitnessInCtx (..) , ScriptWitnessInCtx (..) , IsScriptWitnessInCtx (..) , ScriptDatum (..) , ScriptRedeemer - , scriptWitnessScript -- ** Inspecting 'ScriptWitness'es , AnyScriptWitness (..)