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 Control.Monad.Reader
import Cooked.Conversion
import Cooked.MockChain.GenerateTx.Common
import Cooked.Wallet
import Data.Map (Map)
import Data.Map qualified as Map
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

data CollateralContext where
  CollateralContext ::
    { CollateralContext -> Map TxOutRef TxOut
managedTxOuts :: Map Api.TxOutRef Api.TxOut,
      CollateralContext -> Integer
fee :: Integer,
      CollateralContext -> Maybe (Set TxOutRef, Wallet)
mCollaterals :: Maybe (Set Api.TxOutRef, Wallet),
      CollateralContext -> Params
params :: Emulator.Params
    } ->
    CollateralContext

type CollateralGen a = TxGen CollateralContext a

-- | 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 ::
  CollateralGen
    ( Cardano.TxInsCollateral Cardano.ConwayEra,
      Cardano.TxTotalCollateral Cardano.ConwayEra,
      Cardano.TxReturnCollateral Cardano.CtxTx Cardano.ConwayEra
    )
toCollateralTriplet :: CollateralGen
  (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
   TxReturnCollateral CtxTx ConwayEra)
toCollateralTriplet = do
  -- Retrieving the optional collaterals and associated wallet
  Maybe (Set TxOutRef, Wallet)
mCollaterals <- (CollateralContext -> Maybe (Set TxOutRef, Wallet))
-> ReaderT
     CollateralContext
     (Either GenerateTxError)
     (Maybe (Set TxOutRef, Wallet))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CollateralContext -> Maybe (Set TxOutRef, Wallet)
mCollaterals
  case Maybe (Set TxOutRef, Wallet)
mCollaterals of
    -- If this is nothing, it means no collateral is needed (no script involved)
    Maybe (Set TxOutRef, Wallet)
Nothing -> (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
 TxReturnCollateral CtxTx ConwayEra)
-> CollateralGen
     (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
forall a. a -> ReaderT CollateralContext (Either GenerateTxError) 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)
    Just (Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList -> [TxOutRef]
collateralInsList, Wallet
returnCollateralWallet) -> do
      -- Retrieving know outputs
      Map TxOutRef TxOut
knownTxOuts <- (CollateralContext -> Map TxOutRef TxOut)
-> ReaderT
     CollateralContext (Either GenerateTxError) (Map TxOutRef TxOut)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CollateralContext -> Map TxOutRef TxOut
managedTxOuts
      -- We build the collateral inputs from this list
      TxInsCollateral ConwayEra
txInsCollateral <-
        case [TxOutRef]
collateralInsList of
          [] -> TxInsCollateral ConwayEra
-> ReaderT
     CollateralContext
     (Either GenerateTxError)
     (TxInsCollateral ConwayEra)
forall a. a -> ReaderT CollateralContext (Either GenerateTxError) 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)
-> ReaderT
     CollateralContext
     (Either GenerateTxError)
     (TxInsCollateral ConwayEra)
forall a context.
String -> Either ToCardanoError a -> TxGen context a
throwOnToCardanoError String
"txOutRefsToTxInCollateral" (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
      -- collaterals has been been successfully resolved.
      Value
collateralInsValue <- do
        let collateralInsResolved :: [TxOut]
collateralInsResolved = (TxOutRef -> Maybe TxOut) -> [TxOutRef] -> [TxOut]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TxOutRef -> Map TxOutRef TxOut -> Maybe TxOut
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map TxOutRef TxOut
knownTxOuts) [TxOutRef]
collateralInsList
        Bool
-> ReaderT CollateralContext (Either GenerateTxError) ()
-> ReaderT CollateralContext (Either GenerateTxError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([TxOut] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOut]
collateralInsResolved Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [TxOutRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxOutRef]
collateralInsList) (ReaderT CollateralContext (Either GenerateTxError) ()
 -> ReaderT CollateralContext (Either GenerateTxError) ())
-> ReaderT CollateralContext (Either GenerateTxError) ()
-> ReaderT CollateralContext (Either GenerateTxError) ()
forall a b. (a -> b) -> a -> b
$ String -> ReaderT CollateralContext (Either GenerateTxError) ()
forall context a. String -> TxGen context a
throwOnString String
"toCollateralTriplet: unresolved txOutRefs"
        Value -> ReaderT CollateralContext (Either GenerateTxError) Value
forall a. a -> ReaderT CollateralContext (Either GenerateTxError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> ReaderT CollateralContext (Either GenerateTxError) Value)
-> Value
-> ReaderT CollateralContext (Either GenerateTxError) Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat (TxOut -> Value
Api.txOutValue (TxOut -> Value) -> [TxOut] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOut]
collateralInsResolved)
      -- 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 <- (CollateralContext -> Integer)
