cooked-node-backend

.gitignore

@@ -9,3 +9,4 @@ dist-newstyle
 *.swp
 docs/
 .pre-commit-config.yaml
+.github/copilot-instructions.md

CHANGELOG.md

@@ -4,8 +4,32 @@
 
 ### Added
 
+- New `UserScriptHash` constructor for `User`, representing an allocation-mode
+  script owner known only by its `Api.ScriptHash` (no script body). It can be
+  used to pay to a bare script hash through `receives` (a new
+  `IsTxSkelOutAllowedOwner Api.ScriptHash` instance). Spending an output owned by
+  such a user requires providing the full script through a matching reference
+  input; otherwise a new `MCESpendingHashOnlyScript` error is raised. The
+  `userVScriptL` optic is now restricted to `User IsScript Redemption`, since an
+  allocation-mode script owner may no longer carry a script body.
+- New `SomeTxSkelOutDatumHash` constructor for `TxSkelOutDatum`, representing an
+  output datum known only by its hash (no datum content). It is mirrored by a
+  new `UtxoPayloadDatumHash` constructor in the resulting `UtxoState`, and a new
+  `MCESpendingHashOnlyDatum` error is raised when attempting to build the
+  spending witness of a script output whose datum is only a hash.
+
 ### Changed
 
+- The former `MockChainState` has been split into two independent records, each
+  backed by its own state monad: `EmulatorState` (the emulator `Params` and
+  `EmulatedLedgerState`, only relevant when running against the emulated ledger)
+  and `ChainIndex` (the map of known outputs and the constitution script, which
+  is backend-agnostic and also meaningful for the node backend). Accordingly,
+  `mcstToUtxoState` is now `chainIndexToUtxoState`, the `mcst*L` optics are
+  replaced by `emulatorState*L`/`chainIndex*L`, `MockChainConf` now carries
+  `mccInitialEmulatorState` and `mccInitialChainIndex`, and
+  `RunnableMockChain.runMockChain` takes an `EmulatorState` and a `ChainIndex`.
+
 ### Removed
 
 ### Fixed

cooked-validators.cabal

@@ -24,6 +24,7 @@ library
       Cooked.Families
       Cooked.Ltl
       Cooked.MockChain
+      Cooked.MockChain.Automation
       Cooked.MockChain.Automation.AutoFilling.Constitution
       Cooked.MockChain.Automation.AutoFilling.MinAda
       Cooked.MockChain.Automation.AutoFilling.ReferenceScripts
@@ -44,7 +45,9 @@ library
       Cooked.MockChain.Common
       Cooked.MockChain.Effect.Log
       Cooked.MockChain.Effect.Misc
-      Cooked.MockChain.Effect.Read
+      Cooked.MockChain.Effect.Read.Chain
+      Cooked.MockChain.Effect.Read.Conf
+      Cooked.MockChain.Effect.Validation
       Cooked.MockChain.Effect.Write
       Cooked.MockChain.Run.Instances
       Cooked.MockChain.Run.Runnable
@@ -127,15 +130,18 @@ library
     , bytestring
     , cardano-api
     , cardano-crypto
+    , cardano-ledger-alonzo
     , cardano-ledger-conway
     , cardano-ledger-core
     , cardano-ledger-shelley
     , cardano-node-emulator
+    , cardano-slotting
     , cardano-strict-containers
     , containers
     , data-default
     , either
     , exceptions
+    , extra
     , http-conduit
     , lens
     , microlens
@@ -154,6 +160,8 @@ library
     , tasty-hunit
     , tasty-quickcheck
     , text
+    , time
+    , witherable
   default-language: Haskell2010
 
 test-suite spec

package.yaml

@@ -12,15 +12,18 @@ library:
     - bytestring
     - cardano-api
     - cardano-crypto
+    - cardano-ledger-alonzo
     - cardano-ledger-core
     - cardano-ledger-shelley
     - cardano-ledger-conway
     - cardano-node-emulator
+    - cardano-slotting
     - cardano-strict-containers
     - containers
     - data-default
     - either
     - exceptions
+    - extra
     - http-conduit
     - lens
     - microlens
