{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Chain.Genesis.Data
  ( GenesisData (..),
    GenesisDataError (..),
    mainnetProtocolMagicId,
    readGenesisData,
  )
where

import Cardano.Binary
import Cardano.Chain.Common (BlockCount (..))
import Cardano.Chain.Genesis.AvvmBalances (GenesisAvvmBalances)
import Cardano.Chain.Genesis.Delegation (GenesisDelegation)
import Cardano.Chain.Genesis.Hash (GenesisHash (..))
import Cardano.Chain.Genesis.KeyHashes (GenesisKeyHashes)
import Cardano.Chain.Genesis.NonAvvmBalances (GenesisNonAvvmBalances)
import Cardano.Chain.Update.ProtocolParameters (ProtocolParameters)
import Cardano.Crypto
  ( ProtocolMagicId (..),
    hashRaw,
  )
import Cardano.Prelude
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.List (lookup)
import Data.Time (UTCTime)
import Formatting (bprint, build, stext)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))
import Text.JSON.Canonical
  ( FromJSON (..),
    Int54,
    JSValue (..),
    ToJSON (..),
    expected,
    fromJSField,
    fromJSObject,
    mkObject,
    parseCanonicalJSON,
    renderCanonicalJSON,
  )

-- | Genesis data contains all data which determines consensus rules. It must be
--   same for all nodes. It's used to initialize global state, slotting, etc.
data GenesisData = GenesisData
  { GenesisData -> GenesisKeyHashes
gdGenesisKeyHashes :: !GenesisKeyHashes,
    GenesisData -> GenesisDelegation
gdHeavyDelegation :: !GenesisDelegation,
    GenesisData -> UTCTime
gdStartTime :: !UTCTime,
    GenesisData -> GenesisNonAvvmBalances
gdNonAvvmBalances :: !GenesisNonAvvmBalances,
    GenesisData -> ProtocolParameters
gdProtocolParameters :: !ProtocolParameters,
    GenesisData -> BlockCount
gdK :: !BlockCount,
    GenesisData -> ProtocolMagicId
gdProtocolMagicId :: !ProtocolMagicId,
    GenesisData -> GenesisAvvmBalances
gdAvvmDistr :: !GenesisAvvmBalances
  }
  deriving (Int -> GenesisData -> ShowS
[GenesisData] -> ShowS
GenesisData -> String
(Int -> GenesisData -> ShowS)
-> (GenesisData -> String)
-> ([GenesisData] -> ShowS)
-> Show GenesisData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisData] -> ShowS
$cshowList :: [GenesisData] -> ShowS
show :: GenesisData -> String
$cshow :: GenesisData -> String
showsPrec :: Int -> GenesisData -> ShowS
$cshowsPrec :: Int -> GenesisData -> ShowS
Show, GenesisData -> GenesisData -> Bool
(GenesisData -> GenesisData -> Bool)
-> (GenesisData -> GenesisData -> Bool) -> Eq GenesisData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenesisData -> GenesisData -> Bool
$c/= :: GenesisData -> GenesisData -> Bool
== :: GenesisData -> GenesisData -> Bool
$c== :: GenesisData -> GenesisData -> Bool
Eq, (forall x. GenesisData -> Rep GenesisData x)
-> (forall x. Rep GenesisData x -> GenesisData)
-> Generic GenesisData
forall x. Rep GenesisData x -> GenesisData
forall x. GenesisData -> Rep GenesisData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GenesisData x -> GenesisData
$cfrom :: forall x. GenesisData -> Rep GenesisData x
Generic, Context -> GenesisData -> IO (Maybe ThunkInfo)
Proxy GenesisData -> String
(Context -> GenesisData -> IO (Maybe ThunkInfo))
-> (Context -> GenesisData -> IO (Maybe ThunkInfo))
-> (Proxy GenesisData -> String)
-> NoThunks GenesisData
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy GenesisData -> String
$cshowTypeOf :: Proxy GenesisData -> String
wNoThunks :: Context -> GenesisData -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenesisData -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenesisData -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> GenesisData -> IO (Maybe ThunkInfo)
NoThunks)

