Fix script validity

lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs

@@ -361,7 +361,6 @@ import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
 import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
 import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo
 import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo
-import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo
 import qualified Cardano.Ledger.Babbage as Babbage
 import qualified Cardano.Ledger.Babbage.PParams as Babbage
 import qualified Cardano.Ledger.Babbage.Tx as Babbage hiding
@@ -686,7 +685,7 @@ fromAlonzoBlock
 fromAlonzoBlock gp blk@(ShelleyBlock (SL.Block _ txSeq) _) =
     let
         Alonzo.TxSeq txs' = txSeq
-        (txs, certs, _, _, _) = unzip5 $ map fromAlonzoValidatedTx $ toList txs'
+        (txs, certs, _, _, _) = unzip5 $ map fromAlonzoTx $ toList txs'
         certs' = mconcat certs
     in
         ( W.Block
@@ -706,7 +705,7 @@ fromBabbageBlock
 fromBabbageBlock gp blk@(ShelleyBlock (SL.Block _ txSeq) _) =
     let
         Alonzo.TxSeq txs' = txSeq
-        (txs, certs, _, _, _) = unzip5 $ map fromBabbageValidatedTx $ toList txs'
+        (txs, certs, _, _, _) = unzip5 $ map fromBabbageTx $ toList txs'
         certs' = mconcat certs
     in
         ( W.Block
@@ -1411,17 +1410,15 @@ getScriptIntegrityHash = \case
           (Babbage.ValidatedTx body _wits _isValid _auxData)
               = strictMaybeToMaybe . Babbage.scriptIntegrityHash $ body
 
-fromAlonzoTxBodyAndAux
-    :: Alonzo.TxBody (Cardano.ShelleyLedgerEra AlonzoEra)
-    -> SLAPI.StrictMaybe (Alonzo.AuxiliaryData (Cardano.ShelleyLedgerEra AlonzoEra))
-    -> Alonzo.TxWitness StandardAlonzo
+fromAlonzoTx
+    :: Alonzo.ValidatedTx (Cardano.ShelleyLedgerEra AlonzoEra)
     -> ( W.Tx
        , [W.Certificate]
        , TokenMapWithScripts
        , TokenMapWithScripts
        , Maybe ValidityIntervalExplicit
        )
-fromAlonzoTxBodyAndAux bod mad wits =
+fromAlonzoTx (Alonzo.ValidatedTx bod wits (Alonzo.IsValid isValid) aux) =
     ( W.Tx
         { txId =
             fromShelleyTxId $ TxIn.txid @(Cardano.ShelleyLedgerEra AlonzoEra) bod
@@ -1439,9 +1436,9 @@ fromAlonzoTxBodyAndAux bod mad wits =
         , withdrawals =
             fromShelleyWdrl wdrls
         , metadata =
-            fromShelleyMD . toSLMetadata <$> SL.strictMaybeToMaybe mad
+            fromShelleyMD . toSLMetadata <$> SL.strictMaybeToMaybe aux
         , scriptValidity =
-            Nothing
+            validity
         }
     , map fromShelleyCert (toList certs)
     , TokenMapWithScripts assetsToMint mintScriptMap
@@ -1495,33 +1492,10 @@ fromAlonzoTxBodyAndAux bod mad wits =
 
     toSLMetadata (Alonzo.AuxiliaryData blob _scripts) = SL.Metadata blob
 
-fromAlonzoValidatedTx
-    :: Alonzo.ValidatedTx (Cardano.ShelleyLedgerEra AlonzoEra)
-    -> ( W.Tx
-       , [W.Certificate]
-       , TokenMapWithScripts
-       , TokenMapWithScripts
-       , Maybe ValidityIntervalExplicit
-       )
-fromAlonzoValidatedTx (Alonzo.ValidatedTx bod wits _isValidating aux) =
-    fromAlonzoTxBodyAndAux bod aux wits
-
-fromAlonzoTx
-    :: Alonzo.ValidatedTx (Cardano.ShelleyLedgerEra AlonzoEra)
-    -> ( W.Tx
-       , [W.Certificate]
-       , TokenMapWithScripts
-       , TokenMapWithScripts
-       , Maybe ValidityIntervalExplicit
-       )
-fromAlonzoTx (Alonzo.ValidatedTx bod wits (Alonzo.IsValid isValid) aux) =
-    (\(tx, c, m, b, i) -> (tx { W.scriptValidity = validity }, c, m, b, i))
-    $ fromAlonzoTxBodyAndAux bod aux wits
-    where
-        validity =
-            if isValid
-            then Just W.TxScriptValid
-            else Just W.TxScriptInvalid
+    validity =
+        if isValid
+        then Just W.TxScriptValid
+        else Just W.TxScriptInvalid
 
 fromBabbageTx
     :: Alonzo.ValidatedTx (Cardano.ShelleyLedgerEra BabbageEra)
@@ -1532,37 +1506,6 @@ fromBabbageTx
        , Maybe ValidityIntervalExplicit
        )
 fromBabbageTx (Alonzo.ValidatedTx bod wits (Alonzo.IsValid isValid) aux) =
-    (\(tx, c, m, b, i) -> (tx { W.scriptValidity = validity }, c, m, b, i))
-    $ fromBabbageTxBodyAndAux bod aux wits
-    where
-        validity =
-            if isValid
-            then Just W.TxScriptValid
-            else Just W.TxScriptInvalid
-
-fromBabbageValidatedTx
-    :: Alonzo.ValidatedTx (Cardano.ShelleyLedgerEra BabbageEra)
-    -> ( W.Tx
-       , [W.Certificate]
-       , TokenMapWithScripts
-       , TokenMapWithScripts
-       , Maybe ValidityIntervalExplicit
-       )
-fromBabbageValidatedTx (Alonzo.ValidatedTx bod wits _isValidating aux) =
-    fromBabbageTxBodyAndAux bod aux wits
-
-fromBabbageTxBodyAndAux
-    :: Babbage.TxBody (Cardano.ShelleyLedgerEra BabbageEra)
-    -> SLAPI.StrictMaybe
-        (Babbage.AuxiliaryData (Cardano.ShelleyLedgerEra BabbageEra))
-    -> Alonzo.TxWitness StandardBabbage
-    -> ( W.Tx
-       , [W.Certificate]
-       , TokenMapWithScripts
-       , TokenMapWithScripts
-       , Maybe ValidityIntervalExplicit
-       )
-fromBabbageTxBodyAndAux bod mad wits =
     ( W.Tx
         { txId =
             fromShelleyTxId $
@@ -1582,9 +1525,9 @@ fromBabbageTxBodyAndAux bod mad wits =
         , withdrawals =
             fromShelleyWdrl wdrls
         , metadata =
-            fromShelleyMD . toSLMetadata <$> SL.strictMaybeToMaybe mad
+            fromShelleyMD . toSLMetadata <$> SL.strictMaybeToMaybe aux
         , scriptValidity =
-            Nothing
+            validity
         }
     , map fromShelleyCert (toList certs)
     , TokenMapWithScripts assetsToMint mintScriptMap
@@ -1641,6 +1584,10 @@ fromBabbageTxBodyAndAux bod mad wits =
 
     toSLMetadata (Alonzo.AuxiliaryData blob _scripts) = SL.Metadata blob
 
+    validity =
+        if isValid
+        then Just W.TxScriptValid
+        else Just W.TxScriptInvalid
 
 -- Lovelace to coin. Quantities from ledger should always fit in Word64.
 fromCardanoLovelace :: HasCallStack => Cardano.Lovelace -> W.Coin

test/e2e/fixtures/plutus/alwaysfails.plutus

@@ -0,0 +1,5 @@
+{
+    "type": "PlutusScriptV2",
+    "description": "",
+    "cborHex": "4746010000222601"
+}

test/e2e/helpers/cardano_cli.rb

@@ -0,0 +1,124 @@
+##
+# cardano-cli cmd helper wrapper
+#
+class CardanoCli
+
+  attr_reader :node_state, :socket_path
+
+  def initialize
+    @node_state = File.join(absolute_path(ENV['TESTS_NODE_DB']), CONTEXT.env)
+
+    if is_win?
+      @socket_path = '\\\\.\\pipe\\cardano-node-testnet'
+    else
+      @socket_path = File.join(@node_state, 'node.socket')
+    end
+
+    ENV['CARDANO_NODE_SOCKET_PATH'] = @socket_path
+  end
+
+  def build_script_address(script_file_path)
+    cmd(%(cardano-cli address build \
+          --payment-script-file #{script_file_path} \
+          --testnet-magic #{get_protocol_magic})).gsub("\n", '')
+  end
+
+  def generate_payment_keys
+    keys = {
+              vkey: File.join(@node_state, 'payment.vkey'),
+              skey: File.join(@node_state, 'payment.skey')
+           }
+    cmd(%(cardano-cli address key-gen \
+           --verification-key-file #{keys[:vkey]} \
+           --signing-key-file #{keys[:skey]}))
+    keys
+  end
+
+  def build_payment_address(keys)
+    cmd(%(cardano-cli address build \
+           --payment-verification-key-file #{keys[:vkey]} \
+           --testnet-magic #{get_protocol_magic})).gsub("\n", '')
+  end
+
+  ##
+  # Returns simplified utxo array for an address.
+  # Parse cardano-cli query utxo output, like:
+  #   TxHash                                 TxIx        Amount
+  # --------------------------------------------------------------------------------------
+  # 4f10e314ca4f71031ae2f801638d1671571bc0fa811bd59520b34d3e68ae5344     0        10000000 lovelace + TxOutDatumNone
+  # f8e12cf50ebf8b0a3d87869f8ca31ed1a95acc77dcc6007997ea97cb9f5a24cd     0        10000000 lovelace + TxOutDatumNone
+  #
+  # into: 
+  # @return [Array] - [{utxo: utxoId, ix: index, amt: ada amount}, ...]
+  def get_utxos(address)
+    output = cmd(%(cardano-cli query utxo \
+                    --address #{address} \
+                    --testnet-magic #{get_protocol_magic}))
+    # [utxo1, utxo2, ... utxoN]
+    #     where utxoN = {utxo: utxoId, ix: index, amt: ada amount}
+    output.partition("-" * 86).last.strip.split("\n").map do |utxo|
+      utxo_arr = utxo.split(" ")
+      {utxo: utxo_arr[0], ix: utxo_arr[1], amt: utxo_arr[2]}
+    end
+  end
+
+  def get_protocol_params
+    pparams = File.join(@node_state, 'pparams.json')
+    unless File.exists?(pparams)
+      cmd(%(cardano-cli query protocol-parameters \
+            --testnet-magic #{get_protocol_magic} \
+            --out-file #{pparams}))
+    end
+    pparams
+  end
+
+  ##
+  # Build (using trasaction build-raw) an invalid transaction that is
+  # spending from script address and always fails. Using collateral return option.
+  def tx_build_raw_always_fails(script_file,
+                                script_utxo,
+                                collateral_utxo,
+                                collateral_utxo_amt,
+                                fee,
+                                target_addr,
+                                collateral_ret_addr)
+    txbody = File.join(@node_state, 'txbody')
+    cmd(%(cardano-cli transaction build-raw \
+          --tx-in #{script_utxo} \
+          --tx-out "#{target_addr}+#{50000000 - fee}" \
+          --tx-in-script-file #{script_file} \
+          --tx-in-datum-value 1914 \
+          --tx-in-redeemer-value 123 \
+          --tx-in-collateral #{collateral_utxo} \
+          --tx-in-execution-units "(10, 10)" \
+          --protocol-params-file #{get_protocol_params} \
+          --fee #{fee} \
+          --tx-out-return-collateral "#{collateral_ret_addr}+#{collateral_utxo_amt - (fee * 1.5).to_i}" \
+          --tx-total-collateral #{(fee * 1.5).to_i} \
+          --script-invalid \
+          --babbage-era \
+          --out-file #{txbody}))
+    txbody
+  end
+
+  def tx_sign(txbody, keys)
+    txsigned = File.join(@node_state, 'txsigned')
+    cmd(%(cardano-cli transaction sign \
+           --tx-body-file #{txbody} \
+           --testnet-magic #{get_protocol_magic} \
+           --signing-key-file #{keys[:skey]} \
+           --out-file #{txsigned}))
+    txsigned
+  end
+
+  def tx_submit(txsigned)
+    # submit
+    cmd(%(cardano-cli transaction submit \
+          --tx-file #{txsigned} \
+          --testnet-magic #{get_protocol_magic} ))
+
+    # return tx id
+    cmd(%(cardano-cli transaction txid --tx-file #{txsigned})).gsub("\n", '')
+  end
+
+end