Create cardano-node-emulator package

Move Params and TimeSlot modules to cardano-node-emulator

Move some functions from Validation to CardanoAPI

cabal.project

@@ -19,7 +19,8 @@ index-state:
   , hackage.haskell.org 2022-11-14T00:20:02Z
   , cardano-haskell-packages 2022-11-17T04:56:26Z
 
-packages: cardano-streaming
+packages: cardano-node-emulator
+          cardano-streaming
           doc
           freer-extras
           marconi

cardano-node-emulator/cardano-node-emulator.cabal

@@ -0,0 +1,117 @@
+cabal-version: 3.0
+name:          cardano-node-emulator
+version:       1.0.0.0
+
+common lang
+  default-language:   Haskell2010
+  default-extensions:
+    DeriveFoldable
+    DeriveFunctor
+    DeriveGeneric
+    DeriveLift
+    DeriveTraversable
+    ExplicitForAll
+    FlexibleContexts
+    GeneralizedNewtypeDeriving
+    ImportQualifiedPost
+    LambdaCase
+    NamedFieldPuns
+    ScopedTypeVariables
+    StandaloneDeriving
+
+  ghc-options:
+    -Wall -Widentities -Wincomplete-record-updates
+    -Wincomplete-uni-patterns -Wnoncanonical-monad-instances
+    -Wredundant-constraints -Wunused-packages
+
+library
+  import:          lang
+  hs-source-dirs:  src
+  exposed-modules:
+    Cardano.Node.Emulator
+    Cardano.Node.Emulator.Chain
+    Cardano.Node.Emulator.Effects
+    Cardano.Node.Emulator.Fee
+    Cardano.Node.Emulator.Generators
+    Cardano.Node.Emulator.Params
+    Cardano.Node.Emulator.TimeSlot
+    Cardano.Node.Emulator.Validation
+
+  --------------------
+  -- Local components
+  --------------------
+  build-depends:
+    , freer-extras         >=1.0.0
+    , plutus-ledger        >=1.0.0
+    , plutus-script-utils  >=1.0.0
+
+  --------------------------
+  -- Other IOG dependencies
+  --------------------------
+  build-depends:
+    , cardano-api:{cardano-api, gen}  >=1.35
+    , cardano-crypto
+    , cardano-ledger-alonzo
+    , cardano-ledger-babbage
+    , cardano-ledger-core
+    , cardano-ledger-shelley
+    , cardano-ledger-shelley-ma
+    , cardano-slotting
+    , ouroboros-consensus
+    , plutus-core                     >=1.0.0
+    , plutus-ledger-api               >=1.0.0
+    , plutus-tx                       >=1.0.0
+
+  ------------------------
+  -- Non-IOG dependencies
+  ------------------------
+  build-depends:
+    , aeson              >=1.5.2
+    , array
+    , base               >=4.9     && <5
+    , bytestring
+    , containers
+    , data-default
+    , deepseq
+    , either
+    , freer-simple
+    , hedgehog
+    , lens
+    , mtl
+    , openapi3
+    , prettyprinter      >=1.1.0.1
+    , serialise
+    , strict-containers
+    , text
+    , time
+
+test-suite cardano-node-emulator-test
+  import:             lang
+  type:               exitcode-stdio-1.0
+  main-is:            Spec.hs
+  hs-source-dirs:     test
+  default-language:   Haskell2010
+  default-extensions: ImportQualifiedPost
+  other-modules:      Cardano.Node.Emulator.GeneratorsSpec
+
+  --------------------
+  -- Local components
+  --------------------
+  build-depends:
+    , cardano-node-emulator  >=1.0.0
+    , plutus-ledger          >=1.0.0
+
+  --------------------------
+  -- Other IOG dependencies
+  --------------------------
+  build-depends:      plutus-tx >=1.0.0
+
+  ------------------------
+  -- Non-IOG dependencies
+  ------------------------
+  build-depends:
+    , aeson
+    , base            >=4.9 && <5
+    , hedgehog
+    , tasty
+    , tasty-hedgehog

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

@@ -0,0 +1,11 @@
+module Cardano.Node.Emulator
+  ( module Export
+  ) where
+
+import Cardano.Node.Emulator.Chain as Export
+import Cardano.Node.Emulator.Effects as Export
+import Cardano.Node.Emulator.Fee as Export
+import Cardano.Node.Emulator.Generators as Export
+import Cardano.Node.Emulator.Params as Export
+import Cardano.Node.Emulator.TimeSlot as Export
+import Cardano.Node.Emulator.Validation as Export

