Fix #81: Add Chang HF SOP User Story coverage

.github/workflows/auto-format.yml

@@ -0,0 +1,33 @@
+name: Auto-Format Haskell files
+
+on:
+  push:
+    branches:
+      - '*'
+
+permissions:
+  contents: write
+
+jobs:
+  format:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+        with:
+          ref: ${{ github.ref }}
+
+      - name: Install Nix
+        uses: cachix/install-nix-action@v27
+        with:
+          nix_path: nixpkgs=channel:nixos-unstable
+
+      - name: Run pre-commit formatter
+        run: |
+          nix develop --extra-experimental-features "nix-command flakes" -c pre-commit run --all-files || true
+
+      - name: Commit changes
+        run: |
+          git config --local user.email "github-actions[bot]@users.noreply.github.com"
+          git config --local user.name "github-actions[bot]"
+          git add -A
+          git diff-index --quiet HEAD || (git commit -m "Auto-format Haskell files" && git push)

CODEOWNERS.md

@@ -4,5 +4,5 @@
 * @
 
 # General reviewers per PR
-#                        Name   Name          
-*                        @      @  
+#                        Name   Name
+*                        @      @

e2e-tests/e2e-tests.cabal

@@ -156,6 +156,8 @@ test-suite antaeus-test
     PlutusScripts.SECP256k1.Common
     PlutusScripts.SECP256k1.V_1_0
     PlutusScripts.SECP256k1.V_1_1
+    PlutusScripts.SOP.Common
+    PlutusScripts.SOP.V_1_1
     PlutusScripts.V1TxInfo
     PlutusScripts.V2TxInfo
     PlutusScripts.V3TxInfo
@@ -166,6 +168,7 @@ test-suite antaeus-test
     Spec.Builtins.BLS
     Spec.Builtins.Hashing
     Spec.Builtins.SECP256k1
+    Spec.Builtins.SOP
     Spec.ConwayFeatures
     Spec.WriteScriptFiles
 

e2e-tests/test/Helpers/Query.hs

@@ -23,6 +23,7 @@ import Data.List (isInfixOf, sortBy)
 import Data.Map qualified as Map
 import Data.Maybe (fromJust)
 import Data.Set qualified as Set
+import GHC.Exts (toList)
 import Hedgehog (MonadTest)
 import Hedgehog.Extras.Test qualified as HE
 import Hedgehog.Extras.Test.Base qualified as H
@@ -66,16 +67,16 @@ adaOnlyTxInAtAddress era localNodeConnectInfo address = do
     adaOnly =
       filter
         ( \(_, C.TxOut _ (C.TxOutValueShelleyBased sbe v) _ _) ->
-            ((length $ C.valueToList (C.fromLedgerValue sbe v)) == 1)
-              && ((fst $ head $ C.valueToList (C.fromLedgerValue sbe v)) == C.AdaAssetId)
+            ((length $ toList (C.fromLedgerValue sbe v)) == 1)
+              && ((fst $ head $ toList (C.fromLedgerValue sbe v)) == C.AdaAssetId)
         )
     sortByMostAda =
       sortBy
         ( \(_, C.TxOut _ (C.TxOutValueShelleyBased sbe v1) _ _)
            (_, C.TxOut _ (C.TxOutValueShelleyBased _ v2) _ _) ->
               compare
-                (snd $ head $ C.valueToList (C.fromLedgerValue sbe v2))
-                (snd $ head $ C.valueToList (C.fromLedgerValue sbe v1))
+                (snd $ head $ toList (C.fromLedgerValue sbe v2))
+                (snd $ head $ toList (C.fromLedgerValue sbe v1))
         )
 
 -- | Get TxIns from all UTxOs
@@ -154,7 +155,7 @@ waitForTxInAtAddress
   -> String -- temp debug text for intermittent timeout failure
   -> m ()
 waitForTxInAtAddress era localNodeConnectInfo address txIn debugStr = do
