-- | This module provides some 'Tweak's that add or remove inputs and outputs
-- from transactions. Some also operate on the minted value.
module Cooked.Tweak.Inputs
  ( ensureInputTweak,
    addInputTweak,
    removeInputTweak,
    modifySpendRedeemersOfTypeTweak,
  )
where

import Control.Monad
import Cooked.Skeleton
import Cooked.Tweak.Common
import Data.Map qualified as Map
import Optics.Core
import PlutusLedgerApi.V3 qualified as Api

-- | Ensure that a given 'Api.TxOutRef' is being spent with a given
-- 'TxSkelRedeemer'. The return value will be @Just@ the added data, if anything
-- changed.
ensureInputTweak :: (MonadTweak m) => Api.TxOutRef -> TxSkelRedeemer -> m (Maybe (Api.TxOutRef, TxSkelRedeemer))
ensureInputTweak :: forall (m :: * -> *).
MonadTweak m =>
TxOutRef -> TxSkelRedeemer -> m (Maybe (TxOutRef, TxSkelRedeemer))
ensureInputTweak TxOutRef
oref TxSkelRedeemer
howConsumed = do
  Map TxOutRef TxSkelRedeemer
presentInputs <- Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
-> m (Map TxOutRef TxSkelRedeemer)
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Getter) =>
Optic' k is TxSkel a -> m a
viewTweak Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
txSkelInsL
  if Map TxOutRef TxSkelRedeemer
presentInputs Map TxOutRef TxSkelRedeemer -> TxOutRef -> Maybe TxSkelRedeemer
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? TxOutRef
oref Maybe TxSkelRedeemer -> Maybe TxSkelRedeemer -> Bool
forall a. Eq a => a -> a -> Bool
== TxSkelRedeemer -> Maybe TxSkelRedeemer
forall a. a -> Maybe a
Just TxSkelRedeemer
howConsumed
    then Maybe (TxOutRef, TxSkelRedeemer)
-> m (Maybe (TxOutRef, TxSkelRedeemer))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TxOutRef, TxSkelRedeemer)
forall a. Maybe a
Nothing
    else do
      Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
-> (Map TxOutRef TxSkelRedeemer -> Map TxOutRef TxSkelRedeemer)
-> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> (a -> a) -> m ()
overTweak Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
txSkelInsL (TxOutRef
-> TxSkelRedeemer
-> Map TxOutRef TxSkelRedeemer
-> Map TxOutRef TxSkelRedeemer
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxOutRef
oref TxSkelRedeemer
howConsumed)
      Maybe (TxOutRef, TxSkelRedeemer)
-> m (Maybe (TxOutRef, TxSkelRedeemer))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TxOutRef, TxSkelRedeemer)
 -> m (Maybe (TxOutRef, TxSkelRedeemer)))
-> Maybe (TxOutRef, TxSkelRedeemer)
-> m (Maybe (TxOutRef, TxSkelRedeemer))
forall a b. (a -> b) -> a -> b
$ (TxOutRef, TxSkelRedeemer) -> Maybe (TxOutRef, TxSkelRedeemer)
forall a. a -> Maybe a
Just (TxOutRef
oref, TxSkelRedeemer
howConsumed)

-- | Add an input to a transaction. If the given 'Api.TxOutRef' is already being
-- consumed by the transaction, fail.
addInputTweak :: (MonadTweak m) => Api.TxOutRef -> TxSkelRedeemer -> m ()
addInputTweak :: forall (m :: * -> *).
MonadTweak m =>
TxOutRef -> TxSkelRedeemer -> m ()
addInputTweak TxOutRef
oref TxSkelRedeemer
howConsumed = do
  Map TxOutRef TxSkelRedeemer
presentInputs <- Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
-> m (Map TxOutRef TxSkelRedeemer)
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Getter) =>
Optic' k is TxSkel a -> m a
viewTweak Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
txSkelInsL
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (TxOutRef -> Map TxOutRef TxSkelRedeemer -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember TxOutRef
oref Map TxOutRef TxSkelRedeemer
presentInputs)
  Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
