-- | This module exposes a function to automatically fill the withdrawn amounts
-- of a 'Cooked.Skeleton.TxSkel' based on the current state of the blockchain.
module Cooked.MockChain.Automation.AutoFilling.Withdrawals
  ( autoFillWithdrawalAmounts,
  )
where

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.Address qualified as Script
import Polysemy

-- * Auto filling withdrawal amounts

-- | Goes through all the withdrawals of the input skeleton and attempts to fill
-- out the withdrawn amount based on the associated user rewards. Does not
-- tamper with an existing specified amount in such withdrawals. Logs an event
-- when an amount has been successfully auto-filled.
autoFillWithdrawalAmounts ::
  (Members '[MockChainRead, Tweak, MockChainLog] effs) =>
  Sem effs ()
autoFillWithdrawalAmounts :: forall (effs :: EffectRow).
Members '[MockChainRead, Tweak, MockChainLog] effs =>
Sem effs ()
autoFillWithdrawalAmounts = do
  Optic' A_Traversal '[] TxSkel Withdrawal
-> (Withdrawal -> Sem effs Withdrawal) -> 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 TxSkelWithdrawals
txSkelWithdrawalsL Lens' TxSkel TxSkelWithdrawals
-> Optic
     An_Iso
     '[]
     TxSkelWithdrawals
     TxSkelWithdrawals
     [Withdrawal]
     [Withdrawal]
-> Optic A_Lens '[] TxSkel TxSkel [Withdrawal] [Withdrawal]
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
  An_Iso
  '[]
  TxSkelWithdrawals
  TxSkelWithdrawals
  [Withdrawal]
  [Withdrawal]
txSkelWithdrawalsListI Optic A_Lens '[] TxSkel TxSkel [Withdrawal] [Withdrawal]
-> Optic
     A_Traversal '[] [Withdrawal] [Withdrawal] Withdrawal Withdrawal
-> Optic' A_Traversal '[] TxSkel Withdrawal
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 '[] [Withdrawal] [Withdrawal] Withdrawal Withdrawal
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed) ((Withdrawal -> Sem effs Withdrawal) -> Sem effs ())
-> (Withdrawal -> Sem effs Withdrawal) -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ \Withdrawal
withdrawal -> do
    Maybe Lovelace
currentReward <- User 'IsEither 'Redemption -> Sem effs (Maybe Lovelace)
forall (effs :: EffectRow) c.
(Member MockChainRead effs, ToCredential c) =>
c -> Sem effs (Maybe Lovelace)
getCurrentReward (User 'IsEither 'Redemption -> Sem effs (Maybe Lovelace))
-> User 'IsEither 'Redemption -> Sem effs (Maybe Lovelace)
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens '[] Withdrawal (User 'IsEither 'Redemption)
-> Withdrawal -> User 'IsEither 'Redemption
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] Withdrawal (User 'IsEither 'Redemption)
withdrawalUserL Withdrawal
withdrawal
    case Maybe Lovelace
currentReward of
      Just Lovelace
reward | Optic' An_AffineTraversal '[] Withdrawal Lovelace
-> Withdrawal -> Bool
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Bool
isn't Optic' An_AffineTraversal '[] Withdrawal Lovelace
withdrawalAmountAT Withdrawal
withdrawal -> do
        let newWithdrawal :: Withdrawal
newWithdrawal = Lovelace -> Withdrawal -> Withdrawal
fillAmount Lovelace
reward Withdrawal
withdrawal
        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
$
          Credential -> Lovelace -> MockChainLogEntry
MCLogAutoFilledWithdrawalAmount
            (Optic' A_Getter '[] Withdrawal Credential
-> Withdrawal -> Credential
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic' A_Lens '[] Withdrawal (User 'IsEither 'Redemption)
withdrawalUserL Optic' A_Lens '[] Withdrawal (User 'IsEither 'Redemption)
-> Optic
     A_Getter
     '[]
     (User 'IsEither 'Redemption)
     (User 'IsEither 'Redemption)
     Credential
     Credential
-> Optic' A_Getter '[] Withdrawal Credential
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
% (User 'IsEither 'Redemption -> Credential)
-> Optic
     A_Getter
     '[]
     (User 'IsEither 'Redemption)
     (User 'IsEither 'Redemption)
     Credential
     Credential
forall s a. (s -> a) -> Getter s a
to User 'IsEither 'Redemption -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential) Withdrawal
newWithdrawal)
            Lovelace
reward
        Withdrawal -> Sem effs Withdrawal
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return Withdrawal
newWithdrawal
      Maybe Lovelace
_ -> Withdrawal -> Sem effs Withdrawal
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return Withdrawal
withdrawal