instance Monad m => ToJSON m GenesisData where
  toJSON :: GenesisData -> m JSValue
toJSON GenesisData
gd =
    [(JSString, m JSValue)] -> m JSValue
forall (m :: * -> *).
Monad m =>
[(JSString, m JSValue)] -> m JSValue
mkObject
      [ (JSString
"bootStakeholders", GenesisKeyHashes -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (GenesisKeyHashes -> m JSValue) -> GenesisKeyHashes -> m JSValue
forall a b. (a -> b) -> a -> b
$ GenesisData -> GenesisKeyHashes
gdGenesisKeyHashes GenesisData
gd),
        (JSString
"heavyDelegation", GenesisDelegation -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (GenesisDelegation -> m JSValue) -> GenesisDelegation -> m JSValue
forall a b. (a -> b) -> a -> b
$ GenesisData -> GenesisDelegation
gdHeavyDelegation GenesisData
gd),
        (JSString
"startTime", UTCTime -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (UTCTime -> m JSValue) -> UTCTime -> m JSValue
forall a b. (a -> b) -> a -> b
$ GenesisData -> UTCTime
gdStartTime GenesisData
gd),
        (JSString
"nonAvvmBalances", GenesisNonAvvmBalances -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (GenesisNonAvvmBalances -> m JSValue)
-> GenesisNonAvvmBalances -> m JSValue
forall a b. (a -> b) -> a -> b
$ GenesisData -> GenesisNonAvvmBalances
gdNonAvvmBalances GenesisData
gd),
        (JSString
"blockVersionData", ProtocolParameters -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (ProtocolParameters -> m JSValue)
-> ProtocolParameters -> m JSValue
forall a b. (a -> b) -> a -> b
$ GenesisData -> ProtocolParameters
gdProtocolParameters GenesisData
gd),
        --  The above is called blockVersionData for backwards compatibility with
        --  mainnet genesis block
        ( JSString
"protocolConsts",
          [(JSString, m JSValue)] -> m JSValue
forall (m :: * -> *).
Monad m =>
[(JSString, m JSValue)] -> m JSValue
mkObject
            [ (JSString
"k", JSValue -> m JSValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSValue -> m JSValue)
-> (BlockCount -> JSValue) -> BlockCount -> m JSValue
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int54 -> JSValue
JSNum (Int54 -> JSValue)
-> (BlockCount -> Int54) -> BlockCount -> JSValue
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Int54
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int54) -> (BlockCount -> Word64) -> BlockCount -> Int54
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockCount -> Word64
unBlockCount (BlockCount -> m JSValue) -> BlockCount -> m JSValue
forall a b. (a -> b) -> a -> b
$ GenesisData -> BlockCount
gdK GenesisData
gd),
              (JSString
"protocolMagic", ProtocolMagicId -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (ProtocolMagicId -> m JSValue) -> ProtocolMagicId -> m JSValue
forall a b. (a -> b) -> a -> b
$ GenesisData -> ProtocolMagicId
gdProtocolMagicId GenesisData
gd)
            ]
        ),
        (JSString
"avvmDistr", GenesisAvvmBalances -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (GenesisAvvmBalances -> m JSValue)
-> GenesisAvvmBalances -> m JSValue
forall a b. (a -> b) -> a -> b
$ GenesisData -> GenesisAvvmBalances
gdAvvmDistr GenesisData
gd)
      ]

instance MonadError SchemaError m => FromJSON m GenesisData where
  fromJSON :: JSValue -> m GenesisData
fromJSON JSValue
obj = do
    [(JSString, JSValue)]
