{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Guards add required key signatures or script checks to Dijkstra transactions
-- and sub-transactions independently of spending inputs. Key guards are satisfied
-- by signatures supplied when signing; script guards use native or Plutus V4
-- witnesses, supplied inline or through reference inputs.
--
-- 'TxGuards' associates guard credentials with optional script witnesses and
-- preserves insertion order, which determines Plutus guard redeemer indices.
-- Use 'mkTxGuards' to validate the supplied entries before building a transaction.
module Cardano.Api.Experimental.Tx.Internal.Guard
  ( TxGuards
  , ScriptGuardWitness (..)
  , TxGuardsError (..)
  , mkTxGuards
  , emptyTxGuards
  , scriptGuardWitnessToAnyWitness
  , traverseTxGuardsExecutionUnits
  )
where

import Cardano.Api.Error
import Cardano.Api.Experimental.AnyScriptWitness
import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness
import Cardano.Api.Experimental.Simple.Script
import Cardano.Api.Experimental.Tx.Internal.AnyWitness
import Cardano.Api.Plutus.Internal.Script (ExecutionUnits)
import Cardano.Api.Pretty

import Cardano.Ledger.Core qualified as L
import Cardano.Ledger.Credential qualified as L
import Cardano.Ledger.Plutus.Language qualified as L

import Control.Monad (foldM_, unless)
import Data.Foldable (for_)
import Data.Map.Ordered.Strict (OMap)
import Data.Map.Ordered.Strict qualified as OMap
import Data.Set qualified as Set
import Data.Word (Word32)
import GHC.Exts (IsList (..))

-- | A supplied guard script witness. Key signatures are supplied when signing.
-- The Plutus constructor fixes both the language and the script purpose.
data ScriptGuardWitness era
  = NativeGuardWitness (SimpleScriptOrReferenceInput era)
  | PlutusGuardWitness (PlutusScriptWitness L.PlutusV4 GuardingScript era)
  deriving (ScriptGuardWitness era -> ScriptGuardWitness era -> Bool
(ScriptGuardWitness era -> ScriptGuardWitness era -> Bool)
-> (ScriptGuardWitness era -> ScriptGuardWitness era -> Bool)
-> Eq (ScriptGuardWitness era)
forall era.
ScriptGuardWitness era -> ScriptGuardWitness era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
ScriptGuardWitness era -> ScriptGuardWitness era -> Bool
== :: ScriptGuardWitness era -> ScriptGuardWitness era -> Bool
$c/= :: forall era.
ScriptGuardWitness era -> ScriptGuardWitness era -> Bool
/= :: ScriptGuardWitness era -> ScriptGuardWitness era -> Bool
Eq, Int -> ScriptGuardWitness era -> ShowS
[ScriptGuardWitness era] -> ShowS
ScriptGuardWitness era -> String
(Int -> ScriptGuardWitness era -> ShowS)
-> (ScriptGuardWitness era -> String)
-> ([ScriptGuardWitness era] -> ShowS)
-> Show (ScriptGuardWitness era)
forall era. Int -> ScriptGuardWitness era -> ShowS
forall era. [ScriptGuardWitness era] -> ShowS
forall era. ScriptGuardWitness era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ScriptGuardWitness era -> ShowS
showsPrec :: Int -> ScriptGuardWitness era -> ShowS
$cshow :: forall era. ScriptGuardWitness era -> String
show :: ScriptGuardWitness era -> String
$cshowList :: forall era. [ScriptGuardWitness era] -> ShowS
showList :: [ScriptGuardWitness era] -> ShowS
Show)

-- | Guard credentials and their optional witnesses, in ledger insertion order.
-- Construct with 'mkTxGuards' so credentials are unique and witnesses agree
-- with them. Key credentials must have 'Nothing' as their script witness;
-- 'mkTxGuards' rejects a 'Just' witness for a key credential. Key signatures
-- are supplied separately when signing.
-- 'Nothing' means no script witness was supplied; it does not
-- imply that the credential is a key credential or that no witness is required.
-- Use 'toList' to inspect entries in insertion order. The derived 'IsList'
-- instance constructs the underlying ordered map without the validation
-- performed by 'mkTxGuards'.
newtype TxGuards era = TxGuards (OMap (L.Credential L.Guard) (Maybe (ScriptGuardWitness era)))
  deriving (TxGuards era -> TxGuards era -> Bool
(TxGuards era -> TxGuards era -> Bool)
-> (TxGuards era -> TxGuards era -> Bool) -> Eq (TxGuards era)
forall era. TxGuards era -> TxGuards era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. TxGuards era -> TxGuards era -> Bool
== :: TxGuards era -> TxGuards era -> Bool
$c/= :: forall era. TxGuards era -> TxGuards era -> Bool
/= :: TxGuards era -> TxGuards era -> Bool
Eq, Int -> TxGuards era -> ShowS
[TxGuards era] -> ShowS
TxGuards era -> String
(Int -> TxGuards era -> ShowS)
-> (TxGuards era -> String)
-> ([TxGuards era] -> ShowS)
-> Show (TxGuards era)
forall era. Int -> TxGuards era -> ShowS
forall era. [TxGuards era] -> ShowS
forall era. TxGuards era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> TxGuards era -> ShowS
showsPrec :: Int -> TxGuards era -> ShowS
$cshow :: forall era. TxGuards era -> String
show :: TxGuards era -> String
$cshowList :: forall era. [TxGuards era] -> ShowS
showList :: [TxGuards era] -> ShowS
Show, Int -> [Item (TxGuards era)] -> TxGuards era
[Item (TxGuards era)] -> TxGuards era
TxGuards era -> [Item (TxGuards era)]
([Item (TxGuards era)] -> TxGuards era)
-> (Int -> [Item (TxGuards era)] -> TxGuards era)
-> (TxGuards era -> [Item (TxGuards era)])
-> IsList (TxGuards era)
forall era. Int -> [Item (TxGuards era)] -> TxGuards era
forall era. [Item (TxGuards era)] -> TxGuards era
forall era. TxGuards era -> [Item (TxGuards era)]
forall l.
([Item l] -> l)
-> (Int -> [Item l] -> l) -> (l -> [Item l]) -> IsList l
$cfromList :: forall era. [Item (TxGuards era)] -> TxGuards era
fromList :: [Item (TxGuards era)] -> TxGuards era
$cfromListN :: forall era. Int -> [Item (TxGuards era)] -> TxGuards era
fromListN :: Int -> [Item (TxGuards era)] -> TxGuards era
$ctoList :: forall era. TxGuards era -> [Item (TxGuards era)]
toList :: TxGuards era -> [Item (TxGuards era)]
IsList)

-- | Validation errors returned by 'mkTxGuards'.
data TxGuardsError
  = -- | The same guard credential occurs more than once in the supplied entries.
    DuplicateGuardCredential (L.Credential L.Guard)
  | -- | A script witness was supplied for a key credential, which must have 'Nothing'.
    GuardWitnessForKeyCredential (L.Credential L.Guard)
  | -- | An inline native or Plutus script does not match its guard credential.
    -- The first hash is the expected credential hash; the second is the actual
    -- script hash. Reference-script hashes are not checked by 'mkTxGuards'.
    GuardScriptHashMismatch L.ScriptHash L.ScriptHash
  deriving (TxGuardsError -> TxGuardsError -> Bool
(TxGuardsError -> TxGuardsError -> Bool)
-> (TxGuardsError -> TxGuardsError -> Bool) -> Eq TxGuardsError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxGuardsError -> TxGuardsError -> Bool
== :: TxGuardsError -> TxGuardsError -> Bool
$c/= :: TxGuardsError -> TxGuardsError -> Bool
/= :: TxGuardsError -> TxGuardsError -> Bool
Eq, Int -> TxGuardsError -> ShowS
[TxGuardsError] -> ShowS
TxGuardsError -> String
(Int -> TxGuardsError -> ShowS)
-> (TxGuardsError -> String)
-> ([TxGuardsError] -> ShowS)
-> Show TxGuardsError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxGuardsError -> ShowS
showsPrec :: Int -> TxGuardsError -> ShowS
$cshow :: TxGuardsError -> String
show :: TxGuardsError -> String
$cshowList :: [TxGuardsError] -> ShowS
showList :: [TxGuardsError] -> ShowS
Show)

instance Error TxGuardsError where
  prettyError :: forall ann. TxGuardsError -> Doc ann
prettyError (DuplicateGuardCredential Credential Guard
credential) =
    Doc ann
"Duplicate guard credential: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Credential Guard -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Credential Guard
credential
  prettyError (GuardWitnessForKeyCredential Credential Guard
credential) =
    Doc ann
"Script witness supplied for key guard credential: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Credential Guard -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Credential Guard
credential
  prettyError (GuardScriptHashMismatch ScriptHash
expected ScriptHash
actual) =
    Doc ann
"Guard script hash " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ScriptHash -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ScriptHash
actual Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" does not match credential hash " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ScriptHash -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ScriptHash
expected

-- | Preserve the supplied order and reject duplicate credentials, script
-- witnesses for key credentials, and mismatching inline script hashes.
-- Reference-script hashes must be checked against the referenced UTxO later.
-- Constructing this collection does not check whether the transaction's era
-- supports guards, or whether all required witnesses have been supplied.
mkTxGuards
  :: L.EraScript era
  => [(L.Credential L.Guard, Maybe (ScriptGuardWitness era))]
  -> Either TxGuardsError (TxGuards era)
mkTxGuards :: forall era.
EraScript era =>
[(Credential Guard, Maybe (ScriptGuardWitness era))]
-> Either TxGuardsError (TxGuards era)
mkTxGuards [(Credential Guard, Maybe (ScriptGuardWitness era))]
guards = do
  (Set (Credential Guard)
 -> (Credential Guard, Maybe (ScriptGuardWitness era))
 -> Either TxGuardsError (Set (Credential Guard)))
-> Set (Credential Guard)
-> [(Credential Guard, Maybe (ScriptGuardWitness era))]
-> Either TxGuardsError ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Set (Credential Guard)
-> (Credential Guard, Maybe (ScriptGuardWitness era))
-> Either TxGuardsError (Set (Credential Guard))
forall era.
EraScript era =>
Set (Credential Guard)
-> (Credential Guard, Maybe (ScriptGuardWitness era))
-> Either TxGuardsError (Set (Credential Guard))
validate Set (Credential Guard)
forall a. Set a
Set.empty [(Credential Guard, Maybe (ScriptGuardWitness era))]
guards
  TxGuards era -> Either TxGuardsError (TxGuards era)
forall a. a -> Either TxGuardsError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxGuards era -> Either TxGuardsError (TxGuards era))
-> TxGuards era -> Either TxGuardsError (TxGuards era)
forall a b. (a -> b) -> a -> b
$ OMap (Credential Guard) (Maybe (ScriptGuardWitness era))
-> TxGuards era
forall era.
OMap (Credential Guard) (Maybe (ScriptGuardWitness era))
-> TxGuards era
TxGuards (OMap (Credential Guard) (Maybe (ScriptGuardWitness era))
 -> TxGuards era)
