{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}

module Cardano.Chain.Genesis.Hash (
  GenesisHash (..),
)
where

import Cardano.Crypto.Hashing (Hash)
import Cardano.Crypto.Raw (Raw)
import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
import Cardano.Prelude
import Data.Aeson (ToJSON)
import NoThunks.Class (NoThunks (..))

newtype GenesisHash = GenesisHash
  { GenesisHash -> Hash Raw
unGenesisHash :: Hash Raw
  }
  deriving (GenesisHash -> GenesisHash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenesisHash -> GenesisHash -> Bool
$c/= :: GenesisHash -> GenesisHash -> Bool
== :: GenesisHash -> GenesisHash -> Bool
$c== :: GenesisHash -> GenesisHash -> Bool
Eq, forall x. Rep GenesisHash x -> GenesisHash
forall x. GenesisHash -> Rep GenesisHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GenesisHash x -> GenesisHash
$cfrom :: forall x. GenesisHash -> Rep GenesisHash x
Generic, GenesisHash -> ()
forall a. (a -> ()) -> NFData a
rnf :: GenesisHash -> ()
$crnf :: GenesisHash -> ()
NFData, Typeable GenesisHash
Proxy GenesisHash -> Text
forall s. Decoder s GenesisHash
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy GenesisHash -> Decoder s ()
label :: Proxy GenesisHash -> Text
$clabel :: Proxy GenesisHash -> Text
dropCBOR :: forall s. Proxy GenesisHash -> Decoder s ()
$cdropCBOR :: forall s. Proxy GenesisHash -> Decoder s ()
decCBOR :: forall s. Decoder s GenesisHash
$cdecCBOR :: forall s. Decoder s GenesisHash
DecCBOR, Typeable GenesisHash
GenesisHash -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [GenesisHash] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy GenesisHash -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [GenesisHash] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [GenesisHash] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy GenesisHash -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy GenesisHash -> Size
encCBOR :: GenesisHash -> Encoding
$cencCBOR :: GenesisHash -> Encoding
EncCBOR, Context -> GenesisHash -> IO (Maybe ThunkInfo)
Proxy GenesisHash -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy GenesisHash -> String
$cshowTypeOf :: Proxy GenesisHash -> String
wNoThunks :: Context -> GenesisHash -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenesisHash -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenesisHash -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> GenesisHash -> IO (Maybe ThunkInfo)
NoThunks)

deriving instance Show GenesisHash

-- Used for debugging purposes only
instance ToJSON GenesisHash