objAssoc <- JSValue -> m [(JSString, JSValue)]
forall (m :: * -> *).
ReportSchemaErrors m =>
JSValue -> m [(JSString, JSValue)]
fromJSObject JSValue
obj
    JSValue
protocolConsts <- case JSString -> [(JSString, JSValue)] -> Maybe JSValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup JSString
"protocolConsts" [(JSString, JSValue)]
objAssoc of
      Just JSValue
fld -> JSValue -> m JSValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSValue
fld
      Maybe JSValue
Nothing -> String -> Maybe String -> m JSValue
forall (m :: * -> *) a.
ReportSchemaErrors m =>
String -> Maybe String -> m a
expected String
"field protocolConsts" Maybe String
forall a. Maybe a
Nothing

    GenesisKeyHashes
-> GenesisDelegation
-> UTCTime
-> GenesisNonAvvmBalances
-> ProtocolParameters
-> BlockCount
-> ProtocolMagicId
-> GenesisAvvmBalances
-> GenesisData
GenesisData
      (GenesisKeyHashes
 -> GenesisDelegation
 -> UTCTime
 -> GenesisNonAvvmBalances
 -> ProtocolParameters
 -> BlockCount
 -> ProtocolMagicId
 -> GenesisAvvmBalances
 -> GenesisData)
