-- | 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 Cardano.Ledger.Conway.Core qualified as Conway
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Control.Monad
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx.Common
import Cooked.Skeleton
import Data.Set qualified as Set
import Ledger.Tx.CardanoAPI qualified as Ledger
import Lens.Micro.Extras qualified as MicroLens
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Value qualified as Script
import PlutusTx.Numeric qualified as PlutusTx

-- | Computes the collateral triplet from the fees and the collateral inputs in
-- the context. 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 ::
  (MonadBlockChainBalancing m) =>
  Fee ->
  Collaterals ->
  m
    ( Cardano.TxInsCollateral Cardano.ConwayEra,
      Cardano.TxTotalCollateral Cardano.ConwayEra,
      Cardano.TxReturnCollateral Cardano.CtxTx Cardano.ConwayEra
    )
toCollateralTriplet :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
Fee
-> Collaterals
-> m (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
toCollateralTriplet Fee
_ Collaterals
Nothing = (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
 TxReturnCollateral CtxTx ConwayEra)
-> m (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
forall a. a -> m 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 Fee
fee (Just (CollateralIns -> [TxOutRef]
forall a. Set a -> [a]
Set.toList -> [TxOutRef]
collateralInsList, Peer
returnCollateralUser)) = do
  -- We build the collateral inputs from this list
  TxInsCollateral ConwayEra
txInsCollateral <-
    case [TxOutRef]
collateralInsList of
      [] -> TxInsCollateral ConwayEra -> m (TxInsCollateral ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxInsCollateral ConwayEra
forall era. TxInsCollateral era
Cardano.TxInsCollateralNone
      [TxOutRef]
l -> String
-> Either ToCardanoError (TxInsCollateral ConwayEra)
-> m (TxInsCollateral ConwayEra)
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Either ToCardanoError a -> m a
throwOnToCardanoError String
"toCollateralTriplet" (Either ToCardanoError (TxInsCollateral ConwayEra)
 -> m (TxInsCollateral ConwayEra))
-> Either ToCardanoError (TxInsCollateral ConwayEra)
-> m (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
  -- Retrieving the total value in collateral inputs. This fails if one of the
  -- collateral inputs has not been successfully resolved.
  Value
collateralInsValue <-
    (Value -> TxOutRef -> m Value) -> Value -> [TxOutRef] -> m Value
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Value
val -> ((Value
val Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<>) (Value -> Value) -> m Value -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m Value -> m Value)
-> (TxOutRef -> m Value) -> TxOutRef -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens NoIx TxSkelOut Value -> TxOutRef -> m Value
forall (m :: * -> *) g (is :: IxList) c.
(MonadBlockChainBalancing m, Is g A_Getter) =>
Optic' g is TxSkelOut c -> TxOutRef -> m c
viewByRef Optic' A_Lens NoIx TxSkelOut Value
txSkelOutValueL) Value
forall a. Monoid a => a
mempty [TxOutRef]
collateralInsList
  -- We retrieve the collateral percentage compared to fees. By default, we use
  -- 150% which is the current value in the parameters, although the default
  -- value should never be used here, as the call is supposed to always succeed.
  Fee
collateralPercentage <- Natural -> Fee
forall a. Integral a => a -> Fee
toInteger (Natural -> Fee) -> (Params -> Natural) -> Params -> Fee
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Natural (PParams EmulatorEra) Natural
-> PParams EmulatorEra -> Natural
forall a s. Getting a s a -> s -> a
MicroLens.view Getting Natural (PParams EmulatorEra) Natural
forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
Lens' (PParams EmulatorEra) Natural
Conway.ppCollateralPercentageL (PParams EmulatorEra -> Natural)
-> (Params -> PParams EmulatorEra) -> Params -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> PParams EmulatorEra
Emulator.pEmulatorPParams (Params -> Fee) -> m Params -> m Fee
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
  -- The total collateral corresponds to the fees multiplied by the collateral
  -- percentage. We add 1 because the ledger apparently rounds up this value.
  let coinTotalCollateral :: Fee
coinTotalCollateral = Fee
1 Fee -> Fee -> Fee
forall a. Num a => a -> a -> a
+ (Fee
fee Fee -> Fee -> Fee
forall a. Num a => a -> a -> a
* Fee
collateralPercentage) Fee -> Fee -> Fee
forall a. Integral a => a -> a -> a
`div` Fee
100
  -- We create the total collateral based on the computed value
  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
$ Fee -> Coin
Cardano.Coin Fee
coinTotalCollateral
  -- We compute a return collateral value by subtracting the total collateral to
  -- the value in collateral inputs
  let returnCollateralValue :: Value
returnCollateralValue = Value
collateralInsValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
forall a. AdditiveGroup a => a -> a
PlutusTx.negate (Fee -> Value
Script.lovelace Fee
coinTotalCollateral)
  -- The return collateral is then computed
  TxReturnCollateral CtxTx ConwayEra
txReturnCollateral <-
    -- If the total collateral equal what the inputs provide, we return
    -- `TxReturnCollateralNone`, otherwise, we compute the new output
    if Value
returnCollateralValue Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
forall a. Monoid a => a
mempty
      then TxReturnCollateral CtxTx ConwayEra
-> m (TxReturnCollateral CtxTx ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxReturnCollateral CtxTx ConwayEra
forall ctx era. TxReturnCollateral ctx era
Cardano.TxReturnCollateralNone
      else do
        -- The value is a translation of the remaining value
        TxOutValue ConwayEra
txReturnCollateralValue <-
          Value -> TxOutValue ConwayEra
Ledger.toCardanoTxOutValue
            (Value -> TxOutValue ConwayEra)
-> m Value -> m (TxOutValue ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either ToCardanoError Value -> m Value
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Either ToCardanoError a -> m a
throwOnToCardanoError
              String
"toCollateralTriplet: cannot build return collateral value"
              (Value -> Either ToCardanoError Value
Ledger.toCardanoValue Value
returnCollateralValue)
        -- The address is the one from the return collateral user, which is
        -- required to exist here.
        NetworkId
networkId <- Params -> NetworkId
Emulator.pNetworkId (Params -> NetworkId) -> m Params -> m NetworkId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
        AddressInEra ConwayEra
address <-
          String
-> Either ToCardanoError (AddressInEra ConwayEra)
-> m (AddressInEra ConwayEra)
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Either ToCardanoError a -> m a
throwOnToCardanoError String
"toCollateralTriplet: cannot build return collateral address" (Either ToCardanoError (AddressInEra ConwayEra)
 -> m (AddressInEra ConwayEra))
-> Either ToCardanoError (AddressInEra ConwayEra)
-> m (AddressInEra ConwayEra)
forall a b. (a -> b) -> a -> b
$
            NetworkId
-> Address -> Either ToCardanoError (AddressInEra ConwayEra)
Ledger.toCardanoAddressInEra NetworkId
networkId (Peer -> Address
forall a. ToAddress a => a -> Address
Script.toAddress Peer
returnCollateralUser)
        -- The return collateral is built up from those elements
        TxReturnCollateral CtxTx ConwayEra
-> m (TxReturnCollateral CtxTx ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxReturnCollateral CtxTx ConwayEra
 -> m (TxReturnCollateral CtxTx ConwayEra))
-> TxReturnCollateral CtxTx ConwayEra
-> m (TxReturnCollateral CtxTx ConwayEra)
forall a b. (a -> b) -> a -> b
$
          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)
-> TxOut CtxTx ConwayEra -> TxReturnCollateral CtxTx ConwayEra
forall a b. (a -> b) -> a -> b
$
            AddressInEra ConwayEra
-> TxOutValue ConwayEra
-> TxOutDatum CtxTx ConwayEra
-> ReferenceScript ConwayEra
-> TxOut CtxTx ConwayEra
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
Cardano.TxOut AddressInEra ConwayEra
address TxOutValue ConwayEra
txReturnCollateralValue TxOutDatum CtxTx ConwayEra
forall ctx era. TxOutDatum ctx era
Cardano.TxOutDatumNone ReferenceScript ConwayEra
forall era. ReferenceScript era
Cardano.ReferenceScriptNone
  (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
 TxReturnCollateral CtxTx ConwayEra)
-> m (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxInsCollateral ConwayEra
txInsCollateral, TxTotalCollateral ConwayEra
txTotalCollateral, TxReturnCollateral CtxTx ConwayEra
txReturnCollateral)