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

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

instance Crypto c => EraGenesis (ConwayEra c) where
  type Genesis (ConwayEra c) = ConwayGenesis c

instance Crypto c => NoThunks (ConwayGenesis c)

-- | Genesis are always encoded with the version of era they are defined in.
instance Crypto c => DecCBOR (ConwayGenesis c) where
  decCBOR :: forall s. Decoder s (ConwayGenesis c)
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 forall c.
UpgradeConwayPParams Identity
-> Constitution (ConwayEra c)
-> Committee (ConwayEra c)
-> ListMap (Credential 'Staking c) (Delegatee c)
-> ListMap (Credential 'DRepRole c) (DRepState c)
-> ConwayGenesis c
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 Crypto c => EncCBOR (ConwayGenesis c) where
  encCBOR :: ConwayGenesis c -> Encoding
encCBOR (ConwayGenesis UpgradeConwayPParams Identity
pparams Constitution (ConwayEra c)
constitution Committee (ConwayEra c)
committee ListMap (Credential 'Staking c) (Delegatee c)
delegs ListMap (Credential 'DRepRole c) (DRepState c)
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 (forall c.
UpgradeConwayPParams Identity
-> Constitution (ConwayEra c)
-> Committee (ConwayEra c)
-> ListMap (Credential 'Staking c) (Delegatee c)
-> ListMap (Credential 'DRepRole c) (DRepState c)
-> ConwayGenesis c
ConwayGenesis @c)
        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 c)
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 c)
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 c) (Delegatee c)
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 c) (DRepState c)
initialDReps

instance Crypto c => ToJSON (ConwayGenesis c) where
  toJSON :: ConwayGenesis c -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c e a. (Crypto c, KeyValue e a) => ConwayGenesis c -> [a]
toConwayGenesisPairs
  toEncoding :: ConwayGenesis c -> 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 c e a. (Crypto c, KeyValue e a) => ConwayGenesis c -> [a]
toConwayGenesisPairs

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