-> (Map TxOutRef TxSkelRedeemer -> Map TxOutRef TxSkelRedeemer)
-> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> (a -> a) -> m ()
overTweak Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
txSkelInsL (TxOutRef
-> TxSkelRedeemer
-> Map TxOutRef TxSkelRedeemer
-> Map TxOutRef TxSkelRedeemer
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxOutRef
oref TxSkelRedeemer
howConsumed)

-- | Remove transaction inputs according to a given predicate. The returned list
-- contains all removed inputs.
removeInputTweak :: (MonadTweak m) => (Api.TxOutRef -> TxSkelRedeemer -> Bool) -> m [(Api.TxOutRef, TxSkelRedeemer)]
removeInputTweak :: forall (m :: * -> *).
MonadTweak m =>
(TxOutRef -> TxSkelRedeemer -> Bool)
-> m [(TxOutRef, TxSkelRedeemer)]
removeInputTweak TxOutRef -> TxSkelRedeemer -> Bool
removePred = do
  Map TxOutRef TxSkelRedeemer
presentInputs <- Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
-> m (Map TxOutRef TxSkelRedeemer)
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Getter) =>
Optic' k is TxSkel a -> m a
viewTweak Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
txSkelInsL
  let (Map TxOutRef TxSkelRedeemer
removed, Map TxOutRef TxSkelRedeemer
kept) = (TxOutRef -> TxSkelRedeemer -> Bool)
-> Map TxOutRef TxSkelRedeemer
-> (Map TxOutRef TxSkelRedeemer, Map TxOutRef TxSkelRedeemer)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey TxOutRef -> TxSkelRedeemer -> Bool
removePred Map TxOutRef TxSkelRedeemer
presentInputs
  Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
-> Map TxOutRef TxSkelRedeemer -> m ()
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Setter) =>
Optic' k is TxSkel a -> a -> m ()
setTweak Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
txSkelInsL Map TxOutRef TxSkelRedeemer
kept
  [(TxOutRef, TxSkelRedeemer)] -> m [(TxOutRef, TxSkelRedeemer)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(TxOutRef, TxSkelRedeemer)] -> m [(TxOutRef, TxSkelRedeemer)])
