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

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

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

instance DecCBOR GenDelegPair where
  decCBOR :: forall s. Decoder s GenDelegPair
decCBOR = do
    Text
-> (GenDelegPair -> Int)
-> Decoder s GenDelegPair
-> Decoder s GenDelegPair
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed
      Text
"GenDelegPair"
      (Int -> GenDelegPair -> Int
forall a b. a -> b -> a
const Int
2)
      (KeyHash 'GenesisDelegate
-> VRFVerKeyHash 'GenDelegVRF -> GenDelegPair
GenDelegPair (KeyHash 'GenesisDelegate
 -> VRFVerKeyHash 'GenDelegVRF -> GenDelegPair)
-> Decoder s (KeyHash 'GenesisDelegate)
-> Decoder s (VRFVerKeyHash 'GenDelegVRF -> GenDelegPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (KeyHash 'GenesisDelegate)
forall s. Decoder s (KeyHash 'GenesisDelegate)
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (VRFVerKeyHash 'GenDelegVRF -> GenDelegPair)
-> Decoder s (VRFVerKeyHash 'GenDelegVRF) -> Decoder s GenDelegPair
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (VRFVerKeyHash 'GenDelegVRF)
forall s. Decoder s (VRFVerKeyHash 'GenDelegVRF)
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" Key -> KeyHash 'GenesisDelegate -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash 'GenesisDelegate
d
      , Key
"vrf" Key -> VRFVerKeyHash 'GenDelegVRF -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= VRFVerKeyHash 'GenDelegVRF
v
      ]

instance FromJSON GenDelegPair where
  parseJSON :: Value -> Parser GenDelegPair
parseJSON =
    String
-> (Object -> Parser GenDelegPair) -> Value -> Parser GenDelegPair
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"GenDelegPair" ((Object -> Parser GenDelegPair) -> Value -> Parser GenDelegPair)
-> (Object -> Parser GenDelegPair) -> Value -> Parser GenDelegPair
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      KeyHash 'GenesisDelegate
-> VRFVerKeyHash 'GenDelegVRF -> GenDelegPair
GenDelegPair
        (KeyHash 'GenesisDelegate
 -> VRFVerKeyHash 'GenDelegVRF -> GenDelegPair)
-> Parser (KeyHash 'GenesisDelegate)
-> Parser (VRFVerKeyHash 'GenDelegVRF -> GenDelegPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (KeyHash 'GenesisDelegate)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delegate"
        Parser (VRFVerKeyHash 'GenDelegVRF -> GenDelegPair)
-> Parser (VRFVerKeyHash 'GenDelegVRF) -> Parser GenDelegPair
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (VRFVerKeyHash 'GenDelegVRF)
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
(GenDelegs -> GenDelegs -> Bool)
-> (GenDelegs -> GenDelegs -> Bool) -> Eq GenDelegs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenDelegs -> GenDelegs -> Bool
== :: GenDelegs -> GenDelegs -> Bool
$c/= :: GenDelegs -> GenDelegs -> Bool
/= :: GenDelegs -> GenDelegs -> Bool
Eq, Typeable GenDelegs
Typeable GenDelegs =>
(GenDelegs -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy GenDelegs -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [GenDelegs] -> Size)
-> EncCBOR 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
$cencCBOR :: GenDelegs -> Encoding
encCBOR :: GenDelegs -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy GenDelegs -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy GenDelegs -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [GenDelegs] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [GenDelegs] -> Size
EncCBOR, Typeable GenDelegs
Typeable GenDelegs =>
(forall s. Decoder s GenDelegs)
-> (forall s. Proxy GenDelegs -> Decoder s ())
-> (Proxy GenDelegs -> Text)
-> DecCBOR 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 ()
$cdecCBOR :: forall s. Decoder s GenDelegs
decCBOR :: forall s. Decoder s GenDelegs
$cdropCBOR :: forall s. Proxy GenDelegs -> Decoder s ()
dropCBOR :: forall s. Proxy GenDelegs -> Decoder s ()
$clabel :: Proxy GenDelegs -> Text
label :: Proxy GenDelegs -> Text
DecCBOR, Context -> GenDelegs -> IO (Maybe ThunkInfo)
Proxy GenDelegs -> String
(Context -> GenDelegs -> IO (Maybe ThunkInfo))
-> (Context -> GenDelegs -> IO (Maybe ThunkInfo))
-> (Proxy GenDelegs -> String)
-> NoThunks GenDelegs
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> GenDelegs -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenDelegs -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenDelegs -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> GenDelegs -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy GenDelegs -> String
showTypeOf :: Proxy GenDelegs -> String
NoThunks, GenDelegs -> ()
(GenDelegs -> ()) -> NFData GenDelegs
forall a. (a -> ()) -> NFData a
$crnf :: GenDelegs -> ()
rnf :: GenDelegs -> ()
NFData, (forall x. GenDelegs -> Rep GenDelegs x)
-> (forall x. Rep GenDelegs x -> GenDelegs) -> Generic GenDelegs
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
$cfrom :: forall x. GenDelegs -> Rep GenDelegs x
from :: forall x. GenDelegs -> Rep GenDelegs x
$cto :: forall x. Rep GenDelegs x -> GenDelegs
to :: forall x. Rep GenDelegs x -> GenDelegs
Generic, Maybe GenDelegs
Value -> Parser [GenDelegs]
Value -> Parser GenDelegs
(Value -> Parser GenDelegs)
-> (Value -> Parser [GenDelegs])
-> Maybe GenDelegs
-> FromJSON GenDelegs
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GenDelegs
parseJSON :: Value -> Parser GenDelegs
$cparseJSONList :: Value -> Parser [GenDelegs]
parseJSONList :: Value -> Parser [GenDelegs]
$comittedField :: Maybe GenDelegs
omittedField :: Maybe GenDelegs
FromJSON, [GenDelegs] -> Value
[GenDelegs] -> Encoding
GenDelegs -> Bool
GenDelegs -> Value
GenDelegs -> Encoding
(GenDelegs -> Value)
-> (GenDelegs -> Encoding)
-> ([GenDelegs] -> Value)
-> ([GenDelegs] -> Encoding)
-> (GenDelegs -> Bool)
-> ToJSON GenDelegs
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GenDelegs -> Value
toJSON :: GenDelegs -> Value
$ctoEncoding :: GenDelegs -> Encoding
toEncoding :: GenDelegs -> Encoding
$ctoJSONList :: [GenDelegs] -> Value
toJSONList :: [GenDelegs] -> Value
$ctoEncodingList :: [GenDelegs] -> Encoding
toEncodingList :: [GenDelegs] -> Encoding
$comitField :: GenDelegs -> Bool
omitField :: GenDelegs -> Bool
ToJSON)
  deriving (Int -> GenDelegs -> ShowS
[GenDelegs] -> ShowS
GenDelegs -> String
(Int -> GenDelegs -> ShowS)
-> (GenDelegs -> String)
-> ([GenDelegs] -> ShowS)
-> Show GenDelegs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenDelegs -> ShowS
showsPrec :: Int -> GenDelegs -> ShowS
$cshow :: GenDelegs -> String
show :: GenDelegs -> String
$cshowList :: [GenDelegs] -> ShowS
showList :: [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
[SafeHash i] -> ShowS
SafeHash i -> String
(Int -> SafeHash i -> ShowS)
-> (SafeHash i -> String)
-> ([SafeHash i] -> ShowS)
-> Show (SafeHash i)
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
$cshowsPrec :: forall i. Int -> SafeHash i -> ShowS
showsPrec :: Int -> SafeHash i -> ShowS
$cshow :: forall i. SafeHash i -> String
show :: SafeHash i -> String
$cshowList :: forall i. [SafeHash i] -> ShowS
showList :: [SafeHash i] -> ShowS
Show
    , SafeHash i -> SafeHash i -> Bool
(SafeHash i -> SafeHash i -> Bool)
-> (SafeHash i -> SafeHash i -> Bool) -> Eq (SafeHash i)
forall i. SafeHash i -> SafeHash i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
Eq
    , Eq (SafeHash i)
Eq (SafeHash i) =>
(SafeHash i -> SafeHash i -> Ordering)
-> (SafeHash i -> SafeHash i -> Bool)
-> (SafeHash i -> SafeHash i -> Bool)
-> (SafeHash i -> SafeHash i -> Bool)
-> (SafeHash i -> SafeHash i -> Bool)
-> (SafeHash i -> SafeHash i -> SafeHash i)
-> (SafeHash i -> SafeHash i -> SafeHash i)
-> Ord (SafeHash i)
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
$ccompare :: forall i. SafeHash i -> SafeHash i -> Ordering
compare :: SafeHash i -> SafeHash i -> Ordering
$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
>= :: SafeHash i -> SafeHash i -> Bool
$cmax :: forall i. SafeHash i -> SafeHash i -> SafeHash i
max :: SafeHash i -> SafeHash i -> SafeHash i
$cmin :: forall i. SafeHash i -> SafeHash i -> SafeHash i
min :: SafeHash i -> SafeHash i -> SafeHash i
Ord
    , Context -> SafeHash i -> IO (Maybe ThunkInfo)
Proxy (SafeHash i) -> String
(Context -> SafeHash i -> IO (Maybe ThunkInfo))
-> (Context -> SafeHash i -> IO (Maybe ThunkInfo))
-> (Proxy (SafeHash i) -> String)
-> NoThunks (SafeHash i)
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
$cnoThunks :: forall i. Context -> SafeHash i -> IO (Maybe ThunkInfo)
noThunks :: Context -> SafeHash i -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall i. Context -> SafeHash i -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SafeHash i -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall i. Proxy (SafeHash i) -> String
showTypeOf :: Proxy (SafeHash i) -> String
NoThunks
    , SafeHash i -> ()
(SafeHash i -> ()) -> NFData (SafeHash i)
forall i. SafeHash i -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall i. SafeHash i -> ()
rnf :: SafeHash i -> ()
NFData
    , SafeHash i -> Int
SafeHash i -> ByteString
(SafeHash i -> ByteString)
-> (SafeHash i -> Int)
-> (forall i. Proxy i -> SafeHash i -> SafeHash i)
-> SafeToHash (SafeHash i)
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
$coriginalBytes :: forall i. SafeHash i -> ByteString
originalBytes :: SafeHash i -> ByteString
$coriginalBytesSize :: forall i. SafeHash i -> Int
originalBytesSize :: SafeHash i -> Int
$cmakeHashWithExplicitProxys :: forall i i. Proxy i -> SafeHash i -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> SafeHash i -> SafeHash i
SafeToHash
    , Typeable (SafeHash i)
Typeable (SafeHash i) =>
(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)
-> ToCBOR (SafeHash i)
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
$ctoCBOR :: forall i. Typeable i => SafeHash i -> Encoding
toCBOR :: SafeHash i -> Encoding
$cencodedSizeExpr :: 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
$cencodedListSizeExpr :: 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
ToCBOR
    , Typeable (SafeHash i)
Typeable (SafeHash i) =>
(forall s. Decoder s (SafeHash i))
-> (Proxy (SafeHash i) -> Text) -> FromCBOR (SafeHash i)
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)
$cfromCBOR :: forall i s. Typeable i => Decoder s (SafeHash i)
fromCBOR :: forall s. Decoder s (SafeHash i)
$clabel :: forall i. Typeable i => Proxy (SafeHash i) -> Text
label :: Proxy (SafeHash i) -> Text
FromCBOR
    , Typeable (SafeHash i)
Typeable (SafeHash i) =>
(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)
-> EncCBOR (SafeHash i)
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
$cencCBOR :: forall i. Typeable i => SafeHash i -> Encoding
encCBOR :: SafeHash i -> Encoding
$cencodedSizeExpr :: 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
$cencodedListSizeExpr :: 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
EncCBOR
    , Typeable (SafeHash i)
Typeable (SafeHash i) =>
(forall s. Decoder s (SafeHash i))
-> (forall s. Proxy (SafeHash i) -> Decoder s ())
-> (Proxy (SafeHash i) -> Text)
-> DecCBOR (SafeHash i)
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 ()
$cdecCBOR :: forall i s. Typeable i => Decoder s (SafeHash i)
decCBOR :: forall s. Decoder s (SafeHash i)
$cdropCBOR :: forall i s. Typeable i => Proxy (SafeHash i) -> Decoder s ()
dropCBOR :: forall s. Proxy (SafeHash i) -> Decoder s ()
$clabel :: forall i. Typeable i => Proxy (SafeHash i) -> Text
label :: Proxy (SafeHash i) -> Text
DecCBOR
    , [SafeHash i] -> Value
[SafeHash i] -> Encoding
SafeHash i -> Bool
SafeHash i -> Value
SafeHash i -> Encoding
(SafeHash i -> Value)
-> (SafeHash i -> Encoding)
-> ([SafeHash i] -> Value)
-> ([SafeHash i] -> Encoding)
-> (SafeHash i -> Bool)
-> ToJSON (SafeHash i)
forall i. [SafeHash i] -> Value
forall i. [SafeHash i] -> Encoding
forall i. SafeHash i -> Bool
forall i. SafeHash i -> Value
forall i. SafeHash i -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall i. SafeHash i -> Value
toJSON :: SafeHash i -> Value
$ctoEncoding :: forall i. SafeHash i -> Encoding
toEncoding :: SafeHash i -> Encoding
$ctoJSONList :: forall i. [SafeHash i] -> Value
toJSONList :: [SafeHash i] -> Value
$ctoEncodingList :: forall i. [SafeHash i] -> Encoding
toEncodingList :: [SafeHash i] -> Encoding
$comitField :: forall i. SafeHash i -> Bool
omitField :: SafeHash i -> Bool
ToJSON
    , Maybe (SafeHash i)
Value -> Parser [SafeHash i]
Value -> Parser (SafeHash i)
(Value -> Parser (SafeHash i))
-> (Value -> Parser [SafeHash i])
-> Maybe (SafeHash i)
-> FromJSON (SafeHash i)
forall i. Maybe (SafeHash i)
forall i. Value -> Parser [SafeHash i]
forall i. Value -> Parser (SafeHash i)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall i. Value -> Parser (SafeHash i)
parseJSON :: Value -> Parser (SafeHash i)
$cparseJSONList :: forall i. Value -> Parser [SafeHash i]
parseJSONList :: Value -> Parser [SafeHash i]
$comittedField :: forall i. Maybe (SafeHash i)
omittedField :: Maybe (SafeHash i)
FromJSON
    , String
String
-> (SafeHash i -> Int)
-> (forall s. SafeHash i -> Pack s ())
-> (forall b. Buffer b => Unpack b (SafeHash i))
-> MemPack (SafeHash i)
SafeHash i -> Int
forall i. String
forall a.
String
-> (a -> Int)
-> (forall s. a -> Pack s ())
-> (forall b. Buffer b => Unpack b a)
-> MemPack a
forall b. Buffer b => Unpack b (SafeHash i)
forall i. SafeHash i -> Int
forall s. SafeHash i -> Pack s ()
forall i b. Buffer b => Unpack b (SafeHash i)
forall i s. SafeHash i -> Pack s ()
$ctypeName :: forall i. String
typeName :: String
$cpackedByteCount :: forall i. SafeHash i -> Int
packedByteCount :: SafeHash i -> Int
$cpackM :: forall i s. SafeHash i -> Pack s ()
packM :: forall s. SafeHash i -> Pack s ()
$cunpackM :: forall i b. Buffer b => Unpack b (SafeHash i)
unpackM :: forall b. Buffer b => Unpack b (SafeHash i)
MemPack
    )

instance Default (SafeHash i) where
  def :: SafeHash i
def = Hash HASH i -> SafeHash i
forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash Hash HASH i
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 = Hash HASH i -> SafeHash i
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 (ByteString -> Int) -> (t -> ByteString) -> t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ByteString
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 = Hash HASH i -> SafeHash i
forall i. Hash HASH i -> SafeHash i
SafeHash (Hash HASH i -> SafeHash i) -> Hash HASH i -> SafeHash i
forall a b. (a -> b) -> a -> b
$ Hash HASH t -> Hash HASH i
forall h a b. Hash h a -> Hash h b
Hash.castHash ((t -> ByteString) -> t -> Hash HASH t
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith t -> ByteString
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 = Hash h i -> ByteString
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 = Proxy i -> x -> SafeHash i
forall i. Proxy i -> x -> SafeHash i
forall t i. SafeToHash t => Proxy i -> t -> SafeHash i
makeHashWithExplicitProxys (forall t. Proxy t
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) = Hash HASH j -> SafeHash j
forall i. Hash HASH i -> SafeHash i
SafeHash (Hash HASH i -> Hash HASH j
forall h a b. Hash h a -> Hash h b
Hash.castHash Hash HASH i
h)