{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-missed-specialisations #-}

module Cardano.Chain.Genesis.KeyHashes
  ( GenesisKeyHashes (..),
  )
where

import Cardano.Binary
import Cardano.Chain.Common (KeyHash)
import Cardano.Prelude
import qualified Data.Map.Strict as M
import qualified Data.Set as Set
import Formatting (bprint)
import Formatting.Buildable (Buildable (..))
import NoThunks.Class (NoThunks (..))
import Text.JSON.Canonical (FromJSON (..), ToJSON (..))

-- | The set of genesis keys, who are able to produce blocks and submit votes
--   and proposals in the Byron era
newtype GenesisKeyHashes = GenesisKeyHashes
  { GenesisKeyHashes -> Set KeyHash
unGenesisKeyHashes :: Set KeyHash
  }
  deriving (Int -> GenesisKeyHashes -> ShowS
[GenesisKeyHashes] -> ShowS
GenesisKeyHashes -> String
(Int -> GenesisKeyHashes -> ShowS)
-> (GenesisKeyHashes -> String)
-> ([GenesisKeyHashes] -> ShowS)
-> Show GenesisKeyHashes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisKeyHashes] -> ShowS
$cshowList :: [GenesisKeyHashes] -> ShowS
show :: GenesisKeyHashes -> String
$cshow :: GenesisKeyHashes -> String
showsPrec :: Int -> GenesisKeyHashes -> ShowS
$cshowsPrec :: Int -> GenesisKeyHashes -> ShowS
Show, GenesisKeyHashes -> GenesisKeyHashes -> Bool
(GenesisKeyHashes -> GenesisKeyHashes -> Bool)
-> (GenesisKeyHashes -> GenesisKeyHashes -> Bool)
-> Eq GenesisKeyHashes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenesisKeyHashes -> GenesisKeyHashes -> Bool
$c/= :: GenesisKeyHashes -> GenesisKeyHashes -> Bool
== :: GenesisKeyHashes -> GenesisKeyHashes -> Bool
$c== :: GenesisKeyHashes -> GenesisKeyHashes -> Bool
Eq, b -> GenesisKeyHashes -> GenesisKeyHashes
NonEmpty GenesisKeyHashes -> GenesisKeyHashes
GenesisKeyHashes -> GenesisKeyHashes -> GenesisKeyHashes
(GenesisKeyHashes -> GenesisKeyHashes -> GenesisKeyHashes)
-> (NonEmpty GenesisKeyHashes -> GenesisKeyHashes)
-> (forall b.
    Integral b =>
    b -> GenesisKeyHashes -> GenesisKeyHashes)
-> Semigroup GenesisKeyHashes
forall b. Integral b => b -> GenesisKeyHashes -> GenesisKeyHashes
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> GenesisKeyHashes -> GenesisKeyHashes
$cstimes :: forall b. Integral b => b -> GenesisKeyHashes -> GenesisKeyHashes
sconcat :: NonEmpty GenesisKeyHashes -> GenesisKeyHashes
$csconcat :: NonEmpty GenesisKeyHashes -> GenesisKeyHashes
<> :: GenesisKeyHashes -> GenesisKeyHashes -> GenesisKeyHashes
$c<> :: GenesisKeyHashes -> GenesisKeyHashes -> GenesisKeyHashes
Semigroup, Semigroup GenesisKeyHashes
GenesisKeyHashes
Semigroup GenesisKeyHashes
-> GenesisKeyHashes
-> (GenesisKeyHashes -> GenesisKeyHashes -> GenesisKeyHashes)
-> ([GenesisKeyHashes] -> GenesisKeyHashes)
-> Monoid GenesisKeyHashes
[GenesisKeyHashes] -> GenesisKeyHashes
GenesisKeyHashes -> GenesisKeyHashes -> GenesisKeyHashes
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [GenesisKeyHashes] -> GenesisKeyHashes
$cmconcat :: [GenesisKeyHashes] -> GenesisKeyHashes
mappend :: GenesisKeyHashes -> GenesisKeyHashes -> GenesisKeyHashes
$cmappend :: GenesisKeyHashes -> GenesisKeyHashes -> GenesisKeyHashes
mempty :: GenesisKeyHashes
$cmempty :: GenesisKeyHashes
$cp1Monoid :: Semigroup GenesisKeyHashes
Monoid, Context -> GenesisKeyHashes -> IO (Maybe ThunkInfo)
Proxy GenesisKeyHashes -> String
(Context -> GenesisKeyHashes -> IO (Maybe ThunkInfo))
-> (Context -> GenesisKeyHashes -> IO (Maybe ThunkInfo))
-> (Proxy GenesisKeyHashes -> String)
-> NoThunks GenesisKeyHashes
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy GenesisKeyHashes -> String
$cshowTypeOf :: Proxy GenesisKeyHashes -> String
wNoThunks :: Context -> GenesisKeyHashes -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenesisKeyHashes -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenesisKeyHashes -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> GenesisKeyHashes -> IO (Maybe ThunkInfo)
NoThunks)

