{-# 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.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.Ledger.Binary
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
$cshowsPrec :: Int -> GenesisData -> ShowS
showsPrec :: Int -> GenesisData -> ShowS
$cshow :: GenesisData -> String
show :: GenesisData -> String
$cshowList :: [GenesisData] -> ShowS
showList :: [GenesisData] -> ShowS
Show, GenesisData -> GenesisData -> Bool
(GenesisData -> GenesisData -> Bool)
-> (GenesisData -> GenesisData -> Bool) -> Eq GenesisData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenesisData -> GenesisData -> Bool
== :: GenesisData -> GenesisData -> Bool
$c/= :: GenesisData -> GenesisData -> Bool
/= :: 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
$cfrom :: forall x. GenesisData -> Rep GenesisData x
from :: forall x. GenesisData -> Rep GenesisData x
$cto :: forall x. Rep GenesisData x -> GenesisData
to :: forall x. Rep GenesisData x -> GenesisData
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
$cnoThunks :: Context -> GenesisData -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenesisData -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenesisData -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> GenesisData -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy GenesisData -> String
showTypeOf :: Proxy GenesisData -> String
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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSValue -> m JSValue)
-> (BlockCount -> JSValue) -> BlockCount -> m JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSValue
fld
      Maybe JSValue
Nothing -> String -> Maybe String -> m JSValue
forall a. String -> Maybe String -> m a
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 a b. m (a -> b) -> m a -> m b
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 a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UTCTime -> UTCTime
forall a. NFData a => a -> a
force (UTCTime -> UTCTime) -> m UTCTime -> m UTCTime
forall (f :: * -> *) a b. Functor 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 a b. m (a -> b) -> m a -> m b
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 a b. m (a -> b) -> m a -> m b
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 a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> BlockCount
BlockCount (Word64 -> BlockCount) -> (Int54 -> Word64) -> Int54 -> BlockCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 a b. m (a -> b) -> m a -> m b
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 a b. m (a -> b) -> m a -> m b
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
$cshowsPrec :: Int -> GenesisDataError -> ShowS
showsPrec :: Int -> GenesisDataError -> ShowS
$cshow :: GenesisDataError -> String
show :: GenesisDataError -> String
$cshowList :: [GenesisDataError] -> ShowS
showList :: [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 b c a. Format b c -> Format a b -> Format a c
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 b c a. Format b c -> Format a b -> Format a c
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 b c a. Format b c -> Format a b -> Format a c
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 b c a. Format b c -> Format a b -> Format a c
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 -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR GenesisData where
  fromCBOR :: forall s. Decoder s GenesisData
fromCBOR = Decoder s GenesisData
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR GenesisData where
  encCBOR :: GenesisData -> Encoding
encCBOR
    ( 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
        , forall a. EncCBOR a => a -> Encoding
encCBOR @GenesisKeyHashes GenesisKeyHashes
gdGenesisKeyHashes_
        , forall a. EncCBOR a => a -> Encoding
encCBOR @GenesisDelegation GenesisDelegation
gdHeavyDelegation_
        , UTCTime -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR {- @UTCTime -} UTCTime
gdStartTime_
        , forall a. EncCBOR a => a -> Encoding
encCBOR @GenesisNonAvvmBalances GenesisNonAvvmBalances
gdNonAvvmBalances_
        , forall a. EncCBOR a => a -> Encoding
encCBOR @ProtocolParameters ProtocolParameters
gdProtocolParameters_
        , forall a. EncCBOR a => a -> Encoding
encCBOR @BlockCount BlockCount
gdK_
        , forall a. EncCBOR a => a -> Encoding
encCBOR @ProtocolMagicId ProtocolMagicId
gdProtocolMagicId_
        , forall a. EncCBOR a => a -> Encoding
encCBOR @GenesisAvvmBalances GenesisAvvmBalances
gdAvvmDistr_
        ]

instance DecCBOR GenesisData where
  decCBOR :: forall s. Decoder s GenesisData
decCBOR = 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 a s. DecCBOR a => Decoder s a
decCBOR @GenesisKeyHashes
      Decoder
  s
  (GenesisDelegation
   -> UTCTime
   -> GenesisNonAvvmBalances
   -> ProtocolParameters
   -> BlockCount
   -> ProtocolMagicId
   -> GenesisAvvmBalances
   -> GenesisData)
-> Decoder s GenesisDelegation
-> Decoder
     s
     (UTCTime
      -> GenesisNonAvvmBalances
      -> ProtocolParameters
      -> BlockCount
      -> ProtocolMagicId
      -> GenesisAvvmBalances
      -> GenesisData)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR @GenesisDelegation
      Decoder
  s
  (UTCTime
   -> GenesisNonAvvmBalances
   -> ProtocolParameters
   -> BlockCount
   -> ProtocolMagicId
   -> GenesisAvvmBalances
   -> GenesisData)
-> Decoder s UTCTime
-> Decoder
     s
     (GenesisNonAvvmBalances
      -> ProtocolParameters
      -> BlockCount
      -> ProtocolMagicId
      -> GenesisAvvmBalances
      -> GenesisData)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s UTCTime
forall s. Decoder s UTCTime
forall a s. DecCBOR a => Decoder s a
decCBOR -- @UTCTime
      Decoder
  s
  (GenesisNonAvvmBalances
   -> ProtocolParameters
   -> BlockCount
   -> ProtocolMagicId
   -> GenesisAvvmBalances
   -> GenesisData)
-> Decoder s GenesisNonAvvmBalances
-> Decoder
     s
     (ProtocolParameters
      -> BlockCount
      -> ProtocolMagicId
      -> GenesisAvvmBalances
      -> GenesisData)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR @GenesisNonAvvmBalances
      Decoder
  s
  (ProtocolParameters
   -> BlockCount
   -> ProtocolMagicId
   -> GenesisAvvmBalances
   -> GenesisData)
-> Decoder s ProtocolParameters
-> Decoder
     s
     (BlockCount
      -> ProtocolMagicId -> GenesisAvvmBalances -> GenesisData)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR @ProtocolParameters
      Decoder
  s
  (BlockCount
   -> ProtocolMagicId -> GenesisAvvmBalances -> GenesisData)
-> Decoder s BlockCount
-> Decoder
     s (ProtocolMagicId -> GenesisAvvmBalances -> GenesisData)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR @BlockCount
      Decoder s (ProtocolMagicId -> GenesisAvvmBalances -> GenesisData)
-> Decoder s ProtocolMagicId
-> Decoder s (GenesisAvvmBalances -> GenesisData)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR @ProtocolMagicId
      Decoder s (GenesisAvvmBalances -> GenesisData)
-> Decoder s GenesisAvvmBalances -> Decoder s GenesisData
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR @GenesisAvvmBalances

-- | Parse @GenesisData@ from a JSON file and annotate with Canonical JSON hash
readGenesisData ::
  (MonadError GenesisDataError m, MonadIO m) =>
  FilePath ->
  m (GenesisData, GenesisHash)
readGenesisData :: forall (m :: * -> *).
(MonadError GenesisDataError m, MonadIO m) =>
String -> m (GenesisData, GenesisHash)
readGenesisData String
fp = do
  ByteString
bytes <-
    IO (Either IOException ByteString)
-> m (Either IOException ByteString)
forall a. IO a -> m a
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 a b. m a -> (a -> m b) -> m b
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenesisData
genesisData, GenesisHash
genesisHash)

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