module Cooked.MockChain.GenerateTx.Input
  ( toTxInAndWitness,
    InputContext (..),
  )
where

import Cardano.Api qualified as Cardano
import Control.Monad.Reader
import Cooked.MockChain.GenerateTx.Common
import Cooked.MockChain.GenerateTx.Witness
import Cooked.Skeleton
import Data.Map (Map)
import Ledger.Tx.CardanoAPI qualified as Ledger
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api

data InputContext where
  InputContext ::
    { InputContext -> Map DatumHash Datum
managedData :: Map Api.DatumHash Api.Datum,
      InputContext -> Map TxOutRef TxOut
managedTxOuts :: Map Api.TxOutRef Api.TxOut,
      InputContext -> Map ValidatorHash (Versioned Validator)
managedValidators :: Map Script.ValidatorHash (Script.Versioned Script.Validator)
    } ->
    InputContext

instance Transform InputContext (Map Api.TxOutRef Api.TxOut) where
  transform :: InputContext -> Map TxOutRef TxOut
transform = InputContext -> Map TxOutRef TxOut
managedTxOuts

type InputGen a = TxGen InputContext a

-- | Converts a 'TxSkel' input, which consists of a 'Api.TxOutRef' and a
-- 'TxSkelIn', into a 'Cardano.TxIn', together with the appropriate witness.
toTxInAndWitness ::
  (Api.TxOutRef, TxSkelRedeemer) ->
  InputGen (Cardano.TxIn, Cardano.BuildTxWith Cardano.BuildTx (Cardano.Witness Cardano.WitCtxTxIn Cardano.ConwayEra))
toTxInAndWitness :: (TxOutRef, TxSkelRedeemer)
-> InputGen
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
toTxInAndWitness (TxOutRef
txOutRef, TxSkelRedeemer
txSkelRedeemer) = do
  Api.TxOut (Api.Address Credential
cred Maybe StakingCredential
_) Value
_ OutputDatum
datum Maybe ScriptHash
_ <- String
-> TxOutRef -> Map TxOutRef TxOut -> TxGen InputContext TxOut
forall k a context.
Ord k =>
String -> k -> Map k a -> TxGen context a
throwOnLookup String
"toTxInAndWitness: Unknown txOutRef" TxOutRef
txOutRef (Map TxOutRef TxOut -> TxGen InputContext TxOut)
-> ReaderT
     InputContext (Either GenerateTxError) (Map TxOutRef TxOut)
-> TxGen InputContext TxOut
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (InputContext -> Map TxOutRef TxOut)
-> ReaderT
     InputContext (Either GenerateTxError) (Map TxOutRef TxOut)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks InputContext -> Map TxOutRef TxOut
managedTxOuts
  Witness WitCtxTxIn ConwayEra
witness <- case Credential
cred of
    Api.PubKeyCredential PubKeyHash
_ -> Witness WitCtxTxIn ConwayEra
-> ReaderT
     InputContext
     (Either GenerateTxError)
     (Witness WitCtxTxIn ConwayEra)
forall a. a -> ReaderT InputContext (Either GenerateTxError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Witness WitCtxTxIn ConwayEra
 -> ReaderT
      InputContext
      (Either GenerateTxError)
      (Witness WitCtxTxIn ConwayEra))
-> Witness WitCtxTxIn ConwayEra
-> ReaderT
     InputContext
     (Either GenerateTxError)
     (Witness WitCtxTxIn ConwayEra)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn ConwayEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
Cardano.KeyWitness KeyWitnessInCtx WitCtxTxIn
Cardano.KeyWitnessForSpending
    Api.ScriptCredential (Api.ScriptHash BuiltinByteString
scriptHash) -> do
      Versioned Validator
validator <- String
-> ValidatorHash
-> Map ValidatorHash (Versioned Validator)
-> TxGen InputContext (Versioned Validator)
forall k a context.
Ord k =>
String -> k -> Map k a -> TxGen context a
throwOnLookup String
"toTxInAndWitness: Unknown validator" (BuiltinByteString -> ValidatorHash
Script.ValidatorHash BuiltinByteString
scriptHash) (Map ValidatorHash (Versioned Validator)
 -> TxGen InputContext (Versioned Validator))
-> ReaderT
     InputContext
     (Either GenerateTxError)
     (Map ValidatorHash (Versioned Validator))
-> TxGen InputContext (Versioned Validator)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (InputContext -> Map ValidatorHash (Versioned Validator))
-> ReaderT
     InputContext
     (Either GenerateTxError)
     (Map ValidatorHash (Versioned Validator))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks InputContext -> Map ValidatorHash (Versioned Validator)
managedValidators
      ScriptDatum WitCtxTxIn