-  let timeoutSeconds = 90 :: Int
+  let timeoutSeconds = 180 :: Int
       loop i prevUtxo = do
         if i == 0
           then
@@ -221,7 +222,7 @@ txOutHasValue
   -> m Bool
 txOutHasValue (C.TxOut _ txOutValue _ _) tokenValue = do
   let value = C.txOutValueToValue txOutValue
-  return $ isInfixOf (C.valueToList tokenValue) (C.valueToList value)
+  return $ isInfixOf (toList tokenValue) (toList value)
 
 -- | Query network's protocol parameters
 getProtocolParams

e2e-tests/test/Helpers/Tx.hs

@@ -428,7 +428,7 @@ buildRawTx
   => C.ShelleyBasedEra era
   -> C.TxBodyContent C.BuildTx era
   -> m (C.TxBody era)
-buildRawTx sbe = HE.leftFail . C.createAndValidateTransactionBody sbe -- TODO: handle error
+buildRawTx sbe = HE.leftFail . C.createTransactionBody sbe -- TODO: handle error
 
 -- | Witness txbody with signing key when not using convenience build function
 signTx

e2e-tests/test/Helpers/TypeConverters.hs

@@ -10,6 +10,7 @@ import Cardano.Chain.Common (addrToBase58)
 import Cardano.Ledger.Conway.Governance qualified as L
 import Cardano.Ledger.Crypto qualified as L
 import Cardano.Ledger.Shelley.API qualified as L