-> [(TxOutRef, TxSkelRedeemer)] -> m [(TxOutRef, TxSkelRedeemer)]
forall a b. (a -> b) -> a -> b
$ Map TxOutRef TxSkelRedeemer -> [(TxOutRef, TxSkelRedeemer)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxOutRef TxSkelRedeemer
removed

-- | Applies an optional modification to all spend redeemers of type a. Returns
-- the list of modified spending redemeers, as they were before being modified.
modifySpendRedeemersOfTypeTweak :: forall a b m. (RedeemerConstrs a, RedeemerConstrs b, MonadTweak m) => (a -> Maybe b) -> m [TxSkelRedeemer]
modifySpendRedeemersOfTypeTweak :: forall a b (m :: * -> *).
(RedeemerConstrs a, RedeemerConstrs b, MonadTweak m) =>
(a -> Maybe b) -> m [TxSkelRedeemer]
modifySpendRedeemersOfTypeTweak a -> Maybe b
f =
  Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
-> (TxSkelRedeemer -> Maybe TxSkelRedeemer) -> m [TxSkelRedeemer]
forall (m :: * -> *) k (is :: IxList) a.
(MonadTweak m, Is k A_Traversal) =>
Optic' k is TxSkel a -> (a -> Maybe a) -> m [a]
overMaybeTweak (Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
txSkelInsL Optic' A_Lens NoIx TxSkel (Map TxOutRef TxSkelRedeemer)
-> Optic
     An_Iso
     NoIx
     (Map TxOutRef TxSkelRedeemer)
     (Map TxOutRef TxSkelRedeemer)
     [(TxOutRef, TxSkelRedeemer)]
     [(TxOutRef, TxSkelRedeemer)]
-> Optic
     A_Lens
     NoIx
     TxSkel
     TxSkel
     [(TxOutRef, TxSkelRedeemer)]
     [(TxOutRef, TxSkelRedeemer)]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Map TxOutRef TxSkelRedeemer -> [(TxOutRef, TxSkelRedeemer)])
-> ([(TxOutRef, TxSkelRedeemer)] -> Map TxOutRef TxSkelRedeemer)
-> Optic
     An_Iso
     NoIx
     (Map TxOutRef TxSkelRedeemer)
     (Map TxOutRef TxSkelRedeemer)
     [(TxOutRef, TxSkelRedeemer)]
     [(TxOutRef, TxSkelRedeemer)]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Map TxOutRef TxSkelRedeemer -> [(TxOutRef, TxSkelRedeemer)]
forall k a. Map k a -> [(k, a)]
Map.toList [(TxOutRef, TxSkelRedeemer)] -> Map TxOutRef TxSkelRedeemer
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList Optic
  A_Lens
  NoIx
  TxSkel
  TxSkel
  [(TxOutRef, TxSkelRedeemer)]
  [(TxOutRef, TxSkelRedeemer)]
-> Optic
     A_Traversal
     NoIx
     [(TxOutRef, TxSkelRedeemer)]
     [(TxOutRef, TxSkelRedeemer)]
     (TxOutRef, TxSkelRedeemer)
     (TxOutRef, TxSkelRedeemer)
-> Optic
     A_Traversal
     NoIx
     TxSkel
     TxSkel
     (TxOutRef, TxSkelRedeemer)
     (TxOutRef, TxSkelRedeemer)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  NoIx
  [(TxOutRef, TxSkelRedeemer)]
  [(TxOutRef, TxSkelRedeemer)]
  (TxOutRef, TxSkelRedeemer)
  (TxOutRef, TxSkelRedeemer)
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Optic
  A_Traversal
  NoIx
  TxSkel
  TxSkel
  (TxOutRef, TxSkelRedeemer)
  (TxOutRef, TxSkelRedeemer)
-> Optic
     A_Lens
     NoIx
     (TxOutRef, TxSkelRedeemer)
     (TxOutRef, TxSkelRedeemer)
     TxSkelRedeemer
     TxSkelRedeemer
-> Optic' A_Traversal NoIx TxSkel TxSkelRedeemer
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (TxOutRef, TxSkelRedeemer)
  (TxOutRef, TxSkelRedeemer)
  TxSkelRedeemer
  TxSkelRedeemer
forall s t a b. Field2 s t a b => Lens s t a b
_2) ((TxSkelRedeemer -> Maybe TxSkelRedeemer) -> m [TxSkelRedeemer])
-> (TxSkelRedeemer -> Maybe TxSkelRedeemer) -> m [TxSkelRedeemer]
forall a b. (a -> b) -> a -> b
$ \TxSkelRedeemer
red -> do
    a
typedRedeemer <- TxSkelRedeemer
red TxSkelRedeemer
-> Optic' An_AffineTraversal NoIx TxSkelRedeemer a -> Maybe a
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic' An_AffineTraversal NoIx TxSkelRedeemer a
forall a b.
(RedeemerConstrs a, RedeemerConstrs b) =>
AffineTraversal TxSkelRedeemer TxSkelRedeemer a b
txSkelRedeemerTypedAT
    b
typedRedeemerModified <- a -> Maybe b
f a
typedRedeemer
    TxSkelRedeemer -> Maybe TxSkelRedeemer
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSkelRedeemer -> Maybe TxSkelRedeemer)
-> TxSkelRedeemer -> Maybe TxSkelRedeemer
forall a b. (a -> b) -> a -> b
$ TxSkelRedeemer
red TxSkelRedeemer
-> (TxSkelRedeemer -> TxSkelRedeemer) -> TxSkelRedeemer
forall a b. a -> (a -> b) -> b
& forall a b.
(RedeemerConstrs a, RedeemerConstrs b) =>
AffineTraversal TxSkelRedeemer TxSkelRedeemer a b
txSkelRedeemerTypedAT @a AffineTraversal TxSkelRedeemer TxSkelRedeemer a b
-> b -> TxSkelRedeemer -> TxSkelRedeemer
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ b
typedRedeemerModified