-- | This module exposes the generation of transaction collaterals, which
-- consist of a collateral amount, collateral inputs and return collateral
module Cooked.MockChain.GenerateTx.Collateral where

import Cardano.Api qualified as Cardano
import Cooked.MockChain.Common
import Cooked.MockChain.GenerateTx.Output
import Cooked.MockChain.Read
import Cooked.Skeleton.Output
import Cooked.Skeleton.Value
import Data.Map qualified as Map
import Data.Set qualified as Set
import Ledger.Tx.CardanoAPI qualified as Ledger
import Optics.Core
import PlutusLedgerApi.V3 qualified as Api
import Polysemy
import Polysemy.Error

-- | Computes the collateral triplet from the potential collaterals. What we
-- call a collateral triplet is composed of:
--
-- * The set of collateral inputs
--
-- * The total collateral paid by the transaction in case of phase 2 failure
--
-- * An output returning excess collateral value when collaterals are used
--
-- These quantity should satisfy the equation (in terms of their values):
-- collateral inputs = total collateral + return collateral
toCollateralTriplet ::
  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
  Maybe Collaterals ->
  Sem
    effs
    ( Cardano.TxInsCollateral Cardano.ConwayEra,
      Cardano.TxTotalCollateral Cardano.ConwayEra,
      Cardano.TxReturnCollateral Cardano.CtxTx Cardano.ConwayEra
    )
toCollateralTriplet :: forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
Maybe Collaterals
-> Sem
     effs
     (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
toCollateralTriplet Maybe Collaterals
Nothing = (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
 TxReturnCollateral CtxTx ConwayEra)
-> Sem
     effs
     (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxInsCollateral ConwayEra
forall era. TxInsCollateral era
Cardano.TxInsCollateralNone, TxTotalCollateral ConwayEra
forall era. TxTotalCollateral era
Cardano.TxTotalCollateralNone, TxReturnCollateral CtxTx ConwayEra
forall ctx era. TxReturnCollateral ctx era
Cardano.TxReturnCollateralNone)
toCollateralTriplet (Just (CollateralIns -> [TxOutRef]
forall a. Set a -> [a]
Set.toList -> [TxOutRef]
collateralInsList, Maybe TxSkelOut
mReturnCollateral)) = do
  -- We build the collateral inputs from this list
  TxInsCollateral ConwayEra
txInsCollateral <-
    case [TxOutRef]
collateralInsList of
      [] -> TxInsCollateral ConwayEra -> Sem effs (TxInsCollateral ConwayEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return TxInsCollateral ConwayEra
forall era. TxInsCollateral era
Cardano.TxInsCollateralNone
      [TxOutRef]
l -> Either ToCardanoError (TxInsCollateral ConwayEra)
-> Sem effs (TxInsCollateral ConwayEra)
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either ToCardanoError (TxInsCollateral ConwayEra)
 -> Sem effs (TxInsCollateral ConwayEra))
-> Either ToCardanoError (TxInsCollateral ConwayEra)
-> Sem effs (TxInsCollateral ConwayEra)
forall a b. (a -> b) -> a -> b
$ AlonzoEraOnwards ConwayEra -> [TxIn] -> TxInsCollateral ConwayEra
forall era. AlonzoEraOnwards era -> [TxIn] -> TxInsCollateral era
Cardano.TxInsCollateral AlonzoEraOnwards ConwayEra
Cardano.AlonzoEraOnwardsConway ([TxIn] -> TxInsCollateral ConwayEra)
-> Either ToCardanoError [TxIn]
-> Either ToCardanoError (TxInsCollateral ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxOutRef -> Either ToCardanoError TxIn)
-> [TxOutRef] -> Either ToCardanoError [TxIn]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TxOutRef -> Either ToCardanoError TxIn
Ledger.toCardanoTxIn [TxOutRef]
l
  -- We collect the amount of lovelace in the collateral inputs
  Api.Lovelace Integer
collateralInsLovelace <- Optic' A_Fold '[] [TxSkelOut] Lovelace -> [TxSkelOut] -> Lovelace
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (Fold [TxSkelOut] TxSkelOut
forall (f :: * -> *) a. Foldable f => Fold (f a) a
folded Fold [TxSkelOut] TxSkelOut
-> Optic A_Lens '[] TxSkelOut TxSkelOut Value Value
-> Optic A_Fold '[] [TxSkelOut] [TxSkelOut] Value Value
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 '[] TxSkelOut TxSkelOut Value Value
txSkelOutValueL Optic A_Fold '[] [TxSkelOut] [TxSkelOut] Value Value
-> Optic A_Lens '[] Value Value Lovelace Lovelace
-> Optic' A_Fold '[] [TxSkelOut] Lovelace
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 '[] Value Value Lovelace Lovelace
valueLovelaceL) ([TxSkelOut] -> Lovelace)
-> (Map TxOutRef TxSkelOut -> [TxSkelOut])
-> Map TxOutRef TxSkelOut
-> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxOutRef TxSkelOut -> [TxSkelOut]
forall k a. Map k a -> [a]
Map.elems (Map TxOutRef TxSkelOut -> Lovelace)
-> Sem effs (Map TxOutRef TxSkelOut) -> Sem effs Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef] -> Sem effs (Map TxOutRef TxSkelOut)
forall (effs :: EffectRow).
Member MockChainRead effs =>
[TxOutRef] -> Sem effs (Map TxOutRef TxSkelOut)
lookupUtxos [TxOutRef]
collateralInsList
  -- We collect the amount of lovelace in the return collateral output
  let Api.Lovelace Integer