plutus-contract/src/Wallet/Emulator/Chain.hs → cardano-node-emulator/src/Cardano/Node/Emulator/Chain.hs

@@ -15,8 +15,10 @@
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeOperators         #-}
 
-module Wallet.Emulator.Chain where
+module Cardano.Node.Emulator.Chain where
 
+import Cardano.Node.Emulator.Params (Params (..))
+import Cardano.Node.Emulator.Validation qualified as Validation
 import Control.Lens hiding (index)
 import Control.Monad.Freer
 import Control.Monad.Freer.Extras.Log (LogMsg, logDebug, logInfo, logWarn)
@@ -32,12 +34,12 @@ import Data.Monoid (Ap (Ap))
 import Data.Text (Text)
 import Data.Traversable (for)
 import GHC.Generics (Generic)
-import Ledger (Block, Blockchain, CardanoTx (..), OnChainTx (..), Params (..), Slot (..), TxId, TxIn (txInRef), Value,
+import Ledger (Block, Blockchain, CardanoTx (..), OnChainTx (..), Slot (..), TxId, TxIn (txInRef), Value,
                getCardanoTxCollateralInputs, getCardanoTxFee, getCardanoTxId, getCardanoTxTotalCollateral,
                getCardanoTxValidityRange, txOutValue, unOnChain)
 import Ledger.Index qualified as Index
 import Ledger.Interval qualified as Interval
-import Ledger.Validation qualified as Validation
+import Ledger.Tx.CardanoAPI (fromPlutusIndex)
 import Plutus.V1.Ledger.Scripts qualified as Scripts
 import Prettyprinter
 
@@ -64,7 +66,7 @@ data ChainState = ChainState {
     _chainNewestFirst :: Blockchain, -- ^ The current chain, with the newest transactions first in the list.
     _txPool           :: TxPool, -- ^ The pool of pending transactions.
     _index            :: Index.UtxoIndex, -- ^ The UTxO index, used for validation.
-    _currentSlot      :: Slot -- ^ The current slot number
+    _chainCurrentSlot :: Slot -- ^ The current slot number
 } deriving (Show, Generic)
 
 emptyChainState :: ChainState
@@ -104,7 +106,7 @@ handleControlChain :: Members ChainEffs effs => Params -> ChainControlEffect ~>
 handleControlChain params = \case
     ProcessBlock -> do
         pool  <- gets $ view txPool
-        slot  <- gets $ view currentSlot
+        slot  <- gets $ view chainCurrentSlot
         idx   <- gets $ view index
 
         let ValidatedBlock block events idx' =
@@ -117,7 +119,7 @@ handleControlChain params = \case
         traverse_ logEvent events
         pure block
 
-    ModifySlot f -> modify @ChainState (over currentSlot f) >> gets (view currentSlot)
+    ModifySlot f -> modify @ChainState (over chainCurrentSlot f) >> gets (view chainCurrentSlot)
 
 logEvent :: Member (LogMsg ChainEvent) effs => ChainEvent -> Eff effs ()
 logEvent e = case e of
@@ -128,7 +130,7 @@ logEvent e = case e of
 handleChain :: (Members ChainEffs effs) => Params -> ChainEffect ~> Eff effs
 handleChain params = \case
     QueueTx tx     -> modify $ over txPool (addTxToPool tx)
-    GetCurrentSlot -> gets _currentSlot
+    GetCurrentSlot -> gets _chainCurrentSlot
     GetParams      -> pure params
 
 -- | The result of validating a block.
@@ -199,7 +201,7 @@ validateEm
 validateEm h txn = do
     ctx@(ValidationCtx idx params) <- S.get
     let
-        cUtxoIndex = either (error . show) id $ Validation.fromPlutusIndex idx
+        cUtxoIndex = either (error . show) id $ fromPlutusIndex idx
         e = Validation.validateCardanoTx params h cUtxoIndex txn
         idx' = case e of
             Left (Index.Phase1, _) -> idx

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

@@ -0,0 +1,29 @@
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE DeriveAnyClass    #-}
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE DerivingVia       #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE GADTs             #-}
+{-# LANGUAGE KindSignatures    #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE NamedFieldPuns    #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+
+module Cardano.Node.Emulator.Effects(
+  -- * Node client
+    NodeClientEffect(..)
+  , publishTx
+  , getClientSlot
+  , getClientParams
+  ) where
+
+import Cardano.Node.Emulator.Params (Params)
+import Control.Monad.Freer.TH (makeEffect)
+import Ledger (CardanoTx, Slot)
+
+data NodeClientEffect r where
+    PublishTx :: CardanoTx -> NodeClientEffect ()
+    GetClientSlot :: NodeClientEffect Slot
+    GetClientParams :: NodeClientEffect Params
+makeEffect ''NodeClientEffect

plutus-ledger/src/Ledger/Fee.hs → cardano-node-emulator/src/Cardano/Node/Emulator/Fee.hs

@@ -6,7 +6,7 @@
 {-# LANGUAGE TupleSections      #-}
 {-# LANGUAGE TypeFamilies       #-}
 -- | Calculating transaction fees in the emulator.
-module Ledger.Fee(
+module Cardano.Node.Emulator.Fee(
   estimateTransactionFee,
   estimateCardanoBuildTxFee,
   makeAutoBalancedTransaction,
@@ -24,6 +24,9 @@ import Cardano.Ledger.Core qualified as C.Ledger (Tx)
 import Cardano.Ledger.Shelley.API qualified as C.Ledger hiding (Tx)
 import Control.Lens (over, (&))
 import Data.Aeson (FromJSON, ToJSON)
+import Cardano.Node.Emulator.Params (EmulatorEra, PParams, Params (emulatorPParams, pNetworkId), emulatorEraHistory,
+                                     emulatorGlobals, pProtocolParams)
+import Cardano.Node.Emulator.Validation (CardanoLedgerError, UTxO (..), makeTransactionBody)
 import Data.Bifunctor (bimap, first)
 import Data.Foldable (fold, foldl', toList)
 import Data.List (sortOn, (\\))
@@ -36,14 +39,11 @@ import Ledger.Ada qualified as Ada
 import Ledger.Address (Address, PaymentPubKeyHash)
 import Ledger.Index (UtxoIndex (UtxoIndex), ValidationError (TxOutRefNotFound), ValidationPhase (Phase1), adjustTxOut,
                      minAdaTxOutEstimated)
-import Ledger.Params (EmulatorEra, PParams, Params (emulatorPParams, pNetworkId), emulatorEraHistory, emulatorGlobals,
-                      pProtocolParams)
 import Ledger.Tx (ToCardanoError (TxBodyError), Tx, TxOut, TxOutRef)
 import Ledger.Tx qualified as Tx
 import Ledger.Tx.CardanoAPI (CardanoBuildTx (..), getCardanoBuildTx, toCardanoAddressInEra, toCardanoFee,
-                             toCardanoReturnCollateral, toCardanoTotalCollateral, toCardanoTxBodyContent)
+                             toCardanoReturnCollateral, toCardanoTotalCollateral, toCardanoTxBodyContent, fromPlutusIndex)
 import Ledger.Tx.CardanoAPI qualified as CardanoAPI
-import Ledger.Validation (CardanoLedgerError, UTxO (..), fromPlutusIndex, makeTransactionBody)
 import Ledger.Value (Value)
 import Ledger.Value qualified as Value
 import PlutusTx.Prelude qualified as PlutusTx
@@ -55,7 +55,7 @@ estimateTransactionFee
   -> Tx
   -> Either CardanoLedgerError Value
 estimateTransactionFee params utxo requiredSigners tx = do
-  txBodyContent <- first Right $ toCardanoTxBodyContent params requiredSigners tx
+  txBodyContent <- first Right $ toCardanoTxBodyContent (pNetworkId params) (emulatorPParams params) requiredSigners tx
   estimateCardanoBuildTxFee params utxo txBodyContent
 
 estimateCardanoBuildTxFee

plutus-ledger/src/Ledger/Generators.hs → cardano-node-emulator/src/Cardano/Node/Emulator/Generators.hs

@@ -7,7 +7,7 @@
 {-# LANGUAGE TypeFamilies        #-}
 
 -- | Generators for constructing blockchains and transactions for use in property-based testing.
-module Ledger.Generators(
+module Cardano.Node.Emulator.Generators(
     -- * Mockchain
     Mockchain(..),
     genMockchain,
@@ -80,6 +80,10 @@ import Hedgehog.Range qualified as Range
 import Cardano.Api qualified as C
 import Cardano.Api.Shelley (ProtocolParameters (..))
 import Cardano.Crypto.Wallet qualified as Crypto
+import Cardano.Node.Emulator.Params (Params (pSlotConfig))
+import Cardano.Node.Emulator.TimeSlot (SlotConfig)
+import Cardano.Node.Emulator.TimeSlot qualified as TimeSlot
+import Cardano.Node.Emulator.Validation (fromPlutusTxSigned, validateCardanoTx)
 import Ledger (Ada, AssetClass, CardanoTx (EmulatorTx), CurrencySymbol, Datum, Interval, Language (PlutusV1),
                POSIXTime (POSIXTime, getPOSIXTime), POSIXTimeRange, Passphrase (Passphrase),
                PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey, Slot (Slot), SlotRange,
@@ -93,11 +97,8 @@ import Ledger (Ada, AssetClass, CardanoTx (EmulatorTx), CurrencySymbol, Datum, I
 import Ledger.Ada qualified as Ada
 import Ledger.CardanoWallet qualified as CW
 import Ledger.Index.Internal qualified as Index (UtxoIndex (UtxoIndex))
-import Ledger.Params (Params (pSlotConfig))
-import Ledger.TimeSlot (SlotConfig)
-import Ledger.TimeSlot qualified as TimeSlot
 import Ledger.Tx qualified as Tx
-import Ledger.Validation (fromPlutusIndex, fromPlutusTxSigned, validateCardanoTx)
+import Ledger.Tx.CardanoAPI (fromPlutusIndex)
 import Ledger.Value qualified as Value
 import Numeric.Natural (Natural)
 import Plutus.Script.Utils.Scripts (Versioned (Versioned), datumHash)

plutus-ledger/src/Ledger/Params.hs → cardano-node-emulator/src/Cardano/Node/Emulator/Params.hs

@@ -6,7 +6,7 @@
 {-# LANGUAGE TemplateHaskell    #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 -- | The set of parameters, like protocol parameters and slot configuration.
-module Ledger.Params(
+module Cardano.Node.Emulator.Params(
   Params(..),
   paramsWithProtocolsParameters,
   slotConfigL,
@@ -39,6 +39,7 @@ import Cardano.Ledger.Crypto (StandardCrypto)
 import Cardano.Ledger.Shelley.API (Coin (..), Globals, ShelleyGenesis (..), mkShelleyGlobals)
 import Cardano.Ledger.Shelley.API qualified as C.Ledger
 import Cardano.Ledger.Slot (EpochSize (..))
+import Cardano.Node.Emulator.TimeSlot (SlotConfig (..), posixTimeToNominalDiffTime, posixTimeToUTCTime)
 import Cardano.Slotting.EpochInfo (fixedEpochInfo)
 import Cardano.Slotting.Time (SlotLength, mkSlotLength)
 import Control.Lens (Lens', lens, makeLensesFor, over, (&), (.~))
@@ -50,7 +51,6 @@ import Data.Maybe (fromMaybe)
 import Data.Ratio ((%))
 import Data.SOP.Strict (K (K), NP (..))
 import GHC.Generics (Generic)
-import Ledger.TimeSlot (SlotConfig (..), posixTimeToNominalDiffTime, posixTimeToUTCTime)
 import Ouroboros.Consensus.HardFork.History qualified as Ouroboros
 import Ouroboros.Consensus.Util.Counting qualified as Ouroboros
 import Plutus.V1.Ledger.Api (POSIXTime (..))

plutus-ledger/src/Ledger/TimeSlot.hs → cardano-node-emulator/src/Cardano/Node/Emulator/TimeSlot.hs

@@ -1,14 +1,15 @@
-{-# LANGUAGE DeriveAnyClass     #-}
-{-# LANGUAGE DeriveGeneric      #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE NamedFieldPuns     #-}
-{-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE OverloadedStrings  #-}
-{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE DeriveAnyClass        #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE DerivingStrategies    #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns        #-}
+{-# LANGUAGE NoImplicitPrelude     #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TemplateHaskell       #-}
 
 {-# OPTIONS_GHC -Wno-orphans        #-}
 
-module Ledger.TimeSlot(
+module Cardano.Node.Emulator.TimeSlot(
   SlotConfig(..)
 , SlotConversionError(..)
 , slotRangeToPOSIXTimeRange