-- | This module exposes a function to automatically fill the constitution
-- scripts of the proposals in a 'Cooked.Skeleton.TxSkel' based on the current
-- state of the blockchain.
module Cooked.MockChain.Automation.AutoFilling.Constitution
  ( autoFillConstitution,
  )
where

import Control.Monad
import Cooked.MockChain.Effect.Log
import Cooked.MockChain.Effect.Read
import Cooked.Skeleton
import Cooked.Tweak.Common
import Cooked.Tweak.Update
import Optics.Core
import Plutus.Script.Utils.Scripts qualified as Script
import Polysemy

-- * Auto filling constitution script

-- | Goes through all the proposals of the input skeleton and attempts to fill
-- out the constitution scripts with the current one. Does not tamper with an
-- existing specified script in such proposals. Logs an event when the
-- constitution script has been successfully auto-filled.
autoFillConstitution ::
  (Members '[MockChainRead, Tweak, MockChainLog] effs) =>
  Sem effs ()
autoFillConstitution :: forall (effs :: EffectRow).
Members '[MockChainRead, Tweak, MockChainLog] effs =>
Sem effs ()
autoFillConstitution = do
  Maybe VScript
currentConstitution <- Sem effs (Maybe VScript)
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs (Maybe VScript)
getConstitutionScript
  case Maybe VScript
currentConstitution of
    Maybe VScript
Nothing -> () -> Sem effs ()
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just VScript
constitutionScript -> do
      Optic' A_Traversal NoIx TxSkel TxSkelProposal
-> (TxSkelProposal -> Sem effs TxSkelProposal) -> Sem effs ()
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Traversal) =>
Optic' k is TxSkel a -> (a -> Sem effs a) -> Sem effs ()
traverseTweak (Lens' TxSkel [TxSkelProposal]
txSkelProposalsL Lens' TxSkel [TxSkelProposal]
-> Optic
     A_Traversal
     NoIx
     [TxSkelProposal]
     [TxSkelProposal]
     TxSkelProposal
     TxSkelProposal
-> Optic' A_Traversal NoIx TxSkel TxSkelProposal
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
  [TxSkelProposal]
  [TxSkelProposal]
  TxSkelProposal
  TxSkelProposal
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed) ((TxSkelProposal -> Sem effs TxSkelProposal) -> Sem effs ())
-> (TxSkelProposal -> Sem effs TxSkelProposal) -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ \TxSkelProposal
prop -> do
        Bool -> Sem effs () -> Sem effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Optic'
  An_AffineTraversal NoIx TxSkelProposal (User 'IsScript 'Redemption)
-> TxSkelProposal -> Bool
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Bool
isn't Optic'
  An_AffineTraversal NoIx TxSkelProposal (User 'IsScript 'Redemption)
txSkelProposalConstitutionAT TxSkelProposal
prop) (Sem effs () -> Sem effs ()) -> Sem effs () -> Sem effs ()
forall a b. (a -> b) -> a -> b
$
          MockChainLogEntry -> Sem effs ()
forall (effs :: EffectRow).
Member MockChainLog effs =>
MockChainLogEntry -> Sem effs ()
logEvent (MockChainLogEntry -> Sem effs ())
-> MockChainLogEntry -> Sem effs ()
forall a b. (a -> b) -> a -> b
$
            ScriptHash -> MockChainLogEntry
MCLogAutoFilledConstitution (ScriptHash -> MockChainLogEntry)
-> ScriptHash -> MockChainLogEntry
forall a b. (a -> b) -> a -> b
$
              VScript -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash VScript
constitutionScript
        TxSkelProposal -> Sem effs TxSkelProposal
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (VScript -> TxSkelProposal -> TxSkelProposal
forall script.
(ToVScript script, Typeable script) =>
script -> TxSkelProposal -> TxSkelProposal
fillConstitution VScript
constitutionScript TxSkelProposal
prop)