-> OMap (Credential Guard) (Maybe (ScriptGuardWitness era))
-> TxGuards era
forall a b. (a -> b) -> a -> b
$ [(Credential Guard, Maybe (ScriptGuardWitness era))]
-> OMap (Credential Guard) (Maybe (ScriptGuardWitness era))
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList [(Credential Guard, Maybe (ScriptGuardWitness era))]
guards
 where
  validate
    :: L.EraScript era
    => Set.Set (L.Credential L.Guard)
    -> (L.Credential L.Guard, Maybe (ScriptGuardWitness era))
    -> Either TxGuardsError (Set.Set (L.Credential L.Guard))
  validate :: forall era.
EraScript era =>
Set (Credential Guard)
-> (Credential Guard, Maybe (ScriptGuardWitness era))
-> Either TxGuardsError (Set (Credential Guard))
validate Set (Credential Guard)
seen (Credential Guard
credential, Maybe (ScriptGuardWitness era)
witness) = do
    Bool -> Either TxGuardsError () -> Either TxGuardsError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Credential Guard -> Set (Credential Guard) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember Credential Guard
credential Set (Credential Guard)
seen) (Either TxGuardsError () -> Either TxGuardsError ())
-> Either TxGuardsError () -> Either TxGuardsError ()
forall a b. (a -> b) -> a -> b
$ TxGuardsError -> Either TxGuardsError ()
forall a b. a -> Either a b
Left (TxGuardsError -> Either TxGuardsError ())
-> TxGuardsError -> Either TxGuardsError ()
forall a b. (a -> b) -> a -> b
$ Credential Guard -> TxGuardsError
DuplicateGuardCredential Credential Guard
credential
    case (Credential Guard
credential, Maybe (ScriptGuardWitness era)
witness) of
      (L.KeyHashObj KeyHash Guard
_, Just ScriptGuardWitness era
_) -> TxGuardsError -> Either TxGuardsError ()
forall a b. a -> Either a b
Left (TxGuardsError -> Either TxGuardsError ())
-> TxGuardsError -> Either TxGuardsError ()
forall a b. (a -> b) -> a -> b
$ Credential Guard -> TxGuardsError
GuardWitnessForKeyCredential Credential Guard
credential
      (L.ScriptHashObj ScriptHash
expected, Just ScriptGuardWitness era
scriptWitness) ->
        Maybe (Script era)