scriptDatum <- case OutputDatum
datum of
        OutputDatum
Api.NoOutputDatum -> String
-> ReaderT
     InputContext (Either GenerateTxError) (ScriptDatum WitCtxTxIn)
forall context a. String -> TxGen context a
throwOnString String
"toTxInAndWitness: No datum found on script output"
        Api.OutputDatum Datum
_ -> ScriptDatum WitCtxTxIn
-> ReaderT
     InputContext (Either GenerateTxError) (ScriptDatum WitCtxTxIn)
forall a. a -> ReaderT InputContext (Either GenerateTxError) a
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptDatum WitCtxTxIn
Cardano.InlineScriptDatum
        Api.OutputDatumHash DatumHash
datumHash -> do
          Datum
sDatum <- String
-> DatumHash -> Map DatumHash Datum -> TxGen InputContext Datum
forall k a context.
Ord k =>
String -> k -> Map k a -> TxGen context a
throwOnLookup String
"toTxInAndWitness: Unknown datum hash" DatumHash
datumHash (Map DatumHash Datum -> TxGen InputContext Datum)
-> ReaderT
     InputContext (Either GenerateTxError) (Map DatumHash Datum)
-> TxGen InputContext Datum
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (InputContext -> Map DatumHash Datum)
-> ReaderT
     InputContext (Either GenerateTxError) (Map DatumHash Datum)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks InputContext -> Map DatumHash Datum
managedData
          ScriptDatum WitCtxTxIn
-> ReaderT
     InputContext (Either GenerateTxError) (ScriptDatum WitCtxTxIn)
forall a. a -> ReaderT InputContext (Either GenerateTxError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptDatum WitCtxTxIn
 -> ReaderT
      InputContext (Either GenerateTxError) (ScriptDatum WitCtxTxIn))
-> ScriptDatum WitCtxTxIn
-> ReaderT
     InputContext (Either GenerateTxError) (ScriptDatum WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$ HashableScriptData -> ScriptDatum WitCtxTxIn
Cardano.ScriptDatumForTxIn (HashableScriptData -> ScriptDatum WitCtxTxIn)
-> HashableScriptData -> ScriptDatum WitCtxTxIn
forall a b. (a -> b) -> a -> b
$ BuiltinData -> HashableScriptData
Ledger.toCardanoScriptData (BuiltinData -> HashableScriptData)
-> BuiltinData -> HashableScriptData
forall a b. (a -> b) -> a -> b
$ Datum -> BuiltinData
Api.getDatum Datum
sDatum
      ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn ConwayEra
-> Witness WitCtxTxIn ConwayEra
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
Cardano.ScriptWitness ScriptWitnessInCtx WitCtxTxIn
Cardano.ScriptWitnessForSpending (ScriptWitness WitCtxTxIn ConwayEra
 -> Witness WitCtxTxIn ConwayEra)
-> ReaderT
     InputContext
     (Either GenerateTxError)
     (ScriptWitness WitCtxTxIn ConwayEra)
-> ReaderT
     InputContext
     (Either GenerateTxError)
     (Witness WitCtxTxIn ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxGen (Map TxOutRef TxOut) (ScriptWitness WitCtxTxIn ConwayEra)
-> ReaderT
     InputContext
     (Either GenerateTxError)
     (ScriptWitness WitCtxTxIn ConwayEra)
forall context' context a.
Transform context' context =>
TxGen context a -> TxGen context' a
liftTxGen (Versioned Validator
-> TxSkelRedeemer
-> ScriptDatum WitCtxTxIn
-> TxGen (Map TxOutRef TxOut) (ScriptWitness WitCtxTxIn ConwayEra)
forall a b.
ToVersionedScript a =>
a
-> TxSkelRedeemer
-> ScriptDatum b
-> WitnessGen (ScriptWitness b ConwayEra)
toScriptWitness Versioned Validator
validator TxSkelRedeemer
txSkelRedeemer ScriptDatum WitCtxTxIn
scriptDatum)
  String
-> (TxIn
    -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra)))
-> Either ToCardanoError TxIn
-> InputGen
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
forall a b context.
String -> (a -> b) -> Either ToCardanoError a -> TxGen context b
throwOnToCardanoErrorOrApply
    String
"toTxInAndWitness: Unable to translate TxOutRef"
    (,Witness WitCtxTxIn ConwayEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra)
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith Witness WitCtxTxIn ConwayEra
witness)
    (Either ToCardanoError TxIn
 -> InputGen
      (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra)))
-> Either ToCardanoError TxIn
-> InputGen
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
forall a b. (a -> b) -> a -> b
$ TxOutRef -> Either ToCardanoError TxIn
Ledger.toCardanoTxIn TxOutRef
txOutRef