-- | This module allows the generation of Cardano reference inputs
module Cooked.MockChain.GenerateTx.ReferenceInputs (toInsReference) where

import Cardano.Api qualified as Cardano
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx.Common
import Cooked.Skeleton
import Data.Map qualified as Map
import Data.Set qualified as Set
import Ledger.Tx.CardanoAPI qualified as Ledger
import PlutusLedgerApi.V3 qualified as Api

-- | Takes a 'TxSkel' and generates the associated 'Cardano.TxInsReference' from
-- its content. These reference inputs can be found in two places, either in
-- direct reference inputs 'txSkelInsReference' or scattered in the various
-- redeemers of the transaction, which can be gathered with
-- 'txSkelInsReferenceInRedeemers'.
toInsReference :: (MonadBlockChainBalancing m) => TxSkel -> m (Cardano.TxInsReference Cardano.BuildTx Cardano.ConwayEra)
toInsReference :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkel -> m (TxInsReference BuildTx ConwayEra)
toInsReference TxSkel
skel = do
  -- As regular inputs can be used to hold scripts as if in reference inputs, we
  -- need to remove from the reference inputs stored in redeemers the ones that
  -- already appear in the inputs to avoid validation errors.
  let indirectReferenceInputs :: Set TxOutRef
indirectReferenceInputs = TxSkel -> Set TxOutRef
txSkelInsReferenceInRedeemers TxSkel
skel
      redundantReferenceInputs :: Set TxOutRef
redundantReferenceInputs = Set TxOutRef
indirectReferenceInputs Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Map TxOutRef TxSkelRedeemer -> Set TxOutRef
forall k a. Map k a -> Set k
Map.keysSet (TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelIns TxSkel
skel)
      refInputs :: [TxOutRef]
refInputs = Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList (TxSkel -> Set TxOutRef
txSkelInsReference TxSkel
skel Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Semigroup a => a -> a -> a
<> Set TxOutRef
indirectReferenceInputs Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set TxOutRef
redundantReferenceInputs)
  if [TxOutRef] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxOutRef]
refInputs
    then TxInsReference BuildTx ConwayEra
-> m (TxInsReference BuildTx ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxInsReference BuildTx ConwayEra
forall build era. TxInsReference build era
Cardano.TxInsReferenceNone
    else do
      [TxIn]
cardanoRefInputs <-
        String -> Either ToCardanoError [TxIn] -> m [TxIn]
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Either ToCardanoError a -> m a
throwOnToCardanoError
          String
"toInsReference: Unable to translate reference inputs."
          ((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]
refInputs)
      [TxSkelOutDatum]
resolvedOutputs <- (TxOutRef -> m TxSkelOutDatum) -> [TxOutRef] -> m [TxSkelOutDatum]
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 -> m TxSkelOutDatum
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxOutRef -> m TxSkelOutDatum
unsafeDatumFromTxOutRef [TxOutRef]
refInputs
      TxInsReference BuildTx ConwayEra
-> m (TxInsReference BuildTx ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxInsReference BuildTx ConwayEra
 -> m (TxInsReference BuildTx ConwayEra))
-> TxInsReference BuildTx ConwayEra
-> m (TxInsReference BuildTx ConwayEra)
forall a b. (a -> b) -> a -> b
$
        BabbageEraOnwards ConwayEra
-> [TxIn]
-> TxInsReferenceDatums BuildTx
-> TxInsReference BuildTx ConwayEra
forall era build.
BabbageEraOnwards era
-> [TxIn] -> TxInsReferenceDatums build -> TxInsReference build era
Cardano.TxInsReference BabbageEraOnwards ConwayEra
Cardano.BabbageEraOnwardsConway [TxIn]
cardanoRefInputs (TxInsReferenceDatums BuildTx -> TxInsReference BuildTx ConwayEra)
-> TxInsReferenceDatums BuildTx -> TxInsReference BuildTx ConwayEra
forall a b. (a -> b) -> a -> b
$
          Set HashableScriptData -> TxInsReferenceDatums BuildTx
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith (Set HashableScriptData -> TxInsReferenceDatums BuildTx)
-> Set HashableScriptData -> TxInsReferenceDatums BuildTx
forall a b. (a -> b) -> a -> b
$
            [HashableScriptData] -> Set HashableScriptData
forall a. Ord a => [a] -> Set a
Set.fromList
              [BuiltinData -> HashableScriptData
Ledger.toCardanoScriptData (BuiltinData -> HashableScriptData)
-> BuiltinData -> HashableScriptData
forall a b. (a -> b) -> a -> b
$ DatumContent -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData DatumContent
dat | TxSkelOutSomeDatum DatumContent
dat (Hashed DatumResolved
_) <- [TxSkelOutDatum]
resolvedOutputs]