@@ -39,6 +42,8 @@ library:
     - tasty-hunit
     - tasty-quickcheck
     - text
+    - time
+    - witherable
   ghc-options:
     -Wall
     -Wcompat

src/Cooked/Families.hs

@@ -23,6 +23,7 @@ module Cooked.Families
     HList (..),
     hHead,
     hTail,
+    hSingleton,
   )
 where
 
@@ -89,6 +90,10 @@ hHead (HCons a _) = a
 hTail :: HList (a ': l) -> HList l
 hTail (HCons _ l) = l
 
+-- | A singleton wrapped in an 'HList'
+hSingleton :: a -> HList '[a]
+hSingleton = (`HCons` HEmpty)
+
 instance Eq (HList '[]) where
   _ == _ = True
 

src/Cooked/MockChain.hs

@@ -2,10 +2,12 @@
 -- elements related to logs and inner state.
 module Cooked.MockChain (module X) where
 
-import Cooked.MockChain.Automation.Balancing as X
+import Cooked.MockChain.Automation as X
 import Cooked.MockChain.Common as X
 import Cooked.MockChain.Effect.Misc as X
-import Cooked.MockChain.Effect.Read as X
+import Cooked.MockChain.Effect.Read.Chain as X
+import Cooked.MockChain.Effect.Read.Conf as X
+import Cooked.MockChain.Effect.Validation as X
 import Cooked.MockChain.Effect.Write as X
 import Cooked.MockChain.Run.Instances as X
 import Cooked.MockChain.Run.Runnable as X

src/Cooked/MockChain/Automation.hs

@@ -0,0 +1,71 @@
+-- | This module runs the full automation pipeline that completes a
+-- `Cooked.Skeleton.TxSkel` into an actual transaction. It also serves as an
+-- umbrella re-exporting all the automation submodules (auto-filling, balancing
+-- and transaction generation).
+module Cooked.MockChain.Automation
+  ( runAutomationPipeline,
+    module X,
+  )
+where
+
+import Control.Monad
+import Cooked.MockChain.Automation.AutoFilling.Constitution as X
+import Cooked.MockChain.Automation.AutoFilling.MinAda as X
+import Cooked.MockChain.Automation.AutoFilling.ReferenceScripts as X
+import Cooked.MockChain.Automation.AutoFilling.Withdrawals as X
+import Cooked.MockChain.Automation.Balancing as X
+import Cooked.MockChain.Automation.GenerateTx.Anchor as X
+import Cooked.MockChain.Automation.GenerateTx.Body as X
+import Cooked.MockChain.Automation.GenerateTx.Certificate as X
+import Cooked.MockChain.Automation.GenerateTx.Collateral as X
+import Cooked.MockChain.Automation.GenerateTx.Credential as X
+import Cooked.MockChain.Automation.GenerateTx.Input as X
+import Cooked.MockChain.Automation.GenerateTx.Mint as X
+import Cooked.MockChain.Automation.GenerateTx.Output as X
+import Cooked.MockChain.Automation.GenerateTx.Proposal as X
+import Cooked.MockChain.Automation.GenerateTx.ReferenceInputs as X
+import Cooked.MockChain.Automation.GenerateTx.Withdrawals as X
+import Cooked.MockChain.Automation.GenerateTx.Witness as X
+import Cooked.MockChain.Effect.Log
+import Cooked.MockChain.Effect.Read.Chain
+import Cooked.MockChain.Effect.Read.Conf
+import Cooked.MockChain.Runtime.Error
+import Cooked.Skeleton
+import Cooked.Tweak.Common
+import Ledger.Orphans ()
+import Ledger.Tx qualified as P.Ledger
+import Polysemy
+import Polysemy.Error
+import Polysemy.Fail
+
+-- | This runs the full automation pipeline:
+-- 1. autofill min ada on eligible outputs
+-- 2. autofill constution on eligible proposals
+-- 3. autofill reference inputs on eligible redeemers
+-- 4. autofill amount on eligible withdrawals
+-- 5. balance the skeleton
+-- 6. compute fees and collaterals
+-- 7. generate a cardano transaction body
+-- 8. fetch phase 2 failures
+runAutomationPipeline ::
+  ( Members
+      '[ Error P.Ledger.ToCardanoError,
+         Error MockChainError,
+         MockChainLog,
+         MockChainReadChain,
+         MockChainReadConf,
+         Fail
+       ]
+      effs
+  ) =>
+  TxSkel ->
+  Sem effs ExtendedTxSkel
+runAutomationPipeline =
+  ( `execTweak`
+      do
+        autoFillMinAda
+        autoFillConstitution
+        autoFillReferenceScripts
+        autoFillWithdrawalAmounts
+  )
+    >=> balanceTxSkel

src/Cooked/MockChain/Automation/AutoFilling/Constitution.hs

@@ -7,8 +7,9 @@ module Cooked.MockChain.Automation.AutoFilling.Constitution
 where
 
 import Control.Monad
+import Control.Monad.Extra
 import Cooked.MockChain.Effect.Log
-import Cooked.MockChain.Effect.Read
+import Cooked.MockChain.Effect.Read.Chain
 import Cooked.Skeleton
 import Cooked.Tweak.Common
 import Cooked.Tweak.Update
@@ -23,16 +24,22 @@ import Polysemy
 -- existing specified script in such proposals. Logs an event when the
 -- constitution script has been successfully auto-filled.
 autoFillConstitution ::
-  (Members '[MockChainRead, Tweak, MockChainLog] effs) =>
+  ( Members
+      '[ MockChainReadChain,
+         Tweak,
+         MockChainLog
+       ]
+      effs
+  ) =>
   Sem effs ()
 autoFillConstitution = do
-  currentConstitution <- getConstitutionScript
-  case currentConstitution of
-    Nothing -> return ()
-    Just constitutionScript -> do
-      traverseTweak (txSkelProposalsL % traversed) $ \prop -> do
+  maybeM
+    (return ())
+    ( \constitutionScript -> traverseTweak (txSkelProposalsL % traversed) $ \prop -> do
         when (isn't txSkelProposalConstitutionAT prop) $
           logEvent $
             MCLogAutoFilledConstitution $
               Script.toScriptHash constitutionScript
-        return (fillConstitution constitutionScript prop)
+        return (fillConstitutionWhenEmpty constitutionScript prop)
+    )
+    getConstitutionScript

src/Cooked/MockChain/Automation/AutoFilling/MinAda.hs

@@ -10,11 +10,11 @@ where
 
 import Cardano.Api qualified as Cardano
 import Cardano.Ledger.Shelley.Core qualified as Shelley
-import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
 import Control.Monad
 import Cooked.MockChain.Automation.GenerateTx.Output
 import Cooked.MockChain.Effect.Log
-import Cooked.MockChain.Effect.Read
+import Cooked.MockChain.Effect.Read.Chain
+import Cooked.MockChain.Effect.Read.Conf
 import Cooked.Skeleton
 import Cooked.Tweak.Common
 import Cooked.Tweak.Update
@@ -28,11 +28,11 @@ import Polysemy.Error
 
 -- | Compute the required minimal ADA for a given output
 getTxSkelOutMinAda ::
-  (Members '[MockChainRead, Error P.Ledger.ToCardanoError] effs) =>
+  (Members '[MockChainReadChain, MockChainReadConf, Error P.Ledger.ToCardanoError] effs) =>
   TxSkelOut ->
   Sem effs Integer
 getTxSkelOutMinAda txSkelOut = do
-  params <- Emulator.pEmulatorPParams <$> getParams
+  params <- getParams
   Cardano.unCoin
     . Shelley.getMinCoinTxOut params
     . Cardano.toShelleyTxOut Cardano.ShelleyBasedEraConway
@@ -45,7 +45,7 @@ getTxSkelOutMinAda txSkelOut = do
 -- will increase the size of the UTXO which in turn might need more ADA.
 toTxSkelOutWithMinAda ::
   forall effs.
-  (Members '[MockChainRead, MockChainLog, Error P.Ledger.ToCardanoError] effs) =>
+  (Members '[MockChainReadChain, MockChainReadConf, MockChainLog, Error P.Ledger.ToCardanoError] effs) =>
   TxSkelOut ->
   Sem effs TxSkelOut
 -- The auto adjustment is disabled so nothing is done here
@@ -72,6 +72,6 @@ toTxSkelOutWithMinAda txSkelOut = do
 -- their ada value when requested by the user and required by the protocol
 -- parameters. Logs an event whenever such a change occurs.
 autoFillMinAda ::
-  (Members '[Tweak, MockChainRead, MockChainLog, Error P.Ledger.ToCardanoError] effs) =>
+  (Members '[Tweak, MockChainReadChain, MockChainReadConf, MockChainLog, Error P.Ledger.ToCardanoError] effs) =>
   Sem effs ()
 autoFillMinAda = traverseTweak (txSkelOutputsL % traversed) toTxSkelOutWithMinAda

src/Cooked/MockChain/Automation/AutoFilling/ReferenceScripts.hs

@@ -9,14 +9,15 @@ where
 
 import Control.Monad
 import Cooked.MockChain.Effect.Log
-import Cooked.MockChain.Effect.Read
+import Cooked.MockChain.Effect.Read.Chain
 import Cooked.MockChain.UtxoSearch
 import Cooked.Skeleton
 import Cooked.Tweak.Common
 import Cooked.Tweak.Query
 import Cooked.Tweak.Update
 import Data.List (find)
 import Data.Map qualified as Map
+import Data.Set qualified as Set
 import Optics.Core
 import Plutus.Script.Utils.Scripts qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
@@ -28,7 +29,7 @@ import Polysemy
 -- given script hash, and attaches it to a redeemer when it does not yet have a
 -- reference input and when it is allowed, in which case an event is logged.
 updateRedeemedScript ::
-  (Members '[MockChainLog, MockChainRead] effs) =>
+  (Members '[MockChainLog, MockChainReadChain] effs) =>
   [Api.TxOutRef] ->
   User IsScript Redemption ->
   Sem effs (User IsScript Redemption)
@@ -48,19 +49,19 @@ updateRedeemedScript
           return $ over userRedeemerAT (fillReferenceInput oRef) rs
       )
       $ case oRefsInInputs of
-        [] -> Nothing
+        s | null s -> Nothing
         -- If possible, we use a reference input appearing in regular inputs
-        l | Just oRefM' <- find (`elem` inputs) l -> Just oRefM'
+        s | Just oRefM' <- find (`elem` inputs) s -> Just oRefM'
         -- If none exist, we use the first one we find elsewhere
-        (oRefM' : _) -> Just oRefM'
+        s -> Just $ Set.elemAt 0 s
 updateRedeemedScript _ rs = return rs
 
 -- | Goes through the various parts of the skeleton where a redeemer can appear,
 -- and attempts to attach a reference input to each of them, whenever it is
 -- allowed and one has not already been set. Logs an event whenever such an
 -- addition occurs.
 autoFillReferenceScripts ::
-  (Members '[Tweak, MockChainRead, MockChainLog] effs) =>
+  (Members '[Tweak, MockChainReadChain, MockChainLog] effs) =>
   Sem effs ()
 autoFillReferenceScripts = do
   inputsKeys <- viewTweak $ txSkelInputsL % to Map.keys

src/Cooked/MockChain/Automation/AutoFilling/Withdrawals.hs

@@ -6,7 +6,7 @@ module Cooked.MockChain.Automation.AutoFilling.Withdrawals
 where
 
 import Cooked.MockChain.Effect.Log
-import Cooked.MockChain.Effect.Read
+import Cooked.MockChain.Effect.Read.Chain
 import Cooked.Skeleton
 import Cooked.Tweak.Common
 import Cooked.Tweak.Update
@@ -21,7 +21,7 @@ import Polysemy
 -- tamper with an existing specified amount in such withdrawals. Logs an event
 -- when an amount has been successfully auto-filled.
 autoFillWithdrawalAmounts ::
-  (Members '[MockChainRead, Tweak, MockChainLog] effs) =>
+  (Members '[MockChainReadChain, Tweak, MockChainLog] effs) =>
   Sem effs ()
 autoFillWithdrawalAmounts = do
   traverseTweak (txSkelWithdrawalsL % txSkelWithdrawalsListI % traversed) $ \withdrawal -> do