module Cooked.MockChain.GenerateTx.Collateral where

import Cardano.Api qualified as Cardano
import Cardano.Api.Shelley qualified as Cardano hiding (Testnet)
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Control.Monad
import Cooked.Conversion
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx.Common
import Cooked.Wallet
import Data.Maybe
import Data.Set (Set)
import Data.Set qualified as Set
import Ledger.Tx.CardanoAPI qualified as Ledger
import PlutusLedgerApi.V1.Value qualified as Api
import PlutusLedgerApi.V3 qualified as Api
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) =>
  Integer ->
  Maybe (Set Api.TxOutRef, Wallet) ->
  m
    ( Cardano.TxInsCollateral Cardano.ConwayEra,
      Cardano.TxTotalCollateral Cardano.ConwayEra,
      Cardano.TxReturnCollateral Cardano.CtxTx Cardano.ConwayEra
    )
toCollateralTriplet :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
Integer
-> Maybe (Set TxOutRef, Wallet)
-> m (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
toCollateralTriplet Integer
_ Maybe (Set TxOutRef, Wallet)
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 Integer
fee (Just (Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList -> [TxOutRef]
collateralInsList, Wallet
returnCollateralWallet)) = 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
. (String -> Maybe Value -> m Value
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Maybe a -> m a
throwOnMaybe String
"toCollateralTriplet: unresolved txOutRefs" (Maybe Value -> m Value)
-> (TxOutRef -> m (Maybe Value)) -> TxOutRef -> m Value
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< TxOutRef -> m (Maybe Value)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m (Maybe Value)
valueFromTxOutRef)) 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.
  Integer
collateralPercentage <- Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer) -> (Params -> Natural) -> Params -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
150 (Maybe Natural -> Natural)
-> (Params -> Maybe Natural) -> Params -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolParameters -> Maybe Natural
Cardano.protocolParamCollateralPercent (ProtocolParameters -> Maybe Natural)
-> (Params -> ProtocolParameters) -> Params -> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> ProtocolParameters
Emulator.pProtocolParams (Params -> Integer) -> m Params -> m Integer
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 :: Coin
coinTotalCollateral = Integer -> Coin
Emulator.Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
fee Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
collateralPercentage) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
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
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 (Coin -> Value
forall a. ToValue a => a -> Value
toValue Coin
coinTotalCollateral)
  -- This should never happen, as we always compute the collaterals for the
  -- user, but we guard against having some negative elements in the value in
  -- case we give more freedom to the users in the future
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Value, Value) -> Value
forall a b. (a, b) -> a
fst (Value -> (Value, Value)
Api.split Value
returnCollateralValue) Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
forall a. Monoid a => a
mempty) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> m a
throwOnString String
"toCollateralTriplet: negative parts in return collateral value"
  -- 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 wallet, 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 (Wallet -> Address
walletAddress Wallet
returnCollateralWallet)
        -- 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)