fix parsing of Alonzo genesis.

Author: KtorZ

clients/TypeScript/packages/client/src/Connection.ts

@@ -227,7 +227,7 @@ export const Method = <
           try {
             const handler = res.handler || ((response, resolve, reject) => {
               if (response.method === req.method && response) {
-                const success = response as unknown as { result: A | PromiseLike<A> };
+                const success = response as unknown as { result: A | PromiseLike<A> }
                 resolve(success.result)
               } else {
                 reject(response)

clients/TypeScript/packages/client/test/LedgerStateQuery.test.ts

@@ -6,9 +6,9 @@ import {
   DigestBlake2B256,
   GenesisAlonzo,
   GenesisByron,
+  GenesisConway,
   GenesisShelley,
   Point,
-  QueryNetworkInvalidGenesis,
   RewardAccountSummary,
   Slot
 } from '@cardano-ogmios/schema'
@@ -84,14 +84,6 @@ describe('Local state queries', () => {
       expect(context.socket.readyState).toBe(context.socket.OPEN)
     })
 
-    it('rejects if the query is for another era', async () => {
-      try {
-        await client.genesisConfiguration('conway')
-      } catch (e) {
-        expect((e as QueryNetworkInvalidGenesis['error']).code).toBe(2004)
-      }
-    })
-
     it('exposes the queries, uses a single context, and should be shutdowned when done', async () => {
       const epoch = await client.epoch()
       expect(epoch).toBeDefined()
@@ -119,6 +111,9 @@ describe('Local state queries', () => {
       const alonzoGenesis = await client.genesisConfiguration('alonzo')
       expect((alonzoGenesis as GenesisAlonzo).updatableParameters.minUtxoDepositCoefficient).toBeDefined()
 
+      const conwayGenesis = await client.genesisConfiguration('conway')
+      expect((conwayGenesis as GenesisConway).constitution).toBeDefined()
+
       const point = await client.ledgerTip() as { slot: Slot, id: DigestBlake2B256 }
       expect(point.slot).toBeDefined()
 
@@ -224,13 +219,33 @@ describe('Local state queries', () => {
         expect(bound.epoch).toBeDefined()
       })
     })
-    describe('genesisConfig', () => {
-      it('fetches the config used to bootstrap the blockchain, excluding the genesis UTXO', async () => {
+    describe('genesisConfig(byron)', () => {
+      it('fetches the byron config used to bootstrap the blockchain, excluding the genesis UTXO', async () => {
+        const config = await LedgerStateQuery.genesisConfiguration(context, 'byron')
+        expect((config as GenesisByron).initialVouchers).toBeDefined()
+      })
+    })
+    describe('genesisConfig(shelley)', () => {
+      it('fetches the shelley config used to bootstrap the Shelley era', async () => {
         const config = await LedgerStateQuery.genesisConfiguration(context, 'shelley')
         expect((config as GenesisShelley).startTime).toBeDefined()
         expect((config as GenesisShelley).networkMagic).toBeDefined()
       })
     })
+    describe('genesisConfig(alonzo)', () => {
+      it('fetches the config used to bootstrap the Alonzo era', async () => {
+        const config = await LedgerStateQuery.genesisConfiguration(context, 'alonzo')
+        expect(config.updatableParameters.plutusCostModels['plutus:v1'])
+          .toEqual([197209, 0, 1, 1, 396231, 621, 0, 1, 150000, 1000, 0, 1, 150000, 32, 2477736, 29175, 4, 29773, 100, 29773, 100, 29773, 100, 29773, 100, 29773, 100, 29773, 100, 100, 100, 29773, 100, 150000, 32, 150000, 32, 150000, 32, 150000, 1000, 0, 1, 150000, 32, 150000, 1000, 0, 8, 148000, 425507, 118, 0, 1, 1, 150000, 1000, 0, 8, 150000, 112536, 247, 1, 150000, 10000, 1, 136542, 1326, 1, 1000, 150000, 1000, 1, 150000, 32, 150000, 32, 150000, 32, 1, 1, 150000, 1, 150000, 4, 103599, 248, 1, 103599, 248, 1, 145276, 1366, 1, 179690, 497, 1, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 148000, 425507, 118, 0, 1, 1, 61516, 11218, 0, 1, 150000, 32, 148000, 425507, 118, 0, 1, 1, 148000, 425507, 118, 0, 1, 1, 2477736, 29175, 4, 0, 82363, 4, 150000, 5000, 0, 1, 150000, 32, 197209, 0, 1, 1, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 3345831, 1, 1])
+        expect((config as GenesisAlonzo).updatableParameters.minUtxoDepositCoefficient).toBeDefined()
+      })
+    })
+    describe('genesisConfig(conway)', () => {
+      it('fetches the config used to bootstrap the Conway era', async () => {
+        const config = await LedgerStateQuery.genesisConfiguration(context, 'conway')
+        expect((config as GenesisConway).constitution).toBeDefined()
+      })
+    })
     describe('ledgerTip', () => {
       it('fetches the tip of the ledger', async () => {
         const point = await LedgerStateQuery.ledgerTip(context) as { slot: Slot, id: DigestBlake2B224 }

server/src/Ogmios/App/Configuration.hs

@@ -48,7 +48,9 @@ import Data.Aeson
     , genericToEncoding
     )
 import Data.Aeson.Lens
-    ( _String
+    ( _JSON'
+    , _String
+    , _Value
     , key
     )
 import Data.Time.Clock.POSIX
@@ -78,7 +80,12 @@ import System.FilePath
     )
 
 import qualified Cardano.Chain.Genesis as Byron
+import qualified Cardano.Ledger.Alonzo.Genesis as Ledger
+import qualified Cardano.Ledger.Api as Ledger
+import qualified Cardano.Ledger.Plutus as Ledger
 import qualified Data.Aeson as Json
+import qualified Data.Map as Map
+import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Yaml as Yaml
 
@@ -137,7 +144,64 @@ readAlonzoGenesis configFile = do
         Nothing ->
             liftIO $ fail "Missing 'AlonzoGenesisFile' from node's configuration."
         Just (toString -> genesisFile) -> do
-            Yaml.decodeFileThrow (replaceFileName configFile genesisFile)
+            -- We have to decode Alonzo into an intermediate value first because
+            -- the default JSON decoder from the cardano-ledge can no longer
+            -- decode the genesis configuration.
+            --
+            -- The reason being that the decoder checks for the existence of
+            -- various parameters in the cost model for Plutus V1. Yet, new
+            -- parameters were added retro-actively to the cost model, so they
+            -- aren't present in the genesis config. But the decoder doesn't
+            -- care and fails.
+            --
+            -- So we have to manually add some placeholder key values to the
+            -- base genesis, so that the decoder can succeed; only to drop them
+            -- after from the map because they aren't actually part of the
+            -- genesis configuration.
+            value :: Yaml.Value <- Yaml.decodeFileThrow (replaceFileName configFile genesisFile)
+
+            let (costModelsWithFutureParams, sourceParamNames) = withFutureParameters (value ^. getter)
+                  where
+                    getter = key "costModels" . key "PlutusV1" . _JSON'
+
+            let valueWithPlaceholders = value & setter .~ Json.toJSON costModelsWithFutureParams
+                  where
+                    setter = key "costModels" . key "PlutusV1" . _Value
+
+            genesis <- liftIO $ Yaml.decodeThrow (Yaml.encode valueWithPlaceholders)
+
+            pure (withoutFutureParameters sourceParamNames genesis)
+  where
+    withFutureParameters :: Map Text Int64  -> (Map Text Int64, Set Text)
+    withFutureParameters genesisParams = foldr
+        (\paramName (params, sourceParamNames) ->
+            case Map.lookup paramName params of
+              Just{} -> (params, Set.insert paramName sourceParamNames)
+              Nothing -> (Map.insert paramName 0 params, sourceParamNames)
+        )
+        (genesisParams, Set.empty)
+        allV1ParamNames
+
+    allV1ParamNames :: [Text]
+    allV1ParamNames = Ledger.costModelParamNames Ledger.PlutusV1
+
+    withoutFutureParameters :: Set Text -> GenesisConfig AlonzoEra -> GenesisConfig AlonzoEra
+    withoutFutureParameters sourceParamNames config =
+        let
+            inner = Ledger.unAlonzoGenesisWrapper config
+            costModels = Ledger.uappCostModels inner
+            costModelsPruned = Map.adjust
+                (either (error . show) identity
+                    . Ledger.mkCostModel Ledger.PlutusV1
+                    . Map.elems
+                    . (`Map.restrictKeys` sourceParamNames)
+                    . Ledger.costModelToMap
+                )
+                Ledger.PlutusV1
+                (Ledger.costModelsValid costModels)
+         in
+            Ledger.AlonzoGenesisWrapper (inner { Ledger.uappCostModels = Ledger.mkCostModels costModelsPruned })
+
 
 readConwayGenesis :: MonadIO m => FilePath -> m (Either Text (GenesisConfig ConwayEra))
 readConwayGenesis configFile = do

server/src/Ogmios/Prelude.hs

@@ -25,6 +25,7 @@ module Ogmios.Prelude
     , typed
     , (^?)
     , (^.)
+    , (.~)
 
       -- * StrictMaybe
     , StrictMaybe
@@ -240,6 +241,11 @@ infixl 8 ^?
 s ^? l = getFirst (fmof l (First #. Just) s)
   where fmof l' f = getConst #. l' (Const #. f)
 
+-- | Copied from https://hackage.haskell.org/package/generic-lens-2.2.2.0/docs/src/Data.Generics.Internal.VL.Lens.html#.~
+infixr 4 .~
+(.~) :: ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
+(.~) f b = runIdentity . f (Identity . const b)
+
 keepRedundantConstraint :: c => Proxy c -> ()
 keepRedundantConstraint _ = ()