-> (Script era -> Either TxGuardsError ())
-> Either TxGuardsError ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (AnyWitness era -> Maybe (Script era)
forall era. AnyWitness era -> Maybe (Script era)
getAnyWitnessScript (ScriptGuardWitness era -> AnyWitness era
forall era. ScriptGuardWitness era -> AnyWitness era
scriptGuardWitnessToAnyWitness ScriptGuardWitness era
scriptWitness)) ((Script era -> Either TxGuardsError ())
 -> Either TxGuardsError ())
-> (Script era -> Either TxGuardsError ())
-> Either TxGuardsError ()
forall a b. (a -> b) -> a -> b
$ \Script era
script -> do
          let actual :: ScriptHash
actual = Script era -> ScriptHash
forall era. EraScript era => Script era -> ScriptHash
L.hashScript Script era
script
          Bool -> Either TxGuardsError () -> Either TxGuardsError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ScriptHash
expected ScriptHash -> ScriptHash -> Bool
forall a. Eq a => a -> a -> Bool
== ScriptHash
actual) (Either TxGuardsError () -> Either TxGuardsError ())
-> Either TxGuardsError () -> Either TxGuardsError ()
forall a b. (a -> b) -> a -> b
$ TxGuardsError -> Either TxGuardsError ()
forall a b. a -> Either a b
Left (TxGuardsError -> Either TxGuardsError ())
-> TxGuardsError -> Either TxGuardsError ()
forall a b. (a -> b) -> a -> b
$ ScriptHash -> ScriptHash -> TxGuardsError
GuardScriptHashMismatch ScriptHash
expected ScriptHash
actual
      (L.KeyHashObj KeyHash Guard
_, Maybe (ScriptGuardWitness era)
Nothing) -> () -> Either TxGuardsError ()
forall a. a -> Either TxGuardsError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      (L.ScriptHashObj ScriptHash
_, Maybe (ScriptGuardWitness era)
Nothing) -> () -> Either TxGuardsError ()
forall a. a -> Either TxGuardsError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Set (Credential Guard)
-> Either TxGuardsError (Set (Credential Guard))
forall a. a -> Either TxGuardsError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set (Credential Guard)
 -> Either TxGuardsError (Set (Credential Guard)))
