wip

cardano-node-emulator/src/Cardano/Node/Emulator/Validation.hs

@@ -16,7 +16,6 @@ module Cardano.Node.Emulator.Validation(
   EmulatorEra,
   CardanoLedgerError,
   initialState,
-  getRequiredSigners,
   hasValidationErrors,
   makeTransactionBody,
   validateCardanoTx,
@@ -26,13 +25,6 @@ module Cardano.Node.Emulator.Validation(
   nextSlot,
   UTxO(..),
   setUtxo,
-  -- * Conversion from Plutus types
-  fromPlutusTx,
-  fromPlutusTxSigned,
-  fromPlutusTxSigned',
-  fromPlutusIndex,
-  fromPlutusTxOut,
-  fromPlutusTxOutRef,
   -- * Lenses
   ledgerEnv,
   memPoolState,
@@ -304,58 +296,3 @@ makeTransactionBody params utxo txBodyContent = do
   txTmp <- bimap Right (makeSignedTransaction []) $ P.makeTransactionBody (Just $ emulatorPParams params) mempty txBodyContent
   exUnits <- bimap Left (Map.map snd) $ getTxExUnitsWithLogs params utxo txTmp
   first Right $ P.makeTransactionBody (Just $ emulatorPParams params) exUnits txBodyContent
-
-fromPlutusTxSigned'
-  :: Params
-  -> UTxO EmulatorEra
-  -> P.Tx
-  -> Map.Map P.PaymentPubKey P.PaymentPrivateKey
-  -> Either CardanoLedgerError CardanoTx
-fromPlutusTxSigned' params utxo tx knownPaymentKeys =
-  let
-    getPrivateKey = fmap P.unPaymentPrivateKey . flip Map.lookup knownPaymentKeys . P.PaymentPubKey
-    getPublicKeys = Map.keys . P.txSignatures
-    privateKeys = mapMaybe getPrivateKey $ getPublicKeys tx
-    signTx txn = foldl' (flip addCardanoTxSignature) txn privateKeys
-    convertTx t =
-        flip SomeTx C.BabbageEraInCardanoMode
-        <$> fromPlutusTx params utxo (P.PaymentPubKeyHash . Crypto.pubKeyHash <$> getPublicKeys t) t
-  in
-    signTx . CardanoApiTx <$> convertTx tx
-
-fromPlutusTxSigned
-  :: Params
-  -> UTxO EmulatorEra
-  -> P.Tx
-  -> Map.Map P.PaymentPubKey P.PaymentPrivateKey
-  -> CardanoTx
-fromPlutusTxSigned params utxo tx knownPaymentKeys = case fromPlutusTxSigned' params utxo tx knownPaymentKeys of
-  Left e  -> error ("fromPlutusTxSigned: failed to convert " ++ show e)
-  Right t -> t
-
-fromPlutusTx
-  :: Params
-  -> UTxO EmulatorEra
-  -> [P.PaymentPubKeyHash]
-  -> P.Tx
-  -> Either CardanoLedgerError (C.Api.Tx C.Api.BabbageEra)
-fromPlutusTx params utxo requiredSigners tx = do
-  txBodyContent <- first Right $ P.toCardanoTxBodyContent (pNetworkId params) (emulatorPParams params) requiredSigners tx
-  makeSignedTransaction [] <$> makeTransactionBody params utxo txBodyContent
-
-getRequiredSigners :: C.Api.Tx C.Api.BabbageEra -> [P.PaymentPubKeyHash]
-getRequiredSigners (C.Api.ShelleyTx _ (ValidatedTx TxBody { reqSignerHashes = rsq } _ _ _)) =
-  foldMap (pure . P.PaymentPubKeyHash . P.fromCardanoPaymentKeyHash . C.Api.PaymentKeyHash . C.Ledger.coerceKeyRole) rsq
-
-fromPlutusIndex :: P.UtxoIndex -> Either CardanoLedgerError (UTxO EmulatorEra)
-fromPlutusIndex (P.UtxoIndex m) =
-  first Right $ UTxO . Map.fromList <$> traverse (bitraverse fromPlutusTxOutRef (pure . fromPlutusTxOut)) (Map.toList m)
-
-fromPlutusTxOutRef :: P.TxOutRef -> Either P.ToCardanoError (TxIn StandardCrypto)
-fromPlutusTxOutRef (P.TxOutRef txId i) = TxIn <$> fromPlutusTxId txId <*> pure (mkTxIxPartial i)
-
-fromPlutusTxId :: V1.TxId -> Either P.ToCardanoError (TxId StandardCrypto)
-fromPlutusTxId = fmap toShelleyTxId . P.toCardanoTxId
-
-fromPlutusTxOut :: P.TxOut -> TxOut EmulatorEra
-fromPlutusTxOut = C.Api.toShelleyTxOut ShelleyBasedEraBabbage . C.Api.toCtxUTxOTxOut . P.getTxOut

plutus-ledger/src/Ledger/Tx.hs

@@ -64,6 +64,8 @@ module Ledger.Tx
     , getCardanoTxValidityRange
     , getCardanoTxData
     , SomeCardanoApiTx(.., CardanoApiEmulatorEraTx)
+    , fromPlutusTxSigned
+    , fromPlutusTxSigned'
     , ToCardanoError(..)
     , addSignature
     , addSignature'
@@ -507,3 +509,31 @@ addSignature' :: PrivateKey -> Tx -> Tx
 addSignature' privK tx = tx & signatures . at pubK ?~ sig where
     sig = signTx' (txId tx) privK
     pubK = toPublicKey privK
+
+fromPlutusTxSigned
+  :: Params
+  -> UTxO EmulatorEra
+  -> P.Tx
+  -> Map.Map P.PaymentPubKey P.PaymentPrivateKey
+  -> CardanoTx
+fromPlutusTxSigned params utxo tx knownPaymentKeys = case fromPlutusTxSigned' params utxo tx knownPaymentKeys of
+  Left e  -> error ("fromPlutusTxSigned: failed to convert " ++ show e)
+  Right t -> t
+
+fromPlutusTxSigned'
+  :: Params
+  -> UTxO EmulatorEra
+  -> P.Tx
+  -> Map.Map P.PaymentPubKey P.PaymentPrivateKey
+  -> Either CardanoLedgerError CardanoTx
+fromPlutusTxSigned' params utxo tx knownPaymentKeys =
+  let
+    getPrivateKey = fmap P.unPaymentPrivateKey . flip Map.lookup knownPaymentKeys . P.PaymentPubKey
+    getPublicKeys = Map.keys . P.txSignatures
+    privateKeys = mapMaybe getPrivateKey $ getPublicKeys tx
+    signTx txn = foldl' (flip addCardanoTxSignature) txn privateKeys
+    convertTx t =
+        flip SomeTx C.BabbageEraInCardanoMode
+        <$> fromPlutusTx params utxo (P.PaymentPubKeyHash . Crypto.pubKeyHash <$> getPublicKeys t) t
+  in
+    signTx . CardanoApiTx <$> convertTx tx

plutus-ledger/src/Ledger/Tx/CardanoAPI.hs

@@ -29,19 +29,30 @@ module Ledger.Tx.CardanoAPI(
   , toCardanoMintValue
   , ToCardanoError(..)
   , FromCardanoError(..)
+  , getRequiredSigners
+  -- * Conversion from Plutus types
+  , fromPlutusTx
+  , fromPlutusIndex
+  , fromPlutusTxOut
+  , fromPlutusTxOutRef
 ) where
 
 import Cardano.Api qualified as C
 import Cardano.Api.Shelley qualified as C
+import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..))
 import Cardano.Ledger.Babbage qualified as Babbage
 import Cardano.Ledger.Babbage.PParams qualified as Babbage
