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
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
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
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
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
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)
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)
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)
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)
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
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)
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"
TxReturnCollateral CtxTx ConwayEra
txReturnCollateral <-
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
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)
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)
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)