returnCollateralLovelace = Lovelace -> (TxSkelOut -> Lovelace) -> Maybe TxSkelOut -> Lovelace
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Lovelace
0 (Optic' A_Lens '[] TxSkelOut Lovelace -> TxSkelOut -> Lovelace
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic A_Lens '[] TxSkelOut TxSkelOut Value Value
txSkelOutValueL Optic A_Lens '[] TxSkelOut TxSkelOut Value Value
-> Optic A_Lens '[] Value Value Lovelace Lovelace
-> Optic' A_Lens '[] TxSkelOut Lovelace
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 '[] Value Value Lovelace Lovelace
valueLovelaceL)) Maybe TxSkelOut
mReturnCollateral
  -- The total collateral is the difference between the two
  let txTotalCollateral :: TxTotalCollateral ConwayEra
txTotalCollateral = BabbageEraOnwards ConwayEra -> Coin -> TxTotalCollateral ConwayEra
forall era. BabbageEraOnwards era -> Coin -> TxTotalCollateral era
Cardano.TxTotalCollateral BabbageEraOnwards ConwayEra
Cardano.BabbageEraOnwardsConway (Coin -> TxTotalCollateral ConwayEra)
-> Coin -> TxTotalCollateral ConwayEra
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Cardano.Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
collateralInsLovelace Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
returnCollateralLovelace
  TxReturnCollateral CtxTx ConwayEra
txReturnCollateral <-
    case Maybe TxSkelOut
mReturnCollateral of
      Maybe TxSkelOut
Nothing -> TxReturnCollateral CtxTx ConwayEra
-> Sem effs (TxReturnCollateral CtxTx ConwayEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return TxReturnCollateral CtxTx ConwayEra
forall ctx era. TxReturnCollateral ctx era
Cardano.TxReturnCollateralNone
      Just TxSkelOut
collateralOut -> BabbageEraOnwards ConwayEra
-> TxOut CtxTx ConwayEra -> TxReturnCollateral CtxTx ConwayEra
forall era ctx.
BabbageEraOnwards era
-> TxOut ctx era -> TxReturnCollateral ctx era
Cardano.TxReturnCollateral BabbageEraOnwards ConwayEra
Cardano.BabbageEraOnwardsConway (TxOut CtxTx ConwayEra -> TxReturnCollateral CtxTx ConwayEra)
-> Sem effs (TxOut CtxTx ConwayEra)
-> Sem effs (TxReturnCollateral CtxTx ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxSkelOut -> Sem effs (TxOut CtxTx ConwayEra)
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxSkelOut -> Sem effs (TxOut CtxTx ConwayEra)
toCardanoTxOut TxSkelOut
collateralOut
  (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
 TxReturnCollateral CtxTx ConwayEra)
-> Sem
     effs
     (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxInsCollateral ConwayEra
txInsCollateral, TxTotalCollateral ConwayEra
txTotalCollateral, TxReturnCollateral CtxTx ConwayEra
txReturnCollateral)