-> Set (Credential Guard)
-> Either TxGuardsError (Set (Credential Guard))
forall a b. (a -> b) -> a -> b
$ Credential Guard
-> Set (Credential Guard) -> Set (Credential Guard)
forall a. Ord a => a -> Set a -> Set a
Set.insert Credential Guard
credential Set (Credential Guard)
seen

-- | An empty guard collection, containing no credentials or script witnesses.
emptyTxGuards :: TxGuards era
emptyTxGuards :: forall era. TxGuards era
emptyTxGuards = OMap (Credential Guard) (Maybe (ScriptGuardWitness era))
-> TxGuards era
forall era.
OMap (Credential Guard) (Maybe (ScriptGuardWitness era))
-> TxGuards era
TxGuards OMap (Credential Guard) (Maybe (ScriptGuardWitness era))
forall k v. OMap k v
OMap.empty

scriptGuardWitnessToAnyWitness :: ScriptGuardWitness era -> AnyWitness era
scriptGuardWitnessToAnyWitness :: forall era. ScriptGuardWitness era -> AnyWitness era
scriptGuardWitnessToAnyWitness (NativeGuardWitness SimpleScriptOrReferenceInput era
witness) = SimpleScriptOrReferenceInput era -> AnyWitness era
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
AnySimpleScriptWitness SimpleScriptOrReferenceInput era
witness
scriptGuardWitnessToAnyWitness (PlutusGuardWitness PlutusScriptWitness 'PlutusV4 'GuardingScript era
witness) =
  AnyPlutusScriptWitness 'PlutusV4 'GuardingScript era
