Add FromJSON instance to AlonzoGenesis

This instances was copied from node. But it should really live in
ledger spec. Same as ShelleyGenesis does. This should be addressed in
the near future.

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -85,14 +85,17 @@ executable db-analyser
                      , optparse-applicative
                      , shelley-spec-ledger
                      , strict-containers
+                     , text
 
                      , ouroboros-consensus
                      , ouroboros-consensus-byron
                      , ouroboros-consensus-cardano
                      , ouroboros-consensus-shelley
                      , ouroboros-network
+                     , plutus-ledger-api
   other-modules:
                        Analysis
+                     , Block.Alonzo
                      , Block.Byron
                      , Block.Cardano
                      , Block.Shelley

ouroboros-consensus-cardano/tools/db-analyser/Block/Alonzo.hs

@@ -0,0 +1,89 @@
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns             #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Block.Alonzo () where
+
+import           Control.Applicative
+import qualified Data.Map.Strict as Map
+import           Data.Text (Text)
+import           Prelude
+
+import           Data.Aeson (FromJSON (..), (.:), (.:?))
+import qualified Data.Aeson as Aeson
+import           Data.Aeson.Types (FromJSONKey (..))
+
+import qualified Cardano.Ledger.Alonzo.Genesis as Alonzo
+import qualified Cardano.Ledger.Alonzo.Language as Alonzo
+import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
+import qualified Cardano.Ledger.BaseTypes as Ledger
+
+import           Plutus.V1.Ledger.Api (defaultCostModelParams)
+
+instance FromJSON Alonzo.AlonzoGenesis where
+  parseJSON = Aeson.withObject "Alonzo Genesis" $ \o -> do
+    coinsPerUTxOWord     <- o .:  "lovelacePerUTxOWord"
+                        <|> o .:  "adaPerUTxOWord"
+    cModels              <- o .:? "costModels"
+    prices               <- o .:  "executionPrices"
+    maxTxExUnits         <- o .:  "maxTxExUnits"
+    maxBlockExUnits      <- o .:  "maxBlockExUnits"
+    maxValSize           <- o .:  "maxValueSize"
+    collateralPercentage <- o .:  "collateralPercentage"
+    maxCollateralInputs  <- o .:  "maxCollateralInputs"
+    case cModels of
+      Nothing -> case Alonzo.CostModel <$> defaultCostModelParams of
+        Just m -> return Alonzo.AlonzoGenesis
+          { Alonzo.coinsPerUTxOWord
+          , Alonzo.costmdls = Map.singleton Alonzo.PlutusV1 m
+          , Alonzo.prices
+          , Alonzo.maxTxExUnits
+          , Alonzo.maxBlockExUnits
+          , Alonzo.maxValSize
+          , Alonzo.collateralPercentage
+          , Alonzo.maxCollateralInputs
+          }
+        Nothing -> fail "Failed to extract the cost model params from defaultCostModel"
+      Just costmdls -> return Alonzo.AlonzoGenesis
+        { Alonzo.coinsPerUTxOWord
+        , Alonzo.costmdls
+        , Alonzo.prices
+        , Alonzo.maxTxExUnits
+        , Alonzo.maxBlockExUnits
+        , Alonzo.maxValSize
+        , Alonzo.collateralPercentage
+        , Alonzo.maxCollateralInputs
+        }
+
+deriving instance FromJSON Alonzo.ExUnits
+
+instance FromJSON Alonzo.Language where
+  parseJSON = Aeson.withText "Language" languageFromText
+
+instance FromJSONKey Alonzo.Language where
+  fromJSONKey = Aeson.FromJSONKeyTextParser languageFromText
+
+instance FromJSON Alonzo.Prices where
+  parseJSON =
+    Aeson.withObject "prices" $ \o -> do
+      steps <- o .: "prSteps"
+      mem   <- o .: "prMem"
+      prSteps <- checkBoundedRational steps
+      prMem   <- checkBoundedRational mem
+      return Alonzo.Prices { Alonzo.prSteps, Alonzo.prMem }
+    where
+      -- We cannot round-trip via NonNegativeInterval, so we go via Rational
+      checkBoundedRational r =
+        case Ledger.boundRational r of
+          Nothing -> fail ("too much precision for bounded rational: " ++ show r)
+          Just s  -> return s
+
+deriving newtype instance FromJSON Alonzo.CostModel
+
+languageFromText :: MonadFail m => Text -> m Alonzo.Language
+languageFromText "PlutusV1" = pure Alonzo.PlutusV1
+languageFromText lang       = fail $ "Error decoding Language: " ++ show lang