Change the structure of input configuration

app/App.hs

@@ -60,22 +60,38 @@ run Options{..} = do
 
 generateScriptsExample :: IO ()
 generateScriptsExample = do
+    -- NOTE: # is the identifier used in str for string interpolation. Example
+    -- [str|Hello, #{world}|].
+    --
+    -- We can escape this using ##. # at the end of the string removes the
+    -- newline. So we use ## if # is at the end.
     putStrLn
-        [str|scripts:
-  # The script hash of the script on-chain that we want to substitute.
-  # In this example it's just a random hash, so please replace with your own.
-  - script_hash: \"b6a7467ea1deb012808ef4e87b5ff371e85f7142d7b356a40d9b42a0\"
-
-    # Script name or alias for easier identification (optional).
-    name: always_succeeds
-
-    # The script that we want to run instead of the original script identified by the script hash above,
-    # in this case it's AlwaysSucceeds.
-    cborHex: \"4e4d01000033222220051200120011\"
-
+        [str|
 # Example of the starting point:
 # start:
 #   tag: ChainPoint
 #   slot: 11617
 #   blockHash: 9b65597bb73e21d5b58a1f5958f8b95324b142727efb2746c577998e93df3463
+
+scripts:
+  # The target script hash that we want to re-run locally.
+  # In this example it's just a random hash, so please replace with your own.
+  - script_hash: "22734734b6b0410cf4a0e3bd731fb98c55ac2b2a27b1eecb8d3b438c"
+    # List of substitution scripts we want to run on wherever the target script
+    # is found.
+    substitutions:
+      - # Name of the substitution script for easier identification (optional)
+        name: "Local Policy"
+        # The hash of the substitution script. The plutus-script-reexecutor will
+        # check and fail if the hash does not match.
+        ##
+        # Tip: Leave this as an empty string and let plutus-script-reexecutor
+        # error out with the expected script hash.
+        hash: "6bfbd8fc6567153cbaacdcd0ee9fff9e69ba2a0eb62c129b303ade19"
+        source:
+          # The source of the substitution script. This can either be a
+          # "file_path" or a "cbor_hex".
+          cbor_hex: "4e4d01000033222220051200120011"
+          # file_path: "local-config/policy-debug.plutus"
+
 |]

dev-local/Main.hs

@@ -107,29 +107,46 @@ tracingYamlContents scriptsDirName = do
 
     policyPolicyId <- getPolicyId $ scriptsDirPath </> "policy.plutus"
     validatorPolicyId <- getPolicyId $ scriptsDirPath </> "validator.plutus"
+    policyDebugPolicyId <- getPolicyId $ scriptsDirPath </> "policy-debug.plutus"
+    validatorDebugPolicyId <- getPolicyId $ scriptsDirPath </> "validator-debug.plutus"
 
+    -- NOTE: This seems hacky but I can't think of a clean way to abstract
+    -- common functionality.
+    let validatorPrefix =
+            if policyPolicyId == validatorPolicyId
+                then ""
+                else
+                    [str|
+  - script_hash: "#{validatorPolicyId}"
+    substitutions:
+|]
     pure
         [str|
   - script_hash: "#{policyPolicyId}"
-    name: "Local Policy"
-    source:
-      path: "#{scriptsDirName}/policy-debug.plutus"
-
-  - script_hash: "#{validatorPolicyId}"
-    name: "Local Validator"
-    source:
-      path: "#{scriptsDirName}/validator-debug.plutus"
+    substitutions:
+      - name: "Local Policy"
+        hash: "#{policyDebugPolicyId}"
+        source:
+          file_path: "#{scriptsDirName}/policy-debug.plutus"
+#{validatorPrefix}
+      - name: "Local Validator"
+        hash: "#{validatorDebugPolicyId}"
+        source:
+          file_path: "#{scriptsDirName}/validator-debug.plutus"
 |]
 
 escrowYamlContents :: IO String
 escrowYamlContents = do
     escrowPolicyId <- getPolicyId $ env_LOCAL_CONFIG_DIR </> "escrow.plutus"
+    escrowDebugPolicyId <- getPolicyId $ env_LOCAL_CONFIG_DIR </> "escrow-debug.plutus"
     pure
         [str|
   - script_hash: "#{escrowPolicyId}"
-    name: "Escrow"
-    source:
-      path: "./escrow-debug.plutus"
+    substitutions:
+      - name: "Escrow"
+        hash: "#{escrowDebugPolicyId}"
+        source:
+          file_path: "./escrow-debug.plutus"
 |]
 
 createScriptsYaml :: IO ()

lib/PSR/ConfigMap.hs

@@ -6,18 +6,23 @@ module PSR.ConfigMap (
     readConfigMap,
 ) where
 
+--------------------------------------------------------------------------------
+-- Imports
+--------------------------------------------------------------------------------
+
 import Cardano.Api qualified as C
 import Cardano.Api.Shelley qualified as C
-import Control.Applicative (asum)
+import Control.Monad (when)
 import Control.Monad.IO.Class (MonadIO (..))
 import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT, throwE, withExceptT)
-import Data.Aeson.Types (FromJSON (..), ToJSON (..))
+import Data.Function ((&))
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Text (Text)
-import Data.Yaml (decodeFileEither, withObject)
-import Data.Yaml.Aeson (Value (Object), object, (.:), (.:?), (.=))
+import Data.Text qualified as Text
+import Data.Yaml (decodeFileEither)
 import PSR.Chain (mkLocalNodeConnectInfo)
+import PSR.Types (deriveJSONRecord, deriveJSONSimpleSum)
 import PlutusLedgerApi.Common (
     MajorProtocolVersion,
     PlutusLedgerLanguage (..),
@@ -28,64 +33,47 @@ import PlutusLedgerApi.Common (
 import System.Directory (makeRelativeToCurrentDirectory)
 import System.FilePath (dropFileName, (</>))
 
--- | Represents the config map file on disk
-data ConfigMapFile = ConfigMapFile
-    { cmfStart :: Maybe C.ChainPoint
-    , cmfScripts :: [ScriptDetails]
-    }
-    deriving (Show, Eq)
+--------------------------------------------------------------------------------
+-- Types
+--------------------------------------------------------------------------------
 
-instance FromJSON ConfigMapFile where
-    parseJSON = withObject "ConfigMapFile" $ \v ->
-        ConfigMapFile
-            <$> v .:? "start"
-            <*> v .: "scripts"
+{- | Where a script's source can be found, either inline in the Yaml file
+ or another file on disk.
+-}
+data ScriptSource
+    = SCborHex C.TextEnvelope
+    | SFilePath FilePath
+    deriving (Show, Eq)
 
-instance ToJSON ConfigMapFile where
-    toJSON (ConfigMapFile strt scrpts) =
-        object ["start" .= strt, "scripts" .= scrpts]
+$(deriveJSONSimpleSum "S" ''ScriptSource)
 
--- | Details of each script
 data ScriptDetails = ScriptDetails
-    { sdScriptHash :: C.ScriptHash
+    { sdHash :: Text
+    , sdSource :: ScriptSource
     , sdName :: Maybe Text
-    , sdSource :: Maybe ScriptSource
     }
     deriving (Show, Eq)
 
-instance ToJSON ScriptDetails where
-    toJSON (ScriptDetails sh nm src) =
-        object $
-            concat
-                [ ["script_hash" .= sh]
-                , maybe [] ((: []) . ("name" .=)) nm
-                , maybe [] ((: []) . ("source" .=)) src
-                ]
+$(deriveJSONRecord "sd" ''ScriptDetails)
+
+-- | Details of each script
+data ScriptSubDetails = ScriptSubDetails
+    { sdScriptHash :: C.ScriptHash
+    , sdTargetScriptName :: Maybe Text
+    , sdSubstitutions :: [ScriptDetails]
+    }
+    deriving (Show, Eq)
 
-instance FromJSON ScriptDetails where
-    parseJSON = withObject "ScriptDetails" $ \v ->
-        ScriptDetails
-            <$> v .: "script_hash"
-            <*> v .:? "name"
-            <*> v .:? "source"
+$(deriveJSONRecord "sd" ''ScriptSubDetails)
 
-{- | Where a script's source can be found, either inline in the Yaml file
- or another file on disk.
--}
-data ScriptSource
-    = CBORHex C.TextEnvelope
-    | FromFile FilePath
+-- | Represents the config map file on disk
+data ConfigMapFile = ConfigMapFile
+    { cmfStart :: Maybe C.ChainPoint
+    , cmfScripts :: [ScriptSubDetails]
+    }
     deriving (Show, Eq)
 
-instance FromJSON ScriptSource where
-    parseJSON = withObject "ScriptSource" $ \v ->
-        asum
-            [ CBORHex <$> parseJSON (Object v)
-            , FromFile <$> v .: "path"
-            ]
-instance ToJSON ScriptSource where
-    toJSON (CBORHex cb) = toJSON cb
-    toJSON (FromFile path) = object ["path" .= path]
+$(deriveJSONRecord "cmf" ''ConfigMapFile)
 
 {- | The resolved configuration map, with any scripts referenced by
   path loaded from disk.
@@ -98,8 +86,8 @@ data ConfigMap = ConfigMap
 
 -- | Information relating to a loaded script
 data ResolvedScript = ResolvedScript
-    { rsScriptHash :: C.ScriptHash
-    , rsName :: Maybe Text
+    { rsName :: Maybe Text
+    , rsScriptHash :: Text
     , rsScriptFileContent :: C.ScriptInAnyLang
     , rsScriptEvaluationParameters :: ScriptEvaluationParameters
     , rsScriptForEvaluation :: ScriptForEvaluation
@@ -114,6 +102,10 @@ data ScriptEvaluationParameters where
         ScriptEvaluationParameters
     deriving (Show, Eq)
 
+--------------------------------------------------------------------------------
+-- Functions
+--------------------------------------------------------------------------------
+
 -- resolveScript :: ScriptInAnyLang -> _
 resolveScript :: C.ScriptInAnyLang -> ExceptT String IO (ScriptEvaluationParameters, ScriptForEvaluation)
 resolveScript (scr :: C.ScriptInAnyLang) = do
@@ -130,31 +122,60 @@ resolveScript (scr :: C.ScriptInAnyLang) = do
     (ScriptEvaluationParameters lang protocol,)
         <$> withExceptT show (deserialiseScript lang protocol script)
 
+readSubstitutionList :: FilePath -> ScriptSubDetails -> ExceptT String IO (C.ScriptHash, [ResolvedScript])
+readSubstitutionList scriptYamlDir ScriptSubDetails{..} = do
+    (sdScriptHash,) <$> mapM (readScriptFile scriptYamlDir sdScriptHash) (zip [1 ..] sdSubstitutions)
+
 -- | Resolve a script, either from disk or inline definition
-readScriptFile :: FilePath -> ScriptDetails -> ExceptT String IO ResolvedScript
-readScriptFile scriptYamlDir ScriptDetails{..} = do
+readScriptFile :: FilePath -> C.ScriptHash -> (Int, ScriptDetails) -> ExceptT String IO ResolvedScript
+readScriptFile scriptYamlDir scrutScriptHash (ix, ScriptDetails{..}) = do
     let someTypeFor x v = C.FromSomeType x (C.ScriptInAnyLang (C.PlutusScriptLanguage v) . C.PlutusScript v)
         v1 = someTypeFor (C.AsPlutusScript C.AsPlutusScriptV1) C.PlutusScriptV1
         v2 = someTypeFor (C.AsPlutusScript C.AsPlutusScriptV2) C.PlutusScriptV2
         v3 = someTypeFor (C.AsPlutusScript C.AsPlutusScriptV3) C.PlutusScriptV3
         scriptTypes = [v1, v2, v3]
 
+    let errIdentifier =
+            Text.concat
+                [ "["
+                , C.serialiseToRawBytesHexText scrutScriptHash
+                , "] at substitution ["
+                , Text.pack (show ix)
+                , "]"
+                ]
+
     rsScriptFileContent <- case sdSource of
-        Just (FromFile path') -> do
+        SFilePath path' -> do
             let path = scriptYamlDir </> path'
             relativePath <- liftIO $ makeRelativeToCurrentDirectory path
             liftIO $ putStrLn $ "Reading script from file: " <> relativePath
             withExceptT show $ ExceptT $ C.readFileTextEnvelopeAnyOf scriptTypes (C.File relativePath)
-        Just (CBORHex content) ->
+        SCborHex content ->
             withExceptT show $ except $ C.deserialiseFromTextEnvelopeAnyOf scriptTypes content
-        _ -> fail $ "Please provide either the cborHex or file_path for: " <> show sdScriptHash
+
+    let actualScriptHash =
+            case rsScriptFileContent of
+                C.ScriptInAnyLang _ script ->
+                    C.serialiseToRawBytesHexText $ C.hashScript script
+
+    when (sdHash /= actualScriptHash) $
+        fail $
+            Text.unpack $
+                Text.concat
+                    [ "Unable to verify script file at "
+                    , errIdentifier
+                    , ". Actual hash is: "
+                    , actualScriptHash
+                    , ", but got "
+                    , sdHash
+                    ]
 
     (rsScriptEvaluationParameters, rsScriptForEvaluation) <- resolveScript rsScriptFileContent
 
     pure
         ResolvedScript
-            { rsScriptHash = sdScriptHash
-            , rsName = sdName
+            { rsName = sdName
+            , rsScriptHash = sdHash
             , rsScriptFileContent
             , rsScriptEvaluationParameters
             , rsScriptForEvaluation
@@ -165,10 +186,19 @@ readConfigMap :: FilePath -> C.NetworkId -> C.SocketPath -> IO (Either String Co
 readConfigMap scriptYaml networkId socketPath = runExceptT $ do
     ConfigMapFile{..} <- withExceptT show $ ExceptT $ decodeFileEither scriptYaml
     let scriptYamlDir = dropFileName scriptYaml
-    scripts' <- mapM (readScriptFile scriptYamlDir) cmfScripts
+    -- NOTE: The list of substitutions here can be empty, it just signals that
+    -- the user is interested in that script and wants to record the
+    -- observations.
+    --
+    -- TODO: Think about what should the behavior look like if the list of
+    -- substitutions is empty.
+    -- One possible behavior: Evaluate the transaction normally in this case,
+    -- and provide the outputs we compute from the real script (like ExUnits).
+    --
+    kvPairs <- mapM (readSubstitutionList scriptYamlDir) cmfScripts
     pure
         ConfigMap
             { cmStart = cmfStart
-            , cmScripts = Map.fromListWith (++) [(rsScriptHash x, [x]) | x <- scripts']
+            , cmScripts = Map.fromList kvPairs
             , cmLocalNodeConn = mkLocalNodeConnectInfo networkId socketPath
             }

lib/PSR/Events/Interface.hs

@@ -40,6 +40,9 @@ data Event = Event
 
 newtype TraceLogs = TraceLogs {getTraceLogs :: [Text]} deriving (Eq, Show, Generic)
 
+-- TODO: scriptHash is currently the targetScriptHash. We need to also track
+-- substitutedScriptHash here which is essentially the canonical scriptName.
+--
 data ExecutionContext = ExecutionContext
     { transactionHash :: TxId
     , scriptName :: Maybe Text