{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Genesis (
  ConwayGenesis (..),
  toConwayGenesisPairs,
  cgDelegsL,
)
where

import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Conway.Era (ConwayEra)
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Conway.PParams (UpgradeConwayPParams, toUpgradeConwayPParamsUpdatePairs)
import Cardano.Ledger.Conway.TxCert (Delegatee)
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.DRep (DRepState)
import Cardano.Ledger.Genesis (EraGenesis (..))
import Cardano.Ledger.Keys (KeyRole (..))
import Data.Aeson (
  FromJSON (..),
  KeyValue (..),
  ToJSON (..),
  Value (..),
  object,
  pairs,
  withObject,
  (.!=),
  (.:),
  (.:?),
 )
import Data.Functor.Identity (Identity)
import Data.ListMap (ListMap)
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens)
import NoThunks.Class (NoThunks)

data ConwayGenesis = ConwayGenesis
  { ConwayGenesis -> UpgradeConwayPParams Identity
cgUpgradePParams :: !(UpgradeConwayPParams Identity)
  , ConwayGenesis -> Constitution ConwayEra
cgConstitution :: !(Constitution ConwayEra)
  , ConwayGenesis -> Committee ConwayEra
cgCommittee :: !(Committee ConwayEra)
  , ConwayGenesis -> ListMap (Credential 'Staking) Delegatee
cgDelegs :: ListMap (Credential 'Staking) Delegatee
  , ConwayGenesis -> ListMap (Credential 'DRepRole) DRepState
cgInitialDReps :: ListMap (Credential 'DRepRole) DRepState
  }
  deriving (ConwayGenesis -> ConwayGenesis -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConwayGenesis -> ConwayGenesis -> Bool
$c/= :: ConwayGenesis -> ConwayGenesis -> Bool
== :: ConwayGenesis -> ConwayGenesis -> Bool
$c== :: ConwayGenesis -> ConwayGenesis -> Bool
Eq, forall x. Rep ConwayGenesis x -> ConwayGenesis
forall x. ConwayGenesis -> Rep ConwayGenesis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConwayGenesis x -> ConwayGenesis
$cfrom :: forall x. ConwayGenesis -> Rep ConwayGenesis x
Generic, Int -> ConwayGenesis -> ShowS
[ConwayGenesis] -> ShowS
ConwayGenesis -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConwayGenesis] -> ShowS
$cshowList :: [ConwayGenesis] -> ShowS
show :: ConwayGenesis -> String
$cshow :: ConwayGenesis -> String
showsPrec :: Int -> ConwayGenesis -> ShowS
$cshowsPrec :: Int -> ConwayGenesis -> ShowS
Show)

cgDelegsL :: Lens' ConwayGenesis (ListMap (Credential 'Staking) Delegatee)
cgDelegsL :: Lens' ConwayGenesis (ListMap (Credential 'Staking) Delegatee)
cgDelegsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ConwayGenesis -> ListMap (Credential 'Staking) Delegatee
cgDelegs (\ConwayGenesis
x ListMap (Credential 'Staking) Delegatee
y -> ConwayGenesis
x {cgDelegs :: ListMap (Credential 'Staking) Delegatee
cgDelegs = ListMap (Credential 'Staking) Delegatee
y})

instance EraGenesis ConwayEra where
  type Genesis ConwayEra = ConwayGenesis

instance NoThunks ConwayGenesis

-- | Genesis are always encoded with the version of era they are defined in.
instance DecCBOR ConwayGenesis where
  decCBOR :: forall s. Decoder s ConwayGenesis
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$ forall t. t -> Decode ('Closed 'Dense) t
RecD UpgradeConwayPParams Identity
-> Constitution ConwayEra
-> Committee ConwayEra
-> ListMap (Credential 'Staking) Delegatee
-> ListMap (Credential 'DRepRole) DRepState
-> ConwayGenesis
ConwayGenesis forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From

instance EncCBOR ConwayGenesis where
  encCBOR :: ConwayGenesis -> Encoding
encCBOR (ConwayGenesis UpgradeConwayPParams Identity
pparams Constitution ConwayEra
constitution Committee ConwayEra
committee ListMap (Credential 'Staking) Delegatee
delegs ListMap (Credential 'DRepRole) DRepState
initialDReps) =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Encode ('Closed 'Dense) t
Rec UpgradeConwayPParams Identity
-> Constitution ConwayEra
-> Committee ConwayEra
-> ListMap (Credential 'Staking) Delegatee
-> ListMap (Credential 'DRepRole) DRepState
-> ConwayGenesis
ConwayGenesis
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To UpgradeConwayPParams Identity
pparams
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Constitution ConwayEra
constitution
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Committee ConwayEra
committee
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ListMap (Credential 'Staking) Delegatee
delegs
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ListMap (Credential 'DRepRole) DRepState
initialDReps

instance ToJSON ConwayGenesis where
  toJSON :: ConwayGenesis -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => ConwayGenesis -> [a]
toConwayGenesisPairs
  toEncoding :: ConwayGenesis -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. KeyValue e a => ConwayGenesis -> [a]
toConwayGenesisPairs

instance FromJSON ConwayGenesis where
  parseJSON :: Value -> Parser ConwayGenesis
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ConwayGenesis" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      UpgradeConwayPParams Identity
upgradeProtocolPParams <- forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
obj)
      UpgradeConwayPParams Identity
-> Constitution ConwayEra
-> Committee ConwayEra
-> ListMap (Credential 'Staking) Delegatee
-> ListMap (Credential 'DRepRole) DRepState
-> ConwayGenesis
ConwayGenesis
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure UpgradeConwayPParams Identity
upgradeProtocolPParams
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"constitution"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"committee"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"delegs" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"initialDReps" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty

toConwayGenesisPairs :: KeyValue e a => ConwayGenesis -> [a]
toConwayGenesisPairs :: forall e a. KeyValue e a => ConwayGenesis -> [a]
toConwayGenesisPairs cg :: ConwayGenesis
cg@(ConwayGenesis UpgradeConwayPParams Identity
_ Constitution ConwayEra
_ Committee ConwayEra
_ ListMap (Credential 'Staking) Delegatee
_ ListMap (Credential 'DRepRole) DRepState
_) =
  let ConwayGenesis {ListMap (Credential 'Staking) Delegatee
ListMap (Credential 'DRepRole) DRepState
Constitution ConwayEra
Committee ConwayEra
UpgradeConwayPParams Identity
cgInitialDReps :: ListMap (Credential 'DRepRole) DRepState
cgDelegs :: ListMap (Credential 'Staking) Delegatee
cgCommittee :: Committee ConwayEra
cgConstitution :: Constitution ConwayEra
cgUpgradePParams :: UpgradeConwayPParams Identity
cgInitialDReps :: ConwayGenesis -> ListMap (Credential 'DRepRole) DRepState
cgDelegs :: ConwayGenesis -> ListMap (Credential 'Staking) Delegatee
cgCommittee :: ConwayGenesis -> Committee ConwayEra
cgConstitution :: ConwayGenesis -> Constitution ConwayEra
cgUpgradePParams :: ConwayGenesis -> UpgradeConwayPParams Identity
..} = ConwayGenesis
cg
   in [ Key
"constitution" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Constitution ConwayEra
cgConstitution
      , Key
"committee" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Committee ConwayEra
cgCommittee
      ]
        forall a. [a] -> [a] -> [a]
++ [Key
"delegs" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ListMap (Credential 'Staking) Delegatee
cgDelegs | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null ListMap (Credential 'Staking) Delegatee
cgDelegs)]
        forall a. [a] -> [a] -> [a]
++ [Key
"initialDReps" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ListMap (Credential 'DRepRole) DRepState
cgInitialDReps | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null ListMap (Credential 'DRepRole) DRepState
cgInitialDReps)]
        forall a. [a] -> [a] -> [a]
++ forall e a. KeyValue e a => UpgradeConwayPParams Identity -> [a]
toUpgradeConwayPParamsUpdatePairs UpgradeConwayPParams Identity
cgUpgradePParams