-> AnyWitness era
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
AnyPlutusScriptWitness (AnyPlutusScriptWitness 'PlutusV4 'GuardingScript era
 -> AnyWitness era)
-> AnyPlutusScriptWitness 'PlutusV4 'GuardingScript era
-> AnyWitness era
forall a b. (a -> b) -> a -> b
$ PlutusScriptWitness 'PlutusV4 'GuardingScript era
-> AnyPlutusScriptWitness 'PlutusV4 'GuardingScript era
forall (lang :: Language) era.
Typeable lang =>
PlutusScriptWitness lang 'GuardingScript era
-> AnyPlutusScriptWitness lang 'GuardingScript era
AnyPlutusGuardingScriptWitness PlutusScriptWitness 'PlutusV4 'GuardingScript era
witness

-- | Update only Plutus budgets, preserving credentials, scripts, and insertion
-- order. Native and witnessless guards occupy indices but need no budget.
traverseTxGuardsExecutionUnits
  :: Applicative f
  => (Word32 -> ExecutionUnits -> f ExecutionUnits)
  -- ^ Update a Plutus guard's budget using its zero-based index in the complete
  -- guard collection and its current execution units. Native and witnessless
  -- guards count towards the index but do not invoke this callback.
  -> TxGuards era
  -- ^ Guard credentials and optional witnesses in insertion order.
  -> f (TxGuards era)
  -- ^ Guards with updated Plutus budgets, preserving all other contents and order.
traverseTxGuardsExecutionUnits :: forall (f :: * -> *) era.
Applicative f =>
(Word32 -> ExecutionUnits -> f ExecutionUnits)
-> TxGuards era -> f (TxGuards era)
traverseTxGuardsExecutionUnits Word32 -> ExecutionUnits -> f ExecutionUnits
update TxGuards era
guards =
  OMap (Credential Guard) (Maybe (ScriptGuardWitness era))
-> TxGuards era
forall era.
OMap (Credential Guard) (Maybe (ScriptGuardWitness era))
-> TxGuards era
TxGuards (OMap (Credential Guard) (Maybe (ScriptGuardWitness era))
 -> TxGuards era)
-> ([(Credential Guard, Maybe (ScriptGuardWitness era))]
    -> OMap (Credential Guard) (Maybe (ScriptGuardWitness era)))
-> [(Credential Guard, Maybe (ScriptGuardWitness era))]
-> TxGuards era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Credential Guard, Maybe (ScriptGuardWitness era))]
-> OMap (Credential Guard) (Maybe (ScriptGuardWitness era))
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList ([(Credential Guard, Maybe (ScriptGuardWitness era))]
 -> TxGuards era)