instance Buildable GenesisKeyHashes where
  build :: GenesisKeyHashes -> Builder
build (GenesisKeyHashes Set KeyHash
m) =
    Format Builder ([KeyHash] -> Builder) -> [KeyHash] -> Builder
forall a. Format Builder a -> a
bprint (Format ([KeyHash] -> Builder) ([KeyHash] -> Builder)
"GenesisKeyHashes: " Format ([KeyHash] -> Builder) ([KeyHash] -> Builder)
-> Format Builder ([KeyHash] -> Builder)
-> Format Builder ([KeyHash] -> 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 ([KeyHash] -> Builder)
forall (t :: * -> *) a r.
(Foldable t, Buildable a) =>
Format r (t a -> r)
listJson) (Set KeyHash -> [KeyHash]
forall a. Set a -> [a]
Set.toList Set KeyHash
m)

instance Monad m => ToJSON m GenesisKeyHashes where
  toJSON :: GenesisKeyHashes -> m JSValue
toJSON (GenesisKeyHashes Set KeyHash
stks) =
    Map KeyHash Word16 -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON (Map KeyHash Word16 -> m JSValue)
-> ([(KeyHash, Word16)] -> Map KeyHash Word16)
-> [(KeyHash, Word16)]
-> m JSValue
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(KeyHash, Word16)] -> Map KeyHash Word16
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(KeyHash, Word16)] -> m JSValue)
-> [(KeyHash, Word16)] -> m JSValue
forall a b. (a -> b) -> a -> b
$ [KeyHash] -> [Word16] -> [(KeyHash, Word16)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set KeyHash -> [KeyHash]
forall a. Set a -> [a]
Set.toList Set KeyHash
stks) (Word16 -> [Word16]
forall a. a -> [a]
repeat (Word16
1 :: Word16))

instance MonadError SchemaError m => FromJSON m GenesisKeyHashes where
  fromJSON :: JSValue -> m GenesisKeyHashes
fromJSON =
    (Map KeyHash Word16 -> GenesisKeyHashes)
-> m (Map KeyHash Word16) -> m GenesisKeyHashes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set KeyHash -> GenesisKeyHashes
GenesisKeyHashes (Set KeyHash -> GenesisKeyHashes)
-> (Map KeyHash Word16 -> Set KeyHash)
-> Map KeyHash Word16
-> GenesisKeyHashes
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map KeyHash Word16 -> Set KeyHash
forall k a. Map k a -> Set k
M.keysSet) (m (Map KeyHash Word16) -> m GenesisKeyHashes)
-> (JSValue -> m (Map KeyHash Word16))
-> JSValue
-> m GenesisKeyHashes
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FromJSON m (Map KeyHash Word16) =>
JSValue -> m (Map KeyHash Word16)
forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON @m @(Map KeyHash Word16)

instance ToCBOR GenesisKeyHashes where
  toCBOR :: GenesisKeyHashes -> Encoding
toCBOR (GenesisKeyHashes Set KeyHash
gkh) = Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set KeyHash -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @(Set KeyHash) Set KeyHash
gkh

instance FromCBOR GenesisKeyHashes where
  fromCBOR :: Decoder s GenesisKeyHashes
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"GenesisKeyHashes" Int
1
    Set KeyHash -> GenesisKeyHashes
GenesisKeyHashes (Set KeyHash -> GenesisKeyHashes)
-> Decoder s (Set KeyHash) -> Decoder s GenesisKeyHashes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. FromCBOR (Set KeyHash) => Decoder s (Set KeyHash)
forall a s. FromCBOR a => Decoder s a
fromCBOR @(Set KeyHash)