+import GHC.Exts (toList)
 import PlutusLedgerApi.V1 qualified as PV1
 import PlutusLedgerApi.V1.Address (Address (Address))
 import PlutusLedgerApi.V1.Credential (
@@ -195,7 +196,7 @@ fromCardanoAssetId (C.AssetId policyId assetName) =
   Value.assetClass (fromCardanoPolicyId policyId) (fromCardanoAssetName assetName)
 
 fromCardanoValue :: C.Value -> Value.Value
-fromCardanoValue (C.valueToList -> list) =
+fromCardanoValue (toList -> list) =
   foldMap fromSingleton list
   where
     fromSingleton (fromCardanoAssetId -> assetClass, C.Quantity quantity) =

e2e-tests/test/PlutusScripts/SOP/Common.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# OPTIONS_GHC -Wno-missing-fields #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
+
+module PlutusScripts.SOP.Common where
+
+import Cardano.Api qualified as C
+import PlutusScripts.Helpers (
+  toScriptData,
+ )
+import PlutusTx qualified
+import PlutusTx.Prelude qualified as P
+
+data SOPRedeemer
+  = Sum1 Integer
+  | Sum2 Integer Integer
+  | Sum3 Integer Integer Integer
+
+$(PlutusTx.unstableMakeIsData ''SOPRedeemer)
+$(PlutusTx.makeLift ''SOPRedeemer)
+
+{-# INLINEABLE mkSopPolicyV3 #-}
+mkSopPolicyV3 :: SOPRedeemer -> P.BuiltinUnit
+mkSopPolicyV3 redeemer =
+  case redeemer of
+    Sum1 a ->
+      P.check (a P.== 1)
+    Sum2 a b ->
+      P.check (a P.== 1 P.&& b P.== 2)
+    Sum3 a b c ->
+      P.check (a P.== 1 P.&& b P.== 2 P.&& c P.== 3)
+
+sopAssetName :: C.AssetName
+sopAssetName = C.AssetName "sop"
+
+sopRedeemer1 :: C.HashableScriptData
+sopRedeemer1 = toScriptData (Sum1 1)
+
+sopRedeemer2 :: C.HashableScriptData
+sopRedeemer2 = toScriptData (Sum2 1 2)
+
+sopRedeemer3 :: C.HashableScriptData
+sopRedeemer3 = toScriptData (Sum3 1 2 3)
+
+sopRedeemerFail :: C.HashableScriptData
+sopRedeemerFail = toScriptData (Sum3 1 2 4)

e2e-tests/test/PlutusScripts/SOP/V_1_1.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
+{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.1.0 #-}
+
+module PlutusScripts.SOP.V_1_1 where
+
+import Cardano.Api qualified as C
+import Cardano.Api.Shelley qualified as C
+import PlutusLedgerApi.Common (SerialisedScript, serialiseCompiledCode)
+import PlutusScripts.Helpers (
+  mintScriptWitness,
+  plutusL3,
+  policyIdV3,
+ )
+import PlutusScripts.SOP.Common (mkSopPolicyV3, sopAssetName)
+import PlutusTx qualified
+
+checkSopPolicy :: SerialisedScript
+checkSopPolicy =
+  serialiseCompiledCode $
+    $$(PlutusTx.compile [||mkSopPolicyV3||])
+
+checkSopPolicyScriptV3 :: C.PlutusScript C.PlutusScriptV3
+checkSopPolicyScriptV3 = C.PlutusScriptSerialised checkSopPolicy
+
+checkSopAssetIdV3 :: C.AssetId
+checkSopAssetIdV3 = C.AssetId (policyIdV3 checkSopPolicy) sopAssetName
+
+checkSopMintWitnessV3
+  :: C.ShelleyBasedEra era
+  -> C.HashableScriptData
+  -> (C.PolicyId, C.ScriptWitness C.WitCtxMint era)
+checkSopMintWitnessV3 sbe redeemer =
+  ( policyIdV3 checkSopPolicy
+  , mintScriptWitness sbe plutusL3 (Left checkSopPolicyScriptV3) redeemer
+  )

e2e-tests/test/Spec.hs

@@ -39,6 +39,7 @@ import Spec.AlonzoFeatures qualified as Alonzo
 import Spec.BabbageFeatures qualified as Babbage
 import Spec.Builtins qualified as Builtins
 import Spec.Builtins.Bitwise qualified as Conway
+import Spec.Builtins.SOP qualified as SOP
 import Spec.ConwayFeatures qualified as Conway
 import Spec.WriteScriptFiles (writeV3ScriptFiles)
 import System.Directory (createDirectoryIfMissing)
@@ -315,6 +316,7 @@ pv9Tests resultsRef = integrationRetryWorkspace 0 "pv9" $ \tempAbsPath -> do
 
       run Conway.integerToByteStringBitwiseSizeArgumentGreaterThan8192ErrorTestInfo -- Failing for unknown reason
     , run Conway.verifyBitwiseFunctionsTestInfo
+    , run SOP.verifySopTestInfo
     ]
 
   failureMessages <- liftIO $ suiteFailureMessages resultsRef

e2e-tests/test/Spec/AlonzoFeatures.hs

@@ -155,7 +155,7 @@ checkTxInfoV1Test networkOptions params = do
           , C.txOuts = [txOut1, txOut2]
           , C.txFee = Tx.txFee era fee
           , C.txValidityLowerBound = Tx.txValidityLowerBound era 1
-          , C.txValidityUpperBound = Tx.txValidityUpperBound era 2700
+          , C.txValidityUpperBound = Tx.txValidityUpperBound era 5400
           , -- \^ ~9min range (200ms slots)
             -- \^ Babbage era onwards cannot have upper slot beyond epoch boundary (10_000 slot epoch)
             C.txExtraKeyWits = Tx.txExtraKeyWits era [w1VKey]

e2e-tests/test/Spec/BabbageFeatures.hs

@@ -165,7 +165,7 @@ checkTxInfoV2Test networkOptions testParams = do
           , C.txOuts = [txOut1, txOut2]
           , C.txFee = Tx.txFee era fee
           , C.txValidityLowerBound = Tx.txValidityLowerBound era 1
-          , C.txValidityUpperBound = Tx.txValidityUpperBound era 2700
+          , C.txValidityUpperBound = Tx.txValidityUpperBound era 5400
           , -- \^ ~9min range (200ms slots)
             -- \^ Babbage era onwards cannot have upper slot beyond epoch boundary (10_000 slot epoch)
             C.txExtraKeyWits = Tx.txExtraKeyWits era [wVKey]

e2e-tests/test/Spec/Builtins/SOP.hs

@@ -0,0 +1,75 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-missing-import-lists #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+-- Not using all CardanoEra
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
+
+module Spec.Builtins.SOP where
+
+import Cardano.Api qualified as C
+import Control.Monad.IO.Class (MonadIO)
+import Data.Map qualified as Map
+import GHC.IsList (fromList)
+import Hedgehog (MonadTest)
+import Helpers.Common (toShelleyBasedEra)
+import Helpers.Query qualified as Q
+import Helpers.Test (assert)
+import Helpers.TestData (TestInfo (..), TestParams (..))
+import Helpers.Testnet qualified as TN
+import Helpers.Tx qualified as Tx
+import PlutusScripts.SOP.Common qualified as SOP
+import PlutusScripts.SOP.V_1_1 qualified as SOP_1_1
+
+verifySopTestInfo =
+  TestInfo
+    { testName = "verifySopTest"
+    , testDescription =
+        "Sums-of-products optimization can be used in Plutus V3 scripts to mint."
+    , test = verifySopTest
+    }
+
+verifySopTest
+  :: (MonadIO m, MonadTest m)
+  => TN.TestEnvironmentOptions era
+  -> TestParams era
+  -> m (Maybe String)
+verifySopTest networkOptions TestParams{localNodeConnectInfo, pparams, networkId, tempAbsPath} = do
+  era <- TN.eraFromOptionsM networkOptions
+  (w1SKey, w1Address) <- TN.w1 tempAbsPath networkId
+  let sbe = toShelleyBasedEra era
+
+  -- Only Plutus V3 supports natively compiled SOPs. Therefore, run only in Conway+
+  case era of
+    C.ConwayEra -> do
+      txIn <- Q.adaOnlyTxInAtAddress era localNodeConnectInfo w1Address
+
+      let
+        tokenValues = fromList [(SOP_1_1.checkSopAssetIdV3, 5)]
+        mintWitnesses = Map.fromList [SOP_1_1.checkSopMintWitnessV3 sbe SOP.sopRedeemer3]
+        txOut = Tx.txOut era (C.lovelaceToValue 3_000_000 <> tokenValues) w1Address
+        collateral = Tx.txInsCollateral era [txIn]
+        txBodyContent =
+          (Tx.emptyTxBodyContent sbe pparams)
+            { C.txIns = Tx.pubkeyTxIns [txIn]
+            , C.txInsCollateral = collateral
+            , C.txMintValue = Tx.txMintValue era tokenValues mintWitnesses
+            , C.txOuts = [txOut]
+            }
+
+      -- Build and submit transaction
+      signedTx <- Tx.buildTx era localNodeConnectInfo txBodyContent w1Address w1SKey
+      Tx.submitTx sbe localNodeConnectInfo signedTx
+      let expectedTxIn = Tx.txIn (Tx.txId signedTx) 0
+
+      -- Query for txo and assert it contains newly minting tokens to prove successful use of SOP
+      resultTxOut <-
+        Q.getTxOutAtAddress era localNodeConnectInfo w1Address expectedTxIn "TN.getTxOutAtAddress"
+      txOutHasTokenValue <- Q.txOutHasValue resultTxOut tokenValues
+      assert "txOut has SOP tokens" txOutHasTokenValue
+    _ ->
+      assert "SOP feature is only applicable starting from Conway era" True

e2e-tests/test/Spec/ConwayFeatures.hs

@@ -167,7 +167,7 @@ checkTxInfoV3Test networkOptions TestParams{..} = do
           , C.txOuts = [txOut1, txOut2]
           , C.txFee = Tx.txFee era fee
           , C.txValidityLowerBound = Tx.txValidityLowerBound era 1
-          , C.txValidityUpperBound = Tx.txValidityUpperBound era 2700
+          , C.txValidityUpperBound = Tx.txValidityUpperBound era 5400
           , -- \^ ~9min range (200ms slots)
             -- \^ Babbage era onwards cannot have upper slot beyond epoch boundary (10_000 slot epoch)
             C.txExtraKeyWits = Tx.txExtraKeyWits era [w1VKey]

issue.txt

@@ -0,0 +1,40 @@
+
+Chang HF User Stories Coverage
+==============================
+
+Last updated **2024-01-30** for **cardano-node 8.7.2**
+ 
+
+**Legend:** ![Success Badge][success-badge] ![Failure Badge][failure-badge] ![Uncovered Badge][uncovered-badge]
+ 
+
+
+Smart Contract User Stories
+----------------
+
+| Status for Story ID | Title | Story Overview |
+|---------------------|-------|----------------|
+|[![Status Badge][CIP-85-badge]][CIP-85-link] <sub>PlutusV3 is not supported in this build so cannot use plutus-tx compiler v1.1.0</sub>| Sums-of-products in Plutus v3 [→][CIP-85-req] | As a DApp developer I want to use sums-of-products instead of Scott-encoding in my Plutus scripts to get better performance.|
+|[![Status Badge][CIP-101-badge]][CIP-101-link] <sub>Plutus version in use doesn't include this builtin| Keccak256 in Plutus v3</sub> [→][CIP-101-req] | As a DApp developer I want to use the Keccak hashing function to validate ECDSA signatures formatted via the EVM standard. |
+|[![Status Badge][PLT-001-badge]][PLT-001-link]<sub> Plutus version in use doesn't include this builtin</sub>| Blake2b-224 in Plutus v3 [→][PLT-001-req] | As a DApp developer I want to use the Blake2b-224 hashing function to compute PubKeyHash onchain. |
+|[![Status Badge][CIP-87-badge]][CIP-87-link] <sub> Plutus version in use doesn't include this builtin</sub>| Use bitwise operations in Plutus V3 [→][CIP-87-req] | As a DApp developer I want to use bitwise operations So that I can work with data bytestrings in a more granular and optimized way and perform operations at the bit level. |
+
+
+[success-badge]: https://img.shields.io/badge/success-green
+[failure-badge]: https://img.shields.io/badge/failure-red
+[uncovered-badge]: https://img.shields.io/badge/uncovered-grey
+
+[CIP-85-badge]: https://img.shields.io/badge/CIP-85-grey
+[CIP-101-badge]: https://img.shields.io/badge/CIP-101-grey
+[PLT-001-badge]: https://img.shields.io/badge/PLT-001-grey
+[CIP-87-badge]: https://img.shields.io/badge/CIP-87-grey
+
+[CIP-85-link]: https://github.com/input-output-hk/antaeus/blob/cardano-node_8-7-2/e2e-tests/test/Spec.hs#L180-L203
+[CIP-101-link]: https://github.com/input-output-hk/antaeus/pull/43
+[PLT-001-link]: https://github.com/input-output-hk/antaeus/pull/43
+[CIP-87-link]: https://github.com/input-output-hk/antaeus/pull/79
+
+[CIP-85-req]: https://github.com/IntersectMBO/cardano-test-plans/blob/main/docs/user-stories/04-smart-contracts.md#user-story-id-cip-85
+[CIP-101-req]: https://github.com/IntersectMBO/cardano-test-plans/blob/main/docs/user-stories/04-smart-contracts.md#user-story-id-cip-101
+[PLT-001-req]: https://github.com/IntersectMBO/cardano-test-plans/blob/main/docs/user-stories/04-smart-contracts.md#user-story-id-plt001
+[CIP-87-req]: https://github.com/IntersectMBO/cardano-test-plans/blob/main/docs/user-stories/04-smart-contracts.md#user-story-id-cip-87