{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.Hashes (
  -- * Hashing algorithms
  Hash.Hash,
  Hash.HashAlgorithm,
  HASH,
  ADDRHASH,

  -- * Era-independent hash type identifiers.

  -- | Various identifiers in the ledger are hashes of particular structures.
  -- While the structures may change from era to era, the hash will remain the
  -- same, and we can refer to the hash of, say, a transaction, without knowing
  -- the actual transaction type. As such, we define a number of these hashes
  -- here.
  -- $eraIndep
  EraIndependentTxBody,
  EraIndependentBlockHeader,
  EraIndependentBlockBody,
  EraIndependentMetadata,
  EraIndependentScript,
  EraIndependentData,
  EraIndependentScriptData,
  EraIndependentTxAuxData,
  EraIndependentPParamView,
  EraIndependentScriptIntegrity,

  -- * Hashes

  -- ** `@DSIGN@ Verification Key Hashes
  KeyHash (..),
  KeyRole (..),
  hashKey,
  hashTxBodySignature,

  -- ** Script Hashes
  ScriptHash (..),
  DataHash,

  -- ** AuxiliaryData
  TxAuxDataHash (..),

  -- ** @VRF@ Verification Key Hashes
  KeyRoleVRF (..),
  VRFVerKeyHash (..),
  toVRFVerKeyHash,
  fromVRFVerKeyHash,

  -- ** Genesis @DSIGN@ and @VRF@ Verification Key Hashes
  GenDelegPair (..),
  GenDelegs (..),

  -- * SafeHash
  -- $SAFEHASH
  SafeHash,
  SafeToHash (..),

  -- ** Creating SafeHash
  HashAnnotated,
  hashAnnotated,
  unsafeMakeSafeHash,

  -- ** Other operations
  castSafeHash,
  extractHash,
)
where

import qualified Cardano.Crypto.DSIGN as DSIGN
import qualified Cardano.Crypto.Hash as Hash
import qualified Cardano.Crypto.VRF as VRF
import Cardano.HeapWords (HeapWords (..))
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  decodeRecordNamed,
  encodeListLen,
 )
import Cardano.Ledger.Keys.Internal (DSIGN, HasKeyRole, KeyRole (..), VKey (..))
import Cardano.Ledger.Orphans ()
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..), ToJSONKey, (.:), (.=))
import qualified Data.Aeson as Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS (length)
import Data.ByteString.Short (ShortByteString, fromShort)
import qualified Data.ByteString.Short as SBS (length)
import Data.Default (Default (..))
import Data.Map.Strict (Map)
import Data.Typeable
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Quiet

-- | Hashing algorithm used for hashing everything, except addresses, for which `ADDRHASH`
-- is used.
type HASH = Hash.Blake2b_256

-- | Hashing algorithm used for hashing cryptographic keys and scripts. As the type
-- synonym name alludes, this is the hashing algorithm used for addresses.
type ADDRHASH = Hash.Blake2b_224

--   $eraIndep
--
--   Hashes carry around a phantom type parameter to identify the sort of thing
--   they are hashing. This is useful to allow us to distinguish, say, a place
--   where we expect the hash for a block from the hash for a script. However,
--   the exact structure that makes up a "block" will differ from era to era. We
--   still want to share the same namespace for the identifiers. Consequently we
--   define some era-independent indices here.

data EraIndependentTxBody

data EraIndependentBlockHeader

data EraIndependentBlockBody

data EraIndependentMetadata

data EraIndependentTxAuxData

data EraIndependentScript

data EraIndependentData

type DataHash = SafeHash EraIndependentData

data EraIndependentScriptData

data EraIndependentPParamView

data EraIndependentScriptIntegrity

--------------------------------------------------------------------------------
-- Key Hashes
--------------------------------------------------------------------------------

-- | Discriminated hash of public Key
newtype KeyHash (r :: KeyRole) = KeyHash
  {forall (r :: KeyRole).
KeyHash r -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
unKeyHash :: Hash.Hash ADDRHASH (DSIGN.VerKeyDSIGN DSIGN)}
  deriving (Int -> KeyHash r -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (r :: KeyRole). Int -> KeyHash r -> ShowS
forall (r :: KeyRole). [KeyHash r] -> ShowS
forall (r :: KeyRole). KeyHash r -> String
showList :: [KeyHash r] -> ShowS
$cshowList :: forall (r :: KeyRole). [KeyHash r] -> ShowS
show :: KeyHash r -> String
$cshow :: forall (r :: KeyRole). KeyHash r -> String
showsPrec :: Int -> KeyHash r -> ShowS
$cshowsPrec :: forall (r :: KeyRole). Int -> KeyHash r -> ShowS
Show, KeyHash r -> KeyHash r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (r :: KeyRole). KeyHash r -> KeyHash r -> Bool
/= :: KeyHash r -> KeyHash r -> Bool
$c/= :: forall (r :: KeyRole). KeyHash r -> KeyHash r -> Bool
== :: KeyHash r -> KeyHash r -> Bool
$c== :: forall (r :: KeyRole). KeyHash r -> KeyHash r -> Bool
Eq, KeyHash r -> KeyHash r -> Bool
KeyHash r -> KeyHash r -> Ordering
KeyHash r -> KeyHash r -> KeyHash r
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (r :: KeyRole). Eq (KeyHash r)
forall (r :: KeyRole). KeyHash r -> KeyHash r -> Bool
forall (r :: KeyRole). KeyHash r -> KeyHash r -> Ordering
forall (r :: KeyRole). KeyHash r -> KeyHash r -> KeyHash r
min :: KeyHash r -> KeyHash r -> KeyHash r
$cmin :: forall (r :: KeyRole). KeyHash r -> KeyHash r -> KeyHash r
max :: KeyHash r -> KeyHash r -> KeyHash r
$cmax :: forall (r :: KeyRole). KeyHash r -> KeyHash r -> KeyHash r
>= :: KeyHash r -> KeyHash r -> Bool
$c>= :: forall (r :: KeyRole). KeyHash r -> KeyHash r -> Bool
> :: KeyHash r -> KeyHash r -> Bool
$c> :: forall (r :: KeyRole). KeyHash r -> KeyHash r -> Bool
<= :: KeyHash r -> KeyHash r -> Bool
$c<= :: forall (r :: KeyRole). KeyHash r -> KeyHash r -> Bool
< :: KeyHash r -> KeyHash r -> Bool
$c< :: forall (r :: KeyRole). KeyHash r -> KeyHash r -> Bool
compare :: KeyHash r -> KeyHash r -> Ordering
$ccompare :: forall (r :: KeyRole). KeyHash r -> KeyHash r -> Ordering
Ord)
  deriving newtype
    ( KeyHash r -> ()
forall a. (a -> ()) -> NFData a
forall (r :: KeyRole). KeyHash r -> ()
rnf :: KeyHash r -> ()
$crnf :: forall (r :: KeyRole). KeyHash r -> ()
NFData
    , Context -> KeyHash r -> IO (Maybe ThunkInfo)
Proxy (KeyHash r) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (r :: KeyRole). Context -> KeyHash r -> IO (Maybe ThunkInfo)
forall (r :: KeyRole). Proxy (KeyHash r) -> String
showTypeOf :: Proxy (KeyHash r) -> String
$cshowTypeOf :: forall (r :: KeyRole). Proxy (KeyHash r) -> String
wNoThunks :: Context -> KeyHash r -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (r :: KeyRole). Context -> KeyHash r -> IO (Maybe ThunkInfo)
noThunks :: Context -> KeyHash r -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (r :: KeyRole). Context -> KeyHash r -> IO (Maybe ThunkInfo)
NoThunks
    , forall x. Rep (KeyHash r) x -> KeyHash r
forall x. KeyHash r -> Rep (KeyHash r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (r :: KeyRole) x. Rep (KeyHash r) x -> KeyHash r
forall (r :: KeyRole) x. KeyHash r -> Rep (KeyHash r) x
to :: forall x. Rep (KeyHash r) x -> KeyHash r
$cto :: forall (r :: KeyRole) x. Rep (KeyHash r) x -> KeyHash r
from :: forall x. KeyHash r -> Rep (KeyHash r) x
$cfrom :: forall (r :: KeyRole) x. KeyHash r -> Rep (KeyHash r) x
Generic
    , KeyHash r -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [KeyHash r] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (KeyHash r) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall {r :: KeyRole}. Typeable r => Typeable (KeyHash r)
forall (r :: KeyRole). Typeable r => KeyHash r -> Encoding
forall (r :: KeyRole).
Typeable r =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [KeyHash r] -> Size
forall (r :: KeyRole).
Typeable r =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (KeyHash r) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [KeyHash r] -> Size
$cencodedListSizeExpr :: forall (r :: KeyRole).
Typeable r =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [KeyHash r] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (KeyHash r) -> Size
$cencodedSizeExpr :: forall (r :: KeyRole).
Typeable r =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (KeyHash r) -> Size
toCBOR :: KeyHash r -> Encoding
$ctoCBOR :: forall (r :: KeyRole). Typeable r => KeyHash r -> Encoding
ToCBOR
    , Proxy (KeyHash r) -> Text
forall s. Decoder s (KeyHash r)
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall {r :: KeyRole}. Typeable r => Typeable (KeyHash r)
forall (r :: KeyRole). Typeable r => Proxy (KeyHash r) -> Text
forall (r :: KeyRole) s. Typeable r => Decoder s (KeyHash r)
label :: Proxy (KeyHash r) -> Text
$clabel :: forall (r :: KeyRole). Typeable r => Proxy (KeyHash r) -> Text
fromCBOR :: forall s. Decoder s (KeyHash r)
$cfromCBOR :: forall (r :: KeyRole) s. Typeable r => Decoder s (KeyHash r)
FromCBOR
    , KeyHash r -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [KeyHash r] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (KeyHash r) -> 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
forall {r :: KeyRole}. Typeable r => Typeable (KeyHash r)
forall (r :: KeyRole). Typeable r => KeyHash r -> Encoding
forall (r :: KeyRole).
Typeable r =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [KeyHash r] -> Size
forall (r :: KeyRole).
Typeable r =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (KeyHash r) -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [KeyHash r] -> Size
$cencodedListSizeExpr :: forall (r :: KeyRole).
Typeable r =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [KeyHash r] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (KeyHash r) -> Size
$cencodedSizeExpr :: forall (r :: KeyRole).
Typeable r =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (KeyHash r) -> Size
encCBOR :: KeyHash r -> Encoding
$cencCBOR :: forall (r :: KeyRole). Typeable r => KeyHash r -> Encoding
EncCBOR
    , Proxy (KeyHash r) -> Text
forall s. Decoder s (KeyHash r)
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (KeyHash r) -> Decoder s ()
forall {r :: KeyRole}. Typeable r => Typeable (KeyHash r)
forall (r :: KeyRole). Typeable r => Proxy (KeyHash r) -> Text
forall (r :: KeyRole) s. Typeable r => Decoder s (KeyHash r)
forall (r :: KeyRole) s.
Typeable r =>
Proxy (KeyHash r) -> Decoder s ()
label :: Proxy (KeyHash r) -> Text
$clabel :: forall (r :: KeyRole). Typeable r => Proxy (KeyHash r) -> Text
dropCBOR :: forall s. Proxy (KeyHash r) -> Decoder s ()
$cdropCBOR :: forall (r :: KeyRole) s.
Typeable r =>
Proxy (KeyHash r) -> Decoder s ()
decCBOR :: forall s. Decoder s (KeyHash r)
$cdecCBOR :: forall (r :: KeyRole) s. Typeable r => Decoder s (KeyHash r)
DecCBOR
    , ToJSONKeyFunction [KeyHash r]
ToJSONKeyFunction (KeyHash r)
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
forall (r :: KeyRole). ToJSONKeyFunction [KeyHash r]
forall (r :: KeyRole). ToJSONKeyFunction (KeyHash r)
toJSONKeyList :: ToJSONKeyFunction [KeyHash r]
$ctoJSONKeyList :: forall (r :: KeyRole). ToJSONKeyFunction [KeyHash r]
toJSONKey :: ToJSONKeyFunction (KeyHash r)
$ctoJSONKey :: forall (r :: KeyRole). ToJSONKeyFunction (KeyHash r)
ToJSONKey
    , FromJSONKeyFunction [KeyHash r]
FromJSONKeyFunction (KeyHash r)
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
forall (r :: KeyRole). FromJSONKeyFunction [KeyHash r]
forall (r :: KeyRole). FromJSONKeyFunction (KeyHash r)
fromJSONKeyList :: FromJSONKeyFunction [KeyHash r]
$cfromJSONKeyList :: forall (r :: KeyRole). FromJSONKeyFunction [KeyHash r]
fromJSONKey :: FromJSONKeyFunction (KeyHash r)
$cfromJSONKey :: forall (r :: KeyRole). FromJSONKeyFunction (KeyHash r)
FromJSONKey
    , [KeyHash r] -> Encoding
[KeyHash r] -> Value
KeyHash r -> Bool
KeyHash r -> Encoding
KeyHash r -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
forall (r :: KeyRole). [KeyHash r] -> Encoding
forall (r :: KeyRole). [KeyHash r] -> Value
forall (r :: KeyRole). KeyHash r -> Bool
forall (r :: KeyRole). KeyHash r -> Encoding
forall (r :: KeyRole). KeyHash r -> Value
omitField :: KeyHash r -> Bool
$comitField :: forall (r :: KeyRole). KeyHash r -> Bool
toEncodingList :: [KeyHash r] -> Encoding
$ctoEncodingList :: forall (r :: KeyRole). [KeyHash r] -> Encoding
toJSONList :: [KeyHash r] -> Value
$ctoJSONList :: forall (r :: KeyRole). [KeyHash r] -> Value
toEncoding :: KeyHash r -> Encoding
$ctoEncoding :: forall (r :: KeyRole). KeyHash r -> Encoding
toJSON :: KeyHash r -> Value
$ctoJSON :: forall (r :: KeyRole). KeyHash r -> Value
ToJSON
    , Maybe (KeyHash r)
Value -> Parser [KeyHash r]
Value -> Parser (KeyHash r)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
forall (r :: KeyRole). Maybe (KeyHash r)
forall (r :: KeyRole). Value -> Parser [KeyHash r]
forall (r :: KeyRole). Value -> Parser (KeyHash r)
omittedField :: Maybe (KeyHash r)
$comittedField :: forall (r :: KeyRole). Maybe (KeyHash r)
parseJSONList :: Value -> Parser [KeyHash r]
$cparseJSONList :: forall (r :: KeyRole). Value -> Parser [KeyHash r]
parseJSON :: Value -> Parser (KeyHash r)
$cparseJSON :: forall (r :: KeyRole). Value -> Parser (KeyHash r)
FromJSON
    , KeyHash r
forall a. a -> Default a
forall (r :: KeyRole). KeyHash r
def :: KeyHash r
$cdef :: forall (r :: KeyRole). KeyHash r
Default
    )

instance HasKeyRole KeyHash

-- | Hash a given public key
hashKey :: VKey kd -> KeyHash kd
hashKey :: forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey VerKeyDSIGN DSIGN
vk) = forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash forall a b. (a -> b) -> a -> b
$ forall v h.
(DSIGNAlgorithm v, HashAlgorithm h) =>
VerKeyDSIGN v -> Hash h (VerKeyDSIGN v)
DSIGN.hashVerKeyDSIGN VerKeyDSIGN DSIGN
vk

-- | Hash a given signature
hashTxBodySignature ::
  DSIGN.SignedDSIGN DSIGN (Hash.Hash HASH EraIndependentTxBody) ->
  Hash.Hash HASH (DSIGN.SignedDSIGN DSIGN (Hash.Hash HASH EraIndependentTxBody))
hashTxBodySignature :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> Hash HASH (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
hashTxBodySignature (DSIGN.SignedDSIGN SigDSIGN DSIGN
sigDSIGN) = forall h a b. Hash h a -> Hash h b
Hash.castHash forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
DSIGN.rawSerialiseSigDSIGN SigDSIGN DSIGN
sigDSIGN
{-# INLINE hashTxBodySignature #-}

--------------------------------------------------------------------------------
-- Script Hashes
--------------------------------------------------------------------------------

newtype ScriptHash
  = ScriptHash (Hash.Hash ADDRHASH EraIndependentScript)
  deriving (Int -> ScriptHash -> ShowS
[ScriptHash] -> ShowS
ScriptHash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptHash] -> ShowS
$cshowList :: [ScriptHash] -> ShowS
show :: ScriptHash -> String
$cshow :: ScriptHash -> String
showsPrec :: Int -> ScriptHash -> ShowS
$cshowsPrec :: Int -> ScriptHash -> ShowS
Show, ScriptHash -> ScriptHash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptHash -> ScriptHash -> Bool
$c/= :: ScriptHash -> ScriptHash -> Bool
== :: ScriptHash -> ScriptHash -> Bool
$c== :: ScriptHash -> ScriptHash -> Bool
Eq, Eq ScriptHash
ScriptHash -> ScriptHash -> Bool
ScriptHash -> ScriptHash -> Ordering
ScriptHash -> ScriptHash -> ScriptHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScriptHash -> ScriptHash -> ScriptHash
$cmin :: ScriptHash -> ScriptHash -> ScriptHash
max :: ScriptHash -> ScriptHash -> ScriptHash
$cmax :: ScriptHash -> ScriptHash -> ScriptHash
>= :: ScriptHash -> ScriptHash -> Bool
$c>= :: ScriptHash -> ScriptHash -> Bool
> :: ScriptHash -> ScriptHash -> Bool
$c> :: ScriptHash -> ScriptHash -> Bool
<= :: ScriptHash -> ScriptHash -> Bool
$c<= :: ScriptHash -> ScriptHash -> Bool
< :: ScriptHash -> ScriptHash -> Bool
$c< :: ScriptHash -> ScriptHash -> Bool
compare :: ScriptHash -> ScriptHash -> Ordering
$ccompare :: ScriptHash -> ScriptHash -> Ordering
Ord, forall x. Rep ScriptHash x -> ScriptHash
forall x. ScriptHash -> Rep ScriptHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScriptHash x -> ScriptHash
$cfrom :: forall x. ScriptHash -> Rep ScriptHash x
Generic)
  deriving newtype
    ( ScriptHash -> ()
forall a. (a -> ()) -> NFData a
rnf :: ScriptHash -> ()
$crnf :: ScriptHash -> ()
NFData
    , Context -> ScriptHash -> IO (Maybe ThunkInfo)
Proxy ScriptHash -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ScriptHash -> String
$cshowTypeOf :: Proxy ScriptHash -> String
wNoThunks :: Context -> ScriptHash -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ScriptHash -> IO (Maybe ThunkInfo)
noThunks :: Context -> ScriptHash -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ScriptHash -> IO (Maybe ThunkInfo)
NoThunks
    , Typeable ScriptHash
ScriptHash -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ScriptHash] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy ScriptHash -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ScriptHash] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ScriptHash] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy ScriptHash -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy ScriptHash -> Size
toCBOR :: ScriptHash -> Encoding
$ctoCBOR :: ScriptHash -> Encoding
ToCBOR
    , Typeable ScriptHash
Proxy ScriptHash -> Text
forall s. Decoder s ScriptHash
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy ScriptHash -> Text
$clabel :: Proxy ScriptHash -> Text
fromCBOR :: forall s. Decoder s ScriptHash
$cfromCBOR :: forall s. Decoder s ScriptHash
FromCBOR
    , Typeable ScriptHash
ScriptHash -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ScriptHash] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy ScriptHash -> 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 [ScriptHash] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ScriptHash] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy ScriptHash -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy ScriptHash -> Size
encCBOR :: ScriptHash -> Encoding
$cencCBOR :: ScriptHash -> Encoding
EncCBOR
    , Typeable ScriptHash
Proxy ScriptHash -> Text
forall s. Decoder s ScriptHash
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy ScriptHash -> Decoder s ()
label :: Proxy ScriptHash -> Text
$clabel :: Proxy ScriptHash -> Text
dropCBOR :: forall s. Proxy ScriptHash -> Decoder s ()
$cdropCBOR :: forall s. Proxy ScriptHash -> Decoder s ()
decCBOR :: forall s. Decoder s ScriptHash
$cdecCBOR :: forall s. Decoder s ScriptHash
DecCBOR
    , [ScriptHash] -> Encoding
[ScriptHash] -> Value
ScriptHash -> Bool
ScriptHash -> Encoding
ScriptHash -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: ScriptHash -> Bool
$comitField :: ScriptHash -> Bool
toEncodingList :: [ScriptHash] -> Encoding
$ctoEncodingList :: [ScriptHash] -> Encoding
toJSONList :: [ScriptHash] -> Value
$ctoJSONList :: [ScriptHash] -> Value
toEncoding :: ScriptHash -> Encoding
$ctoEncoding :: ScriptHash -> Encoding
toJSON :: ScriptHash -> Value
$ctoJSON :: ScriptHash -> Value
ToJSON
    , Maybe ScriptHash
Value -> Parser [ScriptHash]
Value -> Parser ScriptHash
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
omittedField :: Maybe ScriptHash
$comittedField :: Maybe ScriptHash
parseJSONList :: Value -> Parser [ScriptHash]
$cparseJSONList :: Value -> Parser [ScriptHash]
parseJSON :: Value -> Parser ScriptHash
$cparseJSON :: Value -> Parser ScriptHash
FromJSON
    , ToJSONKeyFunction [ScriptHash]
ToJSONKeyFunction ScriptHash
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [ScriptHash]
$ctoJSONKeyList :: ToJSONKeyFunction [ScriptHash]
toJSONKey :: ToJSONKeyFunction ScriptHash
$ctoJSONKey :: ToJSONKeyFunction ScriptHash
ToJSONKey
    , FromJSONKeyFunction [ScriptHash]
FromJSONKeyFunction ScriptHash
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [ScriptHash]
$cfromJSONKeyList :: FromJSONKeyFunction [ScriptHash]
fromJSONKey :: FromJSONKeyFunction ScriptHash
$cfromJSONKey :: FromJSONKeyFunction ScriptHash
FromJSONKey
    )

--------------------------------------------------------------------------------
-- VRF Key Hashes
--------------------------------------------------------------------------------

data KeyRoleVRF
  = StakePoolVRF
  | GenDelegVRF
  | BlockIssuerVRF

-- | Discriminated hash of VRF Verification Key
newtype VRFVerKeyHash (r :: KeyRoleVRF) = VRFVerKeyHash
  {forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Hash HASH KeyRoleVRF
unVRFVerKeyHash :: Hash.Hash HASH KeyRoleVRF}
  deriving (Int -> VRFVerKeyHash r -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (r :: KeyRoleVRF). Int -> VRFVerKeyHash r -> ShowS
forall (r :: KeyRoleVRF). [VRFVerKeyHash r] -> ShowS
forall (r :: KeyRoleVRF). VRFVerKeyHash r -> String
showList :: [VRFVerKeyHash r] -> ShowS
$cshowList :: forall (r :: KeyRoleVRF). [VRFVerKeyHash r] -> ShowS
show :: VRFVerKeyHash r -> String
$cshow :: forall (r :: KeyRoleVRF). VRFVerKeyHash r -> String
showsPrec :: Int -> VRFVerKeyHash r -> ShowS
$cshowsPrec :: forall (r :: KeyRoleVRF). Int -> VRFVerKeyHash r -> ShowS
Show, VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
/= :: VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
$c/= :: forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
== :: VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
$c== :: forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
Eq, VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
VRFVerKeyHash r -> VRFVerKeyHash r -> Ordering
VRFVerKeyHash r -> VRFVerKeyHash r -> VRFVerKeyHash r
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (r :: KeyRoleVRF). Eq (VRFVerKeyHash r)
forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> Ordering
forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> VRFVerKeyHash r
min :: VRFVerKeyHash r -> VRFVerKeyHash r -> VRFVerKeyHash r
$cmin :: forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> VRFVerKeyHash r
max :: VRFVerKeyHash r -> VRFVerKeyHash r -> VRFVerKeyHash r
$cmax :: forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> VRFVerKeyHash r
>= :: VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
$c>= :: forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
> :: VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
$c> :: forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
<= :: VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
$c<= :: forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
< :: VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
$c< :: forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> Bool
compare :: VRFVerKeyHash r -> VRFVerKeyHash r -> Ordering
$ccompare :: forall (r :: KeyRoleVRF).
VRFVerKeyHash r -> VRFVerKeyHash r -> Ordering
Ord)
  deriving newtype
    ( VRFVerKeyHash r -> ()
forall a. (a -> ()) -> NFData a
forall (r :: KeyRoleVRF). VRFVerKeyHash r -> ()
rnf :: VRFVerKeyHash r -> ()
$crnf :: forall (r :: KeyRoleVRF). VRFVerKeyHash r -> ()
NFData
    , Context -> VRFVerKeyHash r -> IO (Maybe ThunkInfo)
Proxy (VRFVerKeyHash r) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (r :: KeyRoleVRF).
Context -> VRFVerKeyHash r -> IO (Maybe ThunkInfo)
forall (r :: KeyRoleVRF). Proxy (VRFVerKeyHash r) -> String
showTypeOf :: Proxy (VRFVerKeyHash r) -> String
$cshowTypeOf :: forall (r :: KeyRoleVRF). Proxy (VRFVerKeyHash r) -> String
wNoThunks :: Context -> VRFVerKeyHash r -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (r :: KeyRoleVRF).
Context -> VRFVerKeyHash r -> IO (Maybe ThunkInfo)
noThunks :: Context -> VRFVerKeyHash r -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (r :: KeyRoleVRF).
Context -> VRFVerKeyHash r -> IO (Maybe ThunkInfo)
NoThunks
    , forall x. Rep (VRFVerKeyHash r) x -> VRFVerKeyHash r
forall x. VRFVerKeyHash r -> Rep (VRFVerKeyHash r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (r :: KeyRoleVRF) x.
Rep (VRFVerKeyHash r) x -> VRFVerKeyHash r
forall (r :: KeyRoleVRF) x.
VRFVerKeyHash r -> Rep (VRFVerKeyHash r) x
to :: forall x. Rep (VRFVerKeyHash r) x -> VRFVerKeyHash r
$cto :: forall (r :: KeyRoleVRF) x.
Rep (VRFVerKeyHash r) x -> VRFVerKeyHash r
from :: forall x. VRFVerKeyHash r -> Rep (VRFVerKeyHash r) x
$cfrom :: forall (r :: KeyRoleVRF) x.
VRFVerKeyHash r -> Rep (VRFVerKeyHash r) x
Generic
    , VRFVerKeyHash r -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VRFVerKeyHash r] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VRFVerKeyHash r) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall {r :: KeyRoleVRF}. Typeable r => Typeable (VRFVerKeyHash r)
forall (r :: KeyRoleVRF). Typeable r => VRFVerKeyHash r -> Encoding
forall (r :: KeyRoleVRF).
Typeable r =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VRFVerKeyHash r] -> Size
forall (r :: KeyRoleVRF).
Typeable r =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VRFVerKeyHash r) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VRFVerKeyHash r] -> Size
$cencodedListSizeExpr :: forall (r :: KeyRoleVRF).
Typeable r =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VRFVerKeyHash r] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VRFVerKeyHash r) -> Size
$cencodedSizeExpr :: forall (r :: KeyRoleVRF).
Typeable r =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VRFVerKeyHash r) -> Size
toCBOR :: VRFVerKeyHash r -> Encoding
$ctoCBOR :: forall (r :: KeyRoleVRF). Typeable r => VRFVerKeyHash r -> Encoding
ToCBOR
    , Proxy (VRFVerKeyHash r) -> Text
forall s. Decoder s (VRFVerKeyHash r)
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall {r :: KeyRoleVRF}. Typeable r => Typeable (VRFVerKeyHash r)
forall (r :: KeyRoleVRF).
Typeable r =>
Proxy (VRFVerKeyHash r) -> Text
forall (r :: KeyRoleVRF) s.
Typeable r =>
Decoder s (VRFVerKeyHash r)
label :: Proxy (VRFVerKeyHash r) -> Text
$clabel :: forall (r :: KeyRoleVRF).
Typeable r =>
Proxy (VRFVerKeyHash r) -> Text
fromCBOR :: forall s. Decoder s (VRFVerKeyHash r)
$cfromCBOR :: forall (r :: KeyRoleVRF) s.
Typeable r =>
Decoder s (VRFVerKeyHash r)
FromCBOR
    , VRFVerKeyHash r -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VRFVerKeyHash r] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VRFVerKeyHash r) -> 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
forall {r :: KeyRoleVRF}. Typeable r => Typeable (VRFVerKeyHash r)
forall (r :: KeyRoleVRF). Typeable r => VRFVerKeyHash r -> Encoding
forall (r :: KeyRoleVRF).
Typeable r =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VRFVerKeyHash r] -> Size
forall (r :: KeyRoleVRF).
Typeable r =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VRFVerKeyHash r) -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VRFVerKeyHash r] -> Size
$cencodedListSizeExpr :: forall (r :: KeyRoleVRF).
Typeable r =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VRFVerKeyHash r] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VRFVerKeyHash r) -> Size
$cencodedSizeExpr :: forall (r :: KeyRoleVRF).
Typeable r =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VRFVerKeyHash r) -> Size
encCBOR :: VRFVerKeyHash r -> Encoding
$cencCBOR :: forall (r :: KeyRoleVRF). Typeable r => VRFVerKeyHash r -> Encoding
EncCBOR
    , Proxy (VRFVerKeyHash r) -> Text
forall s. Decoder s (VRFVerKeyHash r)
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (VRFVerKeyHash r) -> Decoder s ()
forall {r :: KeyRoleVRF}. Typeable r => Typeable (VRFVerKeyHash r)
forall (r :: KeyRoleVRF).
Typeable r =>
Proxy (VRFVerKeyHash r) -> Text
forall (r :: KeyRoleVRF) s.
Typeable r =>
Decoder s (VRFVerKeyHash r)
forall (r :: KeyRoleVRF) s.
Typeable r =>
Proxy (VRFVerKeyHash r) -> Decoder s ()
label :: Proxy (VRFVerKeyHash r) -> Text
$clabel :: forall (r :: KeyRoleVRF).
Typeable r =>
Proxy (VRFVerKeyHash r) -> Text
dropCBOR :: forall s. Proxy (VRFVerKeyHash r) -> Decoder s ()
$cdropCBOR :: forall (r :: KeyRoleVRF) s.
Typeable r =>
Proxy (VRFVerKeyHash r) -> Decoder s ()
decCBOR :: forall s. Decoder s (VRFVerKeyHash r)
$cdecCBOR :: forall (r :: KeyRoleVRF) s.
Typeable r =>
Decoder s (VRFVerKeyHash r)
DecCBOR
    , ToJSONKeyFunction [VRFVerKeyHash r]
ToJSONKeyFunction (VRFVerKeyHash r)
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
forall (r :: KeyRoleVRF). ToJSONKeyFunction [VRFVerKeyHash r]
forall (r :: KeyRoleVRF). ToJSONKeyFunction (VRFVerKeyHash r)
toJSONKeyList :: ToJSONKeyFunction [VRFVerKeyHash r]
$ctoJSONKeyList :: forall (r :: KeyRoleVRF). ToJSONKeyFunction [VRFVerKeyHash r]
toJSONKey :: ToJSONKeyFunction (VRFVerKeyHash r)
$ctoJSONKey :: forall (r :: KeyRoleVRF). ToJSONKeyFunction (VRFVerKeyHash r)
ToJSONKey
    , FromJSONKeyFunction [VRFVerKeyHash r]
FromJSONKeyFunction (VRFVerKeyHash r)
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
forall (r :: KeyRoleVRF). FromJSONKeyFunction [VRFVerKeyHash r]
forall (r :: KeyRoleVRF). FromJSONKeyFunction (VRFVerKeyHash r)
fromJSONKeyList :: FromJSONKeyFunction [VRFVerKeyHash r]
$cfromJSONKeyList :: forall (r :: KeyRoleVRF). FromJSONKeyFunction [VRFVerKeyHash r]
fromJSONKey :: FromJSONKeyFunction (VRFVerKeyHash r)
$cfromJSONKey :: forall (r :: KeyRoleVRF). FromJSONKeyFunction (VRFVerKeyHash r)
FromJSONKey
    , [VRFVerKeyHash r] -> Encoding
[VRFVerKeyHash r] -> Value
VRFVerKeyHash r -> Bool
VRFVerKeyHash r -> Encoding
VRFVerKeyHash r -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
forall (r :: KeyRoleVRF). [VRFVerKeyHash r] -> Encoding
forall (r :: KeyRoleVRF). [VRFVerKeyHash r] -> Value
forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Bool
forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Encoding
forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Value
omitField :: VRFVerKeyHash r -> Bool
$comitField :: forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Bool
toEncodingList :: [VRFVerKeyHash r] -> Encoding
$ctoEncodingList :: forall (r :: KeyRoleVRF). [VRFVerKeyHash r] -> Encoding
toJSONList :: [VRFVerKeyHash r] -> Value
$ctoJSONList :: forall (r :: KeyRoleVRF). [VRFVerKeyHash r] -> Value
toEncoding :: VRFVerKeyHash r -> Encoding
$ctoEncoding :: forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Encoding
toJSON :: VRFVerKeyHash r -> Value
$ctoJSON :: forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Value
ToJSON
    , Maybe (VRFVerKeyHash r)
Value -> Parser [VRFVerKeyHash r]
Value -> Parser (VRFVerKeyHash r)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
forall (r :: KeyRoleVRF). Maybe (VRFVerKeyHash r)
forall (r :: KeyRoleVRF). Value -> Parser [VRFVerKeyHash r]
forall (r :: KeyRoleVRF). Value -> Parser (VRFVerKeyHash r)
omittedField :: Maybe (VRFVerKeyHash r)
$comittedField :: forall (r :: KeyRoleVRF). Maybe (VRFVerKeyHash r)
parseJSONList :: Value -> Parser [VRFVerKeyHash r]
$cparseJSONList :: forall (r :: KeyRoleVRF). Value -> Parser [VRFVerKeyHash r]
parseJSON :: Value -> Parser (VRFVerKeyHash r)
$cparseJSON :: forall (r :: KeyRoleVRF). Value -> Parser (VRFVerKeyHash r)
FromJSON
    , VRFVerKeyHash r
forall a. a -> Default a
forall (r :: KeyRoleVRF). VRFVerKeyHash r
def :: VRFVerKeyHash r
$cdef :: forall (r :: KeyRoleVRF). VRFVerKeyHash r
Default
    )

toVRFVerKeyHash :: Hash.Hash HASH (VRF.VerKeyVRF v) -> VRFVerKeyHash (r :: KeyRoleVRF)
toVRFVerKeyHash :: forall v (r :: KeyRoleVRF).
Hash HASH (VerKeyVRF v) -> VRFVerKeyHash r
toVRFVerKeyHash = forall (r :: KeyRoleVRF). Hash HASH KeyRoleVRF -> VRFVerKeyHash r
VRFVerKeyHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. Hash h a -> Hash h b
Hash.castHash

fromVRFVerKeyHash :: VRFVerKeyHash (r :: KeyRoleVRF) -> Hash.Hash HASH (VRF.VerKeyVRF v)
fromVRFVerKeyHash :: forall (r :: KeyRoleVRF) v.
VRFVerKeyHash r -> Hash HASH (VerKeyVRF v)
fromVRFVerKeyHash = forall h a b. Hash h a -> Hash h b
Hash.castHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Hash HASH KeyRoleVRF
unVRFVerKeyHash

--------------------------------------------------------------------------------
-- Auxiliary Data Hashes
--------------------------------------------------------------------------------

newtype TxAuxDataHash = TxAuxDataHash
  { TxAuxDataHash -> SafeHash EraIndependentTxAuxData
unTxAuxDataHash :: SafeHash EraIndependentTxAuxData
  }
  deriving (Int -> TxAuxDataHash -> ShowS
[TxAuxDataHash] -> ShowS
TxAuxDataHash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxAuxDataHash] -> ShowS
$cshowList :: [TxAuxDataHash] -> ShowS
show :: TxAuxDataHash -> String
$cshow :: TxAuxDataHash -> String
showsPrec :: Int -> TxAuxDataHash -> ShowS
$cshowsPrec :: Int -> TxAuxDataHash -> ShowS
Show, TxAuxDataHash -> TxAuxDataHash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxAuxDataHash -> TxAuxDataHash -> Bool
$c/= :: TxAuxDataHash -> TxAuxDataHash -> Bool
== :: TxAuxDataHash -> TxAuxDataHash -> Bool
$c== :: TxAuxDataHash -> TxAuxDataHash -> Bool
Eq, Eq TxAuxDataHash
TxAuxDataHash -> TxAuxDataHash -> Bool
TxAuxDataHash -> TxAuxDataHash -> Ordering
TxAuxDataHash -> TxAuxDataHash -> TxAuxDataHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxAuxDataHash -> TxAuxDataHash -> TxAuxDataHash
$cmin :: TxAuxDataHash -> TxAuxDataHash -> TxAuxDataHash
max :: TxAuxDataHash -> TxAuxDataHash -> TxAuxDataHash
$cmax :: TxAuxDataHash -> TxAuxDataHash -> TxAuxDataHash
>= :: TxAuxDataHash -> TxAuxDataHash -> Bool
$c>= :: TxAuxDataHash -> TxAuxDataHash -> Bool
> :: TxAuxDataHash -> TxAuxDataHash -> Bool
$c> :: TxAuxDataHash -> TxAuxDataHash -> Bool
<= :: TxAuxDataHash -> TxAuxDataHash -> Bool
$c<= :: TxAuxDataHash -> TxAuxDataHash -> Bool
< :: TxAuxDataHash -> TxAuxDataHash -> Bool
$c< :: TxAuxDataHash -> TxAuxDataHash -> Bool
compare :: TxAuxDataHash -> TxAuxDataHash -> Ordering
$ccompare :: TxAuxDataHash -> TxAuxDataHash -> Ordering
Ord, forall x. Rep TxAuxDataHash x -> TxAuxDataHash
forall x. TxAuxDataHash -> Rep TxAuxDataHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxAuxDataHash x -> TxAuxDataHash
$cfrom :: forall x. TxAuxDataHash -> Rep TxAuxDataHash x
Generic, Context -> TxAuxDataHash -> IO (Maybe ThunkInfo)
Proxy TxAuxDataHash -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy TxAuxDataHash -> String
$cshowTypeOf :: Proxy TxAuxDataHash -> String
wNoThunks :: Context -> TxAuxDataHash -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TxAuxDataHash -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxAuxDataHash -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> TxAuxDataHash -> IO (Maybe ThunkInfo)
NoThunks, TxAuxDataHash -> ()
forall a. (a -> ()) -> NFData a
rnf :: TxAuxDataHash -> ()
$crnf :: TxAuxDataHash -> ()
NFData, Typeable TxAuxDataHash
TxAuxDataHash -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [TxAuxDataHash] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy TxAuxDataHash -> 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 [TxAuxDataHash] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [TxAuxDataHash] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy TxAuxDataHash -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy TxAuxDataHash -> Size
encCBOR :: TxAuxDataHash -> Encoding
$cencCBOR :: TxAuxDataHash -> Encoding
EncCBOR, Typeable TxAuxDataHash
Proxy TxAuxDataHash -> Text
forall s. Decoder s TxAuxDataHash
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy TxAuxDataHash -> Decoder s ()
label :: Proxy TxAuxDataHash -> Text
$clabel :: Proxy TxAuxDataHash -> Text
dropCBOR :: forall s. Proxy TxAuxDataHash -> Decoder s ()
$cdropCBOR :: forall s. Proxy TxAuxDataHash -> Decoder s ()
decCBOR :: forall s. Decoder s TxAuxDataHash
$cdecCBOR :: forall s. Decoder s TxAuxDataHash
DecCBOR, [TxAuxDataHash] -> Encoding
[TxAuxDataHash] -> Value
TxAuxDataHash -> Bool
TxAuxDataHash -> Encoding
TxAuxDataHash -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: TxAuxDataHash -> Bool
$comitField :: TxAuxDataHash -> Bool
toEncodingList :: [TxAuxDataHash] -> Encoding
$ctoEncodingList :: [TxAuxDataHash] -> Encoding
toJSONList :: [TxAuxDataHash] -> Value
$ctoJSONList :: [TxAuxDataHash] -> Value
toEncoding :: TxAuxDataHash -> Encoding
$ctoEncoding :: TxAuxDataHash -> Encoding
toJSON :: TxAuxDataHash -> Value
$ctoJSON :: TxAuxDataHash -> Value
ToJSON)

--------------------------------------------------------------------------------
-- Genesis Keys Hashes
--------------------------------------------------------------------------------

-- TODO: Move to cardano-ledger-shelley, whenever CertState will become era parametric
data GenDelegPair = GenDelegPair
  { GenDelegPair -> KeyHash 'GenesisDelegate
genDelegKeyHash :: !(KeyHash 'GenesisDelegate)
  , GenDelegPair -> VRFVerKeyHash 'GenDelegVRF
genDelegVrfHash :: !(VRFVerKeyHash 'GenDelegVRF)
  }
  deriving (Int -> GenDelegPair -> ShowS
[GenDelegPair] -> ShowS
GenDelegPair -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenDelegPair] -> ShowS
$cshowList :: [GenDelegPair] -> ShowS
show :: GenDelegPair -> String
$cshow :: GenDelegPair -> String
showsPrec :: Int -> GenDelegPair -> ShowS
$cshowsPrec :: Int -> GenDelegPair -> ShowS
Show, GenDelegPair -> GenDelegPair -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenDelegPair -> GenDelegPair -> Bool
$c/= :: GenDelegPair -> GenDelegPair -> Bool
== :: GenDelegPair -> GenDelegPair -> Bool
$c== :: GenDelegPair -> GenDelegPair -> Bool
Eq, Eq GenDelegPair
GenDelegPair -> GenDelegPair -> Bool
GenDelegPair -> GenDelegPair -> Ordering
GenDelegPair -> GenDelegPair -> GenDelegPair
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GenDelegPair -> GenDelegPair -> GenDelegPair
$cmin :: GenDelegPair -> GenDelegPair -> GenDelegPair
max :: GenDelegPair -> GenDelegPair -> GenDelegPair
$cmax :: GenDelegPair -> GenDelegPair -> GenDelegPair
>= :: GenDelegPair -> GenDelegPair -> Bool
$c>= :: GenDelegPair -> GenDelegPair -> Bool
> :: GenDelegPair -> GenDelegPair -> Bool
$c> :: GenDelegPair -> GenDelegPair -> Bool
<= :: GenDelegPair -> GenDelegPair -> Bool
$c<= :: GenDelegPair -> GenDelegPair -> Bool
< :: GenDelegPair -> GenDelegPair -> Bool
$c< :: GenDelegPair -> GenDelegPair -> Bool
compare :: GenDelegPair -> GenDelegPair -> Ordering
$ccompare :: GenDelegPair -> GenDelegPair -> Ordering
Ord, forall x. Rep GenDelegPair x -> GenDelegPair
forall x. GenDelegPair -> Rep GenDelegPair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GenDelegPair x -> GenDelegPair
$cfrom :: forall x. GenDelegPair -> Rep GenDelegPair x
Generic)

instance NoThunks GenDelegPair

instance NFData GenDelegPair

instance EncCBOR GenDelegPair where
  encCBOR :: GenDelegPair -> Encoding
encCBOR (GenDelegPair KeyHash 'GenesisDelegate
hk VRFVerKeyHash 'GenDelegVRF
vrf) =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'GenesisDelegate
hk forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR VRFVerKeyHash 'GenDelegVRF
vrf

instance DecCBOR GenDelegPair where
  decCBOR :: forall s. Decoder s GenDelegPair
decCBOR = do
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed
      Text
"GenDelegPair"
      (forall a b. a -> b -> a
const Int
2)
      (KeyHash 'GenesisDelegate
-> VRFVerKeyHash 'GenDelegVRF -> GenDelegPair
GenDelegPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR)
  {-# INLINE decCBOR #-}

instance ToJSON GenDelegPair where
  toJSON :: GenDelegPair -> Value
toJSON (GenDelegPair KeyHash 'GenesisDelegate
d VRFVerKeyHash 'GenDelegVRF
v) =
    [Pair] -> Value
Aeson.object
      [ Key
"delegate" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash 'GenesisDelegate
d
      , Key
"vrf" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= VRFVerKeyHash 'GenDelegVRF
v
      ]

instance FromJSON GenDelegPair where
  parseJSON :: Value -> Parser GenDelegPair
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"GenDelegPair" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      KeyHash 'GenesisDelegate
-> VRFVerKeyHash 'GenDelegVRF -> GenDelegPair
GenDelegPair
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delegate"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vrf"

newtype GenDelegs = GenDelegs
  { GenDelegs -> Map (KeyHash 'Genesis) GenDelegPair
unGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
  }
  deriving (GenDelegs -> GenDelegs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenDelegs -> GenDelegs -> Bool
$c/= :: GenDelegs -> GenDelegs -> Bool
== :: GenDelegs -> GenDelegs -> Bool
$c== :: GenDelegs -> GenDelegs -> Bool
Eq, Typeable GenDelegs
GenDelegs -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [GenDelegs] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy GenDelegs -> 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 [GenDelegs] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [GenDelegs] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy GenDelegs -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy GenDelegs -> Size
encCBOR :: GenDelegs -> Encoding
$cencCBOR :: GenDelegs -> Encoding
EncCBOR, Typeable GenDelegs
Proxy GenDelegs -> Text
forall s. Decoder s GenDelegs
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy GenDelegs -> Decoder s ()
label :: Proxy GenDelegs -> Text
$clabel :: Proxy GenDelegs -> Text
dropCBOR :: forall s. Proxy GenDelegs -> Decoder s ()
$cdropCBOR :: forall s. Proxy GenDelegs -> Decoder s ()
decCBOR :: forall s. Decoder s GenDelegs
$cdecCBOR :: forall s. Decoder s GenDelegs
DecCBOR, Context -> GenDelegs -> IO (Maybe ThunkInfo)
Proxy GenDelegs -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy GenDelegs -> String
$cshowTypeOf :: Proxy GenDelegs -> String
wNoThunks :: Context -> GenDelegs -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenDelegs -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenDelegs -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> GenDelegs -> IO (Maybe ThunkInfo)
NoThunks, GenDelegs -> ()
forall a. (a -> ()) -> NFData a
rnf :: GenDelegs -> ()
$crnf :: GenDelegs -> ()
NFData, forall x. Rep GenDelegs x -> GenDelegs
forall x. GenDelegs -> Rep GenDelegs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GenDelegs x -> GenDelegs
$cfrom :: forall x. GenDelegs -> Rep GenDelegs x
Generic, Maybe GenDelegs
Value -> Parser [GenDelegs]
Value -> Parser GenDelegs
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
omittedField :: Maybe GenDelegs
$comittedField :: Maybe GenDelegs
parseJSONList :: Value -> Parser [GenDelegs]
$cparseJSONList :: Value -> Parser [GenDelegs]
parseJSON :: Value -> Parser GenDelegs
$cparseJSON :: Value -> Parser GenDelegs
FromJSON, [GenDelegs] -> Encoding
[GenDelegs] -> Value
GenDelegs -> Bool
GenDelegs -> Encoding
GenDelegs -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: GenDelegs -> Bool
$comitField :: GenDelegs -> Bool
toEncodingList :: [GenDelegs] -> Encoding
$ctoEncodingList :: [GenDelegs] -> Encoding
toJSONList :: [GenDelegs] -> Value
$ctoJSONList :: [GenDelegs] -> Value
toEncoding :: GenDelegs -> Encoding
$ctoEncoding :: GenDelegs -> Encoding
toJSON :: GenDelegs -> Value
$ctoJSON :: GenDelegs -> Value
ToJSON)
  deriving (Int -> GenDelegs -> ShowS
[GenDelegs] -> ShowS
GenDelegs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenDelegs] -> ShowS
$cshowList :: [GenDelegs] -> ShowS
show :: GenDelegs -> String
$cshow :: GenDelegs -> String
showsPrec :: Int -> GenDelegs -> ShowS
$cshowsPrec :: Int -> GenDelegs -> ShowS
Show) via Quiet GenDelegs

--------------------------------------------------------------------------------
-- Safe Hashes
--------------------------------------------------------------------------------

-- $SAFEHASH
--
-- In cardano-ledger, hashing a type @X@ is based upon the serialization of
-- @X@. Serialization is based upon the 'EncCBOR' and 'DecCBOR' type classes, and the
-- serialization that can be handled by 'DecCBOR' instances for a particular type, are not
-- necessarily unique. For this reason, when an @X@ object comes over the network in
-- serialized form, we must preserve the original bytes that arrived over the network,
-- otherwise when the system hashes that object, the hash in the ledger, and the hash of
-- that object from the other side of the network may not agree. In otherwords
-- reserialization for the purpose of hash calculation is not an option. The 'SafeToHash'
-- type class ensures that types with a @(SafeToHash X)@ instance store the original bytes
-- that arrived over the network for the value of @X@. The recommended way to store the
-- original bytes is to use the type 'MemoBytes', although there are a few types that
-- store their original bytes in other ways. In order to encourage the use of newtype over
-- 'Cardano.Ledger.MemoBytes.MemoBytes' newtype defined as a 'MemoBytes', which would get
-- the functionality of retaining bytes and deriving of 'SafeToHash' instance for free.

-- | A 'SafeHash' is a hash of something that is safe to hash. Such types store their own
-- serialisation bytes. The prime example is @('MemoBytes' t)@, but other examples are
-- things that consist of only ByteStrings (i.e. they are their own serialization) or for
-- some other reason store their original bytes.
--
-- We do NOT export the constructor 'SafeHash', but instead export other functions such as
-- 'hashAnnotated' and 'extractHash' which have constraints that limit their application
-- to types which preserve their original serialization bytes.
newtype SafeHash i = SafeHash (Hash.Hash HASH i)
  deriving
    (Int -> SafeHash i -> ShowS
forall i. Int -> SafeHash i -> ShowS
forall i. [SafeHash i] -> ShowS
forall i. SafeHash i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SafeHash i] -> ShowS
$cshowList :: forall i. [SafeHash i] -> ShowS
show :: SafeHash i -> String
$cshow :: forall i. SafeHash i -> String
showsPrec :: Int -> SafeHash i -> ShowS
$cshowsPrec :: forall i. Int -> SafeHash i -> ShowS
Show, SafeHash i -> SafeHash i -> Bool
forall i. SafeHash i -> SafeHash i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SafeHash i -> SafeHash i -> Bool
$c/= :: forall i. SafeHash i -> SafeHash i -> Bool
== :: SafeHash i -> SafeHash i -> Bool
$c== :: forall i. SafeHash i -> SafeHash i -> Bool
Eq, SafeHash i -> SafeHash i -> Bool
SafeHash i -> SafeHash i -> Ordering
SafeHash i -> SafeHash i -> SafeHash i
forall i. Eq (SafeHash i)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall i. SafeHash i -> SafeHash i -> Bool
forall i. SafeHash i -> SafeHash i -> Ordering
forall i. SafeHash i -> SafeHash i -> SafeHash i
min :: SafeHash i -> SafeHash i -> SafeHash i
$cmin :: forall i. SafeHash i -> SafeHash i -> SafeHash i
max :: SafeHash i -> SafeHash i -> SafeHash i
$cmax :: forall i. SafeHash i -> SafeHash i -> SafeHash i
>= :: SafeHash i -> SafeHash i -> Bool
$c>= :: forall i. SafeHash i -> SafeHash i -> Bool
> :: SafeHash i -> SafeHash i -> Bool
$c> :: forall i. SafeHash i -> SafeHash i -> Bool
<= :: SafeHash i -> SafeHash i -> Bool
$c<= :: forall i. SafeHash i -> SafeHash i -> Bool
< :: SafeHash i -> SafeHash i -> Bool
$c< :: forall i. SafeHash i -> SafeHash i -> Bool
compare :: SafeHash i -> SafeHash i -> Ordering
$ccompare :: forall i. SafeHash i -> SafeHash i -> Ordering
Ord, Context -> SafeHash i -> IO (Maybe ThunkInfo)
Proxy (SafeHash i) -> String
forall i. Context -> SafeHash i -> IO (Maybe ThunkInfo)
forall i. Proxy (SafeHash i) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (SafeHash i) -> String
$cshowTypeOf :: forall i. Proxy (SafeHash i) -> String
wNoThunks :: Context -> SafeHash i -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall i. Context -> SafeHash i -> IO (Maybe ThunkInfo)
noThunks :: Context -> SafeHash i -> IO (Maybe ThunkInfo)
$cnoThunks :: forall i. Context -> SafeHash i -> IO (Maybe ThunkInfo)
NoThunks, SafeHash i -> ()
forall i. SafeHash i -> ()
forall a. (a -> ()) -> NFData a
rnf :: SafeHash i -> ()
$crnf :: forall i. SafeHash i -> ()
NFData, SafeHash i -> Int
SafeHash i -> ByteString
forall i. Proxy i -> SafeHash i -> SafeHash i
forall i. SafeHash i -> Int
forall i. SafeHash i -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall i i. Proxy i -> SafeHash i -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> SafeHash i -> SafeHash i
$cmakeHashWithExplicitProxys :: forall i i. Proxy i -> SafeHash i -> SafeHash i
originalBytesSize :: SafeHash i -> Int
$coriginalBytesSize :: forall i. SafeHash i -> Int
originalBytes :: SafeHash i -> ByteString
$coriginalBytes :: forall i. SafeHash i -> ByteString
SafeToHash, SafeHash i -> Int
forall i. SafeHash i -> Int
forall a. (a -> Int) -> HeapWords a
heapWords :: SafeHash i -> Int
$cheapWords :: forall i. SafeHash i -> Int
HeapWords, SafeHash i -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SafeHash i] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SafeHash i) -> Size
forall {i}. Typeable i => Typeable (SafeHash i)
forall i. Typeable i => SafeHash i -> Encoding
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall i.
Typeable i =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SafeHash i] -> Size
forall i.
Typeable i =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SafeHash i) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SafeHash i] -> Size
$cencodedListSizeExpr :: forall i.
Typeable i =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SafeHash i] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SafeHash i) -> Size
$cencodedSizeExpr :: forall i.
Typeable i =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SafeHash i) -> Size
toCBOR :: SafeHash i -> Encoding
$ctoCBOR :: forall i. Typeable i => SafeHash i -> Encoding
ToCBOR, Proxy (SafeHash i) -> Text
forall s. Decoder s (SafeHash i)
forall {i}. Typeable i => Typeable (SafeHash i)
forall i. Typeable i => Proxy (SafeHash i) -> Text
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall i s. Typeable i => Decoder s (SafeHash i)
label :: Proxy (SafeHash i) -> Text
$clabel :: forall i. Typeable i => Proxy (SafeHash i) -> Text
fromCBOR :: forall s. Decoder s (SafeHash i)
$cfromCBOR :: forall i s. Typeable i => Decoder s (SafeHash i)
FromCBOR, SafeHash i -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SafeHash i] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (SafeHash i) -> Size
forall {i}. Typeable i => Typeable (SafeHash i)
forall i. Typeable i => SafeHash i -> Encoding
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
forall i.
Typeable i =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SafeHash i] -> Size
forall i.
Typeable i =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (SafeHash i) -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SafeHash i] -> Size
$cencodedListSizeExpr :: forall i.
Typeable i =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SafeHash i] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (SafeHash i) -> Size
$cencodedSizeExpr :: forall i.
Typeable i =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (SafeHash i) -> Size
encCBOR :: SafeHash i -> Encoding
$cencCBOR :: forall i. Typeable i => SafeHash i -> Encoding
EncCBOR, Proxy (SafeHash i) -> Text
forall s. Decoder s (SafeHash i)
forall {i}. Typeable i => Typeable (SafeHash i)
forall i. Typeable i => Proxy (SafeHash i) -> Text
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall i s. Typeable i => Decoder s (SafeHash i)
forall i s. Typeable i => Proxy (SafeHash i) -> Decoder s ()
forall s. Proxy (SafeHash i) -> Decoder s ()
label :: Proxy (SafeHash i) -> Text
$clabel :: forall i. Typeable i => Proxy (SafeHash i) -> Text
dropCBOR :: forall s. Proxy (SafeHash i) -> Decoder s ()
$cdropCBOR :: forall i s. Typeable i => Proxy (SafeHash i) -> Decoder s ()
decCBOR :: forall s. Decoder s (SafeHash i)
$cdecCBOR :: forall i s. Typeable i => Decoder s (SafeHash i)
DecCBOR)

deriving instance ToJSON (SafeHash i)

deriving instance FromJSON (SafeHash i)

instance Default (SafeHash i) where
  def :: SafeHash i
def = forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash forall a. Default a => a
def

-- | Extract the hash out of a 'SafeHash'
extractHash :: SafeHash i -> Hash.Hash HASH i
extractHash :: forall i. SafeHash i -> Hash HASH i
extractHash (SafeHash Hash HASH i
h) = Hash HASH i
h

-- | Don't use this except in Testing to make Arbitrary instances, etc. or in cases when
-- it can be guaranteed that original bytes were used for computing the hash.
unsafeMakeSafeHash :: Hash.Hash HASH i -> SafeHash i
unsafeMakeSafeHash :: forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash = forall i. Hash HASH i -> SafeHash i
SafeHash

-- =====================================================================

-- | Only Types that preserve their serialisation bytes are members of the
--   class 'SafeToHash'. There are only a limited number of primitive direct
--   instances of 'SafeToHash', all but two of them are present in this file. Instead
--   of making explicit instances, we almost always use a newtype (around a type @S@)
--   where their is already an instance @(SafeToHash S)@. In that case the newtype
--   has its SafeToHash instance derived using newtype deriving. The prime example of @s@ is 'MemoBytes'.
--   The only exceptions are the legacy Shelley types: @Metadata@ and @ShelleyTx@, that
--   preserve their serialization bytes
--   using a different mechanism than the use of 'MemoBytes'.  'SafeToHash' is a superclass
--   requirement of the classes 'HashAnnotated' which
--   provide more convenient ways to construct SafeHashes than using 'makeHashWithExplicitProxys'.
class SafeToHash t where
  -- | Extract the original bytes from 't'
  originalBytes :: t -> ByteString

  originalBytesSize :: t -> Int
  originalBytesSize = ByteString -> Int
BS.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. SafeToHash t => t -> ByteString
originalBytes

  makeHashWithExplicitProxys :: Proxy i -> t -> SafeHash i

  -- | Build a @(SafeHash index)@ value given a proxy determining @i@, and the
  --   value to be hashed.
  makeHashWithExplicitProxys Proxy i
_ t
x = forall i. Hash HASH i -> SafeHash i
SafeHash forall a b. (a -> b) -> a -> b
$ forall h a b. Hash h a -> Hash h b
Hash.castHash (forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith forall t. SafeToHash t => t -> ByteString
originalBytes t
x)

instance SafeToHash ShortByteString where
  originalBytes :: ShortByteString -> ByteString
originalBytes = ShortByteString -> ByteString
fromShort
  originalBytesSize :: ShortByteString -> Int
originalBytesSize = ShortByteString -> Int
SBS.length

instance SafeToHash ByteString where
  originalBytes :: ByteString -> ByteString
originalBytes ByteString
x = ByteString
x

-- | Hash of a hash. Hash is always safe to hash. Do you even hash?
instance Hash.HashAlgorithm h => SafeToHash (Hash.Hash h i) where
  originalBytes :: Hash h i -> ByteString
originalBytes = forall h a. Hash h a -> ByteString
Hash.hashToBytes

-- | Types that are 'SafeToHash' AND have the type uniquely determines the 'index' type
-- tag of @`SafeHash` index@
--
-- The 'SafeToHash' and the 'HashAnnotated' classes are designed so that their instances
-- can be easily derived (because their methods have default methods when the type is a
-- newtype around a type that is 'SafeToHash'). For example,
class SafeToHash x => HashAnnotated x i | x -> i where
  -- | Create a @('SafeHash' i)@, given @(`HashAnnotated` x i)@ instance.
  hashAnnotated :: x -> SafeHash i
  hashAnnotated = forall t i. SafeToHash t => Proxy i -> t -> SafeHash i
makeHashWithExplicitProxys (forall {k} (t :: k). Proxy t
Proxy @i)
  {-# INLINE hashAnnotated #-}

-- OTHER

-- | To change the index parameter of SafeHash (which is a phantom type) use castSafeHash
castSafeHash :: forall i j. SafeHash i -> SafeHash j
castSafeHash :: forall i j. SafeHash i -> SafeHash j
castSafeHash (SafeHash Hash HASH i
h) = forall i. Hash HASH i -> SafeHash i
SafeHash (forall h a b. Hash h a -> Hash h b
Hash.castHash Hash HASH i
h)