-> f [(Credential Guard, Maybe (ScriptGuardWitness era))]
-> f (TxGuards era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Word32, (Credential Guard, Maybe (ScriptGuardWitness era)))
 -> f (Credential Guard, Maybe (ScriptGuardWitness era)))
-> [(Word32, (Credential Guard, Maybe (ScriptGuardWitness era)))]
-> f [(Credential Guard, Maybe (ScriptGuardWitness era))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Word32, (Credential Guard, Maybe (ScriptGuardWitness era)))
-> f (Credential Guard, Maybe (ScriptGuardWitness era))
updateEntry ([Word32]
-> [(Credential Guard, Maybe (ScriptGuardWitness era))]
-> [(Word32, (Credential Guard, Maybe (ScriptGuardWitness era)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word32
0 ..] (TxGuards era -> [Item (TxGuards era)]
forall l. IsList l => l -> [Item l]
toList TxGuards era
guards))
 where
  updateEntry :: (Word32, (Credential Guard, Maybe (ScriptGuardWitness era)))
-> f (Credential Guard, Maybe (ScriptGuardWitness era))
updateEntry (Word32
index, (Credential Guard
credential, Maybe (ScriptGuardWitness era)
witness)) =
    (Credential Guard
credential,) (Maybe (ScriptGuardWitness era)
 -> (Credential Guard, Maybe (ScriptGuardWitness era)))
-> f (Maybe (ScriptGuardWitness era))
-> f (Credential Guard, Maybe (ScriptGuardWitness era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ScriptGuardWitness era -> f (ScriptGuardWitness era))
-> Maybe (ScriptGuardWitness era)
-> f (Maybe (ScriptGuardWitness era))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (Word32 -> ScriptGuardWitness era -> f (ScriptGuardWitness era)
updateWitness Word32
index) Maybe (ScriptGuardWitness era)
witness
  updateWitness :: Word32 -> ScriptGuardWitness era -> f (ScriptGuardWitness era)
updateWitness Word32
index (PlutusGuardWitness (PlutusScriptWitness SLanguage 'PlutusV4
lang PlutusScriptOrReferenceInput 'PlutusV4 era
script PlutusScriptDatum 'PlutusV4 'GuardingScript
dat ScriptRedeemer
redeemer ExecutionUnits
units)) =
    PlutusScriptWitness 'PlutusV4 'GuardingScript era
-> ScriptGuardWitness era
forall era.
PlutusScriptWitness 'PlutusV4 'GuardingScript era
-> ScriptGuardWitness era
PlutusGuardWitness (PlutusScriptWitness 'PlutusV4 'GuardingScript era
 -> ScriptGuardWitness era)
-> (ExecutionUnits
    -> PlutusScriptWitness 'PlutusV4 'GuardingScript era)
-> ExecutionUnits
-> ScriptGuardWitness era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SLanguage 'PlutusV4
-> PlutusScriptOrReferenceInput 'PlutusV4 era
-> PlutusScriptDatum 'PlutusV4 'GuardingScript
-> ScriptRedeemer
-> ExecutionUnits
-> PlutusScriptWitness 'PlutusV4 'GuardingScript era
forall (lang :: Language) era (purpose :: PlutusScriptPurpose).
SLanguage lang
-> PlutusScriptOrReferenceInput lang era
-> PlutusScriptDatum lang purpose
-> ScriptRedeemer
-> ExecutionUnits
-> PlutusScriptWitness lang purpose era
PlutusScriptWitness SLanguage 'PlutusV4
lang PlutusScriptOrReferenceInput 'PlutusV4 era
script PlutusScriptDatum 'PlutusV4 'GuardingScript
dat ScriptRedeemer
redeemer (ExecutionUnits -> ScriptGuardWitness era)
-> f ExecutionUnits -> f (ScriptGuardWitness era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> ExecutionUnits -> f ExecutionUnits
update Word32
index ExecutionUnits
units
  updateWitness Word32
_ witness :: ScriptGuardWitness era
witness@NativeGuardWitness{} = ScriptGuardWitness era -> f (ScriptGuardWitness era)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptGuardWitness era
witness