-> m GenesisKeyHashes
-> m (GenesisDelegation
      -> UTCTime
      -> GenesisNonAvvmBalances
      -> ProtocolParameters
      -> BlockCount
      -> ProtocolMagicId
      -> GenesisAvvmBalances
      -> GenesisData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> JSString -> m GenesisKeyHashes
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"bootStakeholders"
      m (GenesisDelegation
   -> UTCTime
   -> GenesisNonAvvmBalances
   -> ProtocolParameters
   -> BlockCount
   -> ProtocolMagicId
   -> GenesisAvvmBalances
   -> GenesisData)
-> m GenesisDelegation
-> m (UTCTime
      -> GenesisNonAvvmBalances
      -> ProtocolParameters
      -> BlockCount
      -> ProtocolMagicId
      -> GenesisAvvmBalances
      -> GenesisData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue -> JSString -> m GenesisDelegation
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"heavyDelegation"
      m (UTCTime
   -> GenesisNonAvvmBalances
   -> ProtocolParameters
   -> BlockCount
   -> ProtocolMagicId
   -> GenesisAvvmBalances
   -> GenesisData)
-> m UTCTime
-> m (GenesisNonAvvmBalances
      -> ProtocolParameters
      -> BlockCount
      -> ProtocolMagicId
      -> GenesisAvvmBalances
      -> GenesisData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue -> JSString -> m UTCTime
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"startTime"
      m (GenesisNonAvvmBalances
   -> ProtocolParameters
   -> BlockCount
   -> ProtocolMagicId
   -> GenesisAvvmBalances
   -> GenesisData)
-> m GenesisNonAvvmBalances
-> m (ProtocolParameters
      -> BlockCount
      -> ProtocolMagicId
      -> GenesisAvvmBalances
      -> GenesisData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue -> JSString -> m GenesisNonAvvmBalances
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"nonAvvmBalances"
      m (ProtocolParameters
   -> BlockCount
   -> ProtocolMagicId
   -> GenesisAvvmBalances
   -> GenesisData)
-> m ProtocolParameters
-> m (BlockCount
      -> ProtocolMagicId -> GenesisAvvmBalances -> GenesisData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue -> JSString -> m ProtocolParameters
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"blockVersionData"
      -- The above is called blockVersionData for backwards compatibility with
      -- mainnet genesis block
      m (BlockCount
   -> ProtocolMagicId -> GenesisAvvmBalances -> GenesisData)
-> m BlockCount
-> m (ProtocolMagicId -> GenesisAvvmBalances -> GenesisData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> BlockCount
BlockCount (Word64 -> BlockCount) -> (Int54 -> Word64) -> Int54 -> BlockCount
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b. (Integral Int54, Num b) => Int54 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int54 (Int54 -> BlockCount) -> m Int54 -> m BlockCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> JSString -> m Int54
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
protocolConsts JSString
"k")
      m (ProtocolMagicId -> GenesisAvvmBalances -> GenesisData)
-> m ProtocolMagicId -> m (GenesisAvvmBalances -> GenesisData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word32 -> ProtocolMagicId
ProtocolMagicId (Word32 -> ProtocolMagicId) -> m Word32 -> m ProtocolMagicId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> JSString -> m Word32
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
protocolConsts JSString
"protocolMagic")
      m (GenesisAvvmBalances -> GenesisData)
-> m GenesisAvvmBalances -> m GenesisData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue -> JSString -> m GenesisAvvmBalances
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> JSString -> m a
fromJSField JSValue
obj JSString
"avvmDistr"

data GenesisDataError
  = GenesisDataParseError Text
  | GenesisDataSchemaError SchemaError
  | GenesisDataIOError IOException
  deriving (Int -> GenesisDataError -> ShowS
[GenesisDataError] -> ShowS
GenesisDataError -> String
(Int -> GenesisDataError -> ShowS)
-> (GenesisDataError -> String)
-> ([GenesisDataError] -> ShowS)
-> Show GenesisDataError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisDataError] -> ShowS
$cshowList :: [GenesisDataError] -> ShowS
show :: GenesisDataError -> String
$cshow :: GenesisDataError -> String
showsPrec :: Int -> GenesisDataError -> ShowS
$cshowsPrec :: Int -> GenesisDataError -> ShowS
Show)

instance B.Buildable GenesisDataError where
  build :: GenesisDataError -> Builder
build = \case
    GenesisDataParseError Text
err ->
      Format Builder (Text -> Builder) -> Text -> Builder
forall a. Format Builder a -> a
bprint (Format (Text -> Builder) (Text -> Builder)
"Failed to parse GenesisData.\n Error: " Format (Text -> Builder) (Text -> Builder)
-> Format Builder (Text -> Builder)
-> Format Builder (Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Text -> Builder)
forall r. Format r (Text -> r)
stext) Text
err
    GenesisDataSchemaError SchemaError
err ->
      Format Builder (SchemaError -> Builder) -> SchemaError -> Builder
forall a. Format Builder a -> a
bprint (Format (SchemaError -> Builder) (SchemaError -> Builder)
"Incorrect schema for GenesisData.\n Error: " Format (SchemaError -> Builder) (SchemaError -> Builder)
-> Format Builder (SchemaError -> Builder)
-> Format Builder (SchemaError -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (SchemaError -> Builder)
forall a r. Buildable a => Format r (a -> r)
build) SchemaError
err
    GenesisDataIOError IOException
err ->
      Format Builder (Text -> Builder) -> Text -> Builder
forall a. Format Builder a -> a
bprint
        (Format (Text -> Builder) (Text -> Builder)
"Failed with " Format (Text -> Builder) (Text -> Builder)
-> Format Builder (Text -> Builder)
-> Format Builder (Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Text -> Builder)
forall r. Format r (Text -> r)
stext Format Builder (Text -> Builder)
-> Format Builder Builder -> Format Builder (Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
" when tried to read GenesisData file")
        (IOException -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show IOException
err)

instance ToCBOR GenesisData where
  toCBOR :: GenesisData -> Encoding
toCBOR
    ( GenesisData
        GenesisKeyHashes
gdGenesisKeyHashes_
        GenesisDelegation
gdHeavyDelegation_
        UTCTime
gdStartTime_
        GenesisNonAvvmBalances
gdNonAvvmBalances_
        ProtocolParameters
gdProtocolParameters_
        BlockCount
gdK_
        ProtocolMagicId
gdProtocolMagicId_
        GenesisAvvmBalances
gdAvvmDistr_
      ) =
      [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
        [ Word -> Encoding
encodeListLen Word
8,
          GenesisKeyHashes -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @GenesisKeyHashes GenesisKeyHashes
gdGenesisKeyHashes_,
          GenesisDelegation -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @GenesisDelegation GenesisDelegation
gdHeavyDelegation_,
          UTCTime -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR {- @UTCTime -} UTCTime
gdStartTime_,
          GenesisNonAvvmBalances -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @GenesisNonAvvmBalances GenesisNonAvvmBalances
gdNonAvvmBalances_,
          ProtocolParameters -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @ProtocolParameters ProtocolParameters
gdProtocolParameters_,
          BlockCount -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @BlockCount BlockCount
gdK_,
          ProtocolMagicId -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @ProtocolMagicId ProtocolMagicId
gdProtocolMagicId_,
          GenesisAvvmBalances -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @GenesisAvvmBalances GenesisAvvmBalances
gdAvvmDistr_
        ]

instance FromCBOR GenesisData where
  fromCBOR :: Decoder s GenesisData
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"GenesisData" Int
8
    GenesisKeyHashes
-> GenesisDelegation
-> UTCTime
-> GenesisNonAvvmBalances
-> ProtocolParameters
-> BlockCount
-> ProtocolMagicId
-> GenesisAvvmBalances
-> GenesisData
GenesisData
      (GenesisKeyHashes
 -> GenesisDelegation
 -> UTCTime
 -> GenesisNonAvvmBalances
 -> ProtocolParameters
 -> BlockCount
 -> ProtocolMagicId
 -> GenesisAvvmBalances
 -> GenesisData)
-> Decoder s GenesisKeyHashes
-> Decoder
     s
     (GenesisDelegation
      -> UTCTime
      -> GenesisNonAvvmBalances
      -> ProtocolParameters
      -> BlockCount
      -> ProtocolMagicId
      -> GenesisAvvmBalances
      -> GenesisData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. FromCBOR GenesisKeyHashes => Decoder s GenesisKeyHashes
forall a s. FromCBOR a => Decoder s a
fromCBOR @GenesisKeyHashes
      Decoder
  s
  (GenesisDelegation
   -> UTCTime
   -> GenesisNonAvvmBalances
   -> ProtocolParameters
   -> BlockCount
   -> ProtocolMagicId
   -> GenesisAvvmBalances
   -> GenesisData)
-> Decoder s GenesisDelegation
-> Decoder
     s
     (UTCTime
      -> GenesisNonAvvmBalances
      -> ProtocolParameters
      -> BlockCount
      -> ProtocolMagicId
      -> GenesisAvvmBalances
      -> GenesisData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. FromCBOR GenesisDelegation => Decoder s GenesisDelegation
forall a s. FromCBOR a => Decoder s a
fromCBOR @GenesisDelegation
      Decoder
  s
  (UTCTime
   -> GenesisNonAvvmBalances
   -> ProtocolParameters
   -> BlockCount
   -> ProtocolMagicId
   -> GenesisAvvmBalances
   -> GenesisData)
-> Decoder s UTCTime
-> Decoder
     s
     (GenesisNonAvvmBalances
      -> ProtocolParameters
      -> BlockCount
      -> ProtocolMagicId
      -> GenesisAvvmBalances
      -> GenesisData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s UTCTime
forall a s. FromCBOR a => Decoder s a
fromCBOR -- @UTCTime
      Decoder
  s
  (GenesisNonAvvmBalances
   -> ProtocolParameters
   -> BlockCount
   -> ProtocolMagicId
   -> GenesisAvvmBalances
   -> GenesisData)
-> Decoder s GenesisNonAvvmBalances
-> Decoder
     s
     (ProtocolParameters
      -> BlockCount
      -> ProtocolMagicId
      -> GenesisAvvmBalances
      -> GenesisData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s.
FromCBOR GenesisNonAvvmBalances =>
Decoder s GenesisNonAvvmBalances
forall a s. FromCBOR a => Decoder s a
fromCBOR @GenesisNonAvvmBalances
      Decoder
  s
  (ProtocolParameters
   -> BlockCount
   -> ProtocolMagicId
   -> GenesisAvvmBalances
   -> GenesisData)
-> Decoder s ProtocolParameters
-> Decoder
     s
     (BlockCount
      -> ProtocolMagicId -> GenesisAvvmBalances -> GenesisData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s.
FromCBOR ProtocolParameters =>
Decoder s ProtocolParameters
forall a s. FromCBOR a => Decoder s a
fromCBOR @ProtocolParameters
      Decoder
  s
  (BlockCount
   -> ProtocolMagicId -> GenesisAvvmBalances -> GenesisData)
-> Decoder s BlockCount
-> Decoder
     s (ProtocolMagicId -> GenesisAvvmBalances -> GenesisData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. FromCBOR BlockCount => Decoder s BlockCount
forall a s. FromCBOR a => Decoder s a
fromCBOR @BlockCount
      Decoder s (ProtocolMagicId -> GenesisAvvmBalances -> GenesisData)
-> Decoder s ProtocolMagicId
-> Decoder s (GenesisAvvmBalances -> GenesisData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. FromCBOR ProtocolMagicId => Decoder s ProtocolMagicId
forall a s. FromCBOR a => Decoder s a
fromCBOR @ProtocolMagicId
      Decoder s (GenesisAvvmBalances -> GenesisData)
-> Decoder s GenesisAvvmBalances -> Decoder s GenesisData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s.
FromCBOR GenesisAvvmBalances =>
Decoder s GenesisAvvmBalances
forall a s. FromCBOR a => Decoder s a
fromCBOR @GenesisAvvmBalances

-- | Parse @GenesisData@ from a JSON file and annotate with Canonical JSON hash
readGenesisData ::
  (MonadError GenesisDataError m, MonadIO m) =>
  FilePath ->
  m (GenesisData, GenesisHash)
readGenesisData :: String -> m (GenesisData, GenesisHash)
readGenesisData String
fp = do
  ByteString
bytes <-
    IO (Either IOException ByteString)
-> m (Either IOException ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> IO (Either IOException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
fp)
      m (Either IOException ByteString)
-> (Either IOException ByteString -> m ByteString) -> m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either IOException ByteString
-> (IOException -> GenesisDataError) -> m ByteString
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` IOException -> GenesisDataError
GenesisDataIOError)

  JSValue
genesisDataJSON <-
    ByteString -> Either String JSValue
parseCanonicalJSON ByteString
bytes Either String JSValue -> (String -> GenesisDataError) -> m JSValue
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` Text -> GenesisDataError
GenesisDataParseError (Text -> GenesisDataError)
-> (String -> Text) -> String -> GenesisDataError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a b. ConvertText a b => a -> b
toS

  GenesisData
genesisData <- JSValue -> Either SchemaError GenesisData
forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
genesisDataJSON Either SchemaError GenesisData
-> (SchemaError -> GenesisDataError) -> m GenesisData
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` SchemaError -> GenesisDataError
GenesisDataSchemaError

  let genesisHash :: GenesisHash
genesisHash = Hash Raw -> GenesisHash
GenesisHash (Hash Raw -> GenesisHash) -> Hash Raw -> GenesisHash
forall a b. (a -> b) -> a -> b
$ ByteString -> Hash Raw
hashRaw (JSValue -> ByteString
renderCanonicalJSON JSValue
genesisDataJSON)

  (GenesisData, GenesisHash) -> m (GenesisData, GenesisHash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenesisData
genesisData, GenesisHash
genesisHash)

mainnetProtocolMagicId :: ProtocolMagicId
mainnetProtocolMagicId :: ProtocolMagicId
mainnetProtocolMagicId = Word32 -> ProtocolMagicId
ProtocolMagicId Word32
764824073