+import Cardano.Ledger.Babbage.TxBody (TxBody (TxBody, reqSignerHashes))
 import Cardano.Ledger.Crypto (StandardCrypto)
+import Cardano.Ledger.Shelley.API qualified as C.Ledger
 import Data.Bitraversable (bisequence)
 import Data.Map qualified as Map
 import Ledger.Address qualified as P
+import Ledger.Crypto qualified as Crypto
 import Ledger.Scripts qualified as P
 import Ledger.Tx.CardanoAPI.Internal
 import Ledger.Tx.Internal qualified as P
+-- import Ledger.Index qualified as P
 import Plutus.V1.Ledger.Api qualified as PV1
 
 
@@ -223,3 +234,30 @@ toCardanoMintValue tx@P.Tx{..} =
              (traverse (\(mph, (rd, mTxOutRef)) ->
                 bisequence (toCardanoPolicyId mph, toCardanoMintWitness rd mTxOutRef (P.lookupMintingPolicy (P.txScripts tx) mph)))
                 indexedMps)
+
+getRequiredSigners :: C.Tx C.BabbageEra -> [P.PaymentPubKeyHash]
+getRequiredSigners (C.ShelleyTx _ (ValidatedTx TxBody { reqSignerHashes = rsq } _ _ _)) =
+  foldMap (pure . P.PaymentPubKeyHash . fromCardanoPaymentKeyHash . C.PaymentKeyHash . C.Ledger.coerceKeyRole) rsq
+
+fromPlutusTx
+  :: _Params
+  -> C.UTxO (Babbage.BabbageEra StandardCrypto)
+  -> [P.PaymentPubKeyHash]
+  -> P.Tx
+  -> Either (Either P.ValidationErrorInPhase ToCardanoError) (C.Tx C.BabbageEra)
+fromPlutusTx params utxo requiredSigners tx = do
+  txBodyContent <- first Right $ P.toCardanoTxBodyContent (pNetworkId params) (emulatorPParams params) requiredSigners tx
+  makeSignedTransaction [] <$> makeTransactionBody params utxo txBodyContent
+
+fromPlutusIndex :: P.UtxoIndex -> Either (Either P.ValidationErrorInPhase ToCardanoError) (C.UTxO (Babbage.BabbageEra StandardCrypto))
+fromPlutusIndex (P.UtxoIndex m) =
+  first Right $ UTxO . Map.fromList <$> traverse (bitraverse fromPlutusTxOutRef (pure . fromPlutusTxOut)) (Map.toList m)
+
+fromPlutusTxOutRef :: P.TxOutRef -> Either ToCardanoError (C.TxIn StandardCrypto)
+fromPlutusTxOutRef (P.TxOutRef txId i) = TxIn <$> fromPlutusTxId txId <*> pure (mkTxIxPartial i)
+
+fromPlutusTxId :: PV1.TxId -> Either ToCardanoError (C.TxId StandardCrypto)
+fromPlutusTxId = fmap toShelleyTxId . toCardanoTxId
+
+fromPlutusTxOut :: TxOut -> Babbage.TxOut (Babbage.BabbageEra StandardCrypto)
+fromPlutusTxOut = C.toShelleyTxOut ShelleyBasedEraBabbage . C.toCtxUTxOTxOut . P.getTxOut