Add getScriptWitnessScript, getScriptWitnessReferenceInput, getScript…

…WitnessReferenceInputOrScript functions

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,25 +696,14 @@ 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
   = SScript SimpleScript
   | 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

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
         ]
 

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 (..)