-> ReaderT CollateralContext (Either GenerateTxError) Integer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer)
-> (CollateralContext -> Natural) -> CollateralContext -> 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)
-> (CollateralContext -> Maybe Natural)
-> CollateralContext
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolParameters -> Maybe Natural
Cardano.protocolParamCollateralPercent (ProtocolParameters -> Maybe Natural)
-> (CollateralContext -> ProtocolParameters)
-> CollateralContext
-> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> ProtocolParameters
Emulator.pProtocolParams (Params -> ProtocolParameters)
-> (CollateralContext -> Params)
-> CollateralContext
-> ProtocolParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CollateralContext -> Params
params)
      -- The total collateral corresponds to the fees multiplied by the collateral
      -- percentage. We add 1 because the ledger apparently rounds up this value.
      Coin
coinTotalCollateral <- (CollateralContext -> Coin)
-> ReaderT CollateralContext (Either GenerateTxError) Coin
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Integer -> Coin
Emulator.Coin (Integer -> Coin)
-> (CollateralContext -> Integer) -> CollateralContext -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) (Integer -> Integer)
-> (CollateralContext -> Integer) -> CollateralContext -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
100) (Integer -> Integer)
-> (CollateralContext -> Integer) -> CollateralContext -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
collateralPercentage) (Integer -> Integer)
-> (CollateralContext -> Integer) -> CollateralContext -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CollateralContext -> Integer
fee)
      -- 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
-> ReaderT CollateralContext (Either GenerateTxError) ()
-> ReaderT CollateralContext (Either GenerateTxError) ()
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) (ReaderT CollateralContext (Either GenerateTxError) ()
 -> ReaderT CollateralContext (Either GenerateTxError) ())
-> ReaderT CollateralContext (Either GenerateTxError) ()
-> ReaderT CollateralContext (Either GenerateTxError) ()
forall a b. (a -> b) -> a -> b
$ String -> ReaderT CollateralContext (Either GenerateTxError) ()
forall context a. String -> TxGen context 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
-> ReaderT
     CollateralContext
     (Either GenerateTxError)
     (TxReturnCollateral CtxTx ConwayEra)
forall a. a -> ReaderT CollateralContext (Either GenerateTxError) 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)
-> ReaderT CollateralContext (Either GenerateTxError) Value
-> ReaderT
     CollateralContext (Either GenerateTxError) (TxOutValue ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> Either ToCardanoError Value
-> ReaderT CollateralContext (Either GenerateTxError) Value
forall a context.
String -> Either ToCardanoError a -> TxGen context 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.
            AddressInEra ConwayEra
address <- do
              NetworkId
networkId <- (CollateralContext -> NetworkId)
-> ReaderT CollateralContext (Either GenerateTxError) NetworkId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Params -> NetworkId
Emulator.pNetworkId (Params -> NetworkId)
-> (CollateralContext -> Params) -> CollateralContext -> NetworkId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CollateralContext -> Params
params)
              String
-> Either ToCardanoError (AddressInEra ConwayEra)
-> ReaderT
     CollateralContext (Either GenerateTxError) (AddressInEra ConwayEra)
forall a context.
String -> Either ToCardanoError a -> TxGen context a
throwOnToCardanoError String
"toCollateralTriplet: cannot build return collateral address" (Either ToCardanoError (AddressInEra ConwayEra)
 -> ReaderT
      CollateralContext
      (Either GenerateTxError)
      (AddressInEra ConwayEra))
-> Either ToCardanoError (AddressInEra ConwayEra)
-> ReaderT
     CollateralContext (Either GenerateTxError) (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
-> ReaderT
     CollateralContext
     (Either GenerateTxError)
     (TxReturnCollateral CtxTx ConwayEra)
forall a. a -> ReaderT CollateralContext (Either GenerateTxError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxReturnCollateral CtxTx ConwayEra
 -> ReaderT
      CollateralContext
      (Either GenerateTxError)
      (TxReturnCollateral CtxTx ConwayEra))
-> TxReturnCollateral CtxTx ConwayEra
-> ReaderT
     CollateralContext
     (Either GenerateTxError)
     (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)
-> CollateralGen
     (TxInsCollateral ConwayEra, TxTotalCollateral ConwayEra,
      TxReturnCollateral CtxTx ConwayEra)
forall a. a -> ReaderT CollateralContext (Either GenerateTxError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxInsCollateral ConwayEra
txInsCollateral, TxTotalCollateral ConwayEra
txTotalCollateral, TxReturnCollateral CtxTx ConwayEra
txReturnCollateral)