{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- DUPLICATE -- adapted from: cardano-api/src/Cardano/Api/KeysPraos.hs

-- | Praos consensus key types and their 'Key' class instances
module Cardano.Api.KeysPraos
  ( -- * Key types
    UnsoundPureKesKey
  , VrfKey

    -- * Data family instances
  , AsType (..)
  , Hash (..)
  , SigningKey (..)
  , VerificationKey (..)
  ) where

import Cardano.Api.Any
import Cardano.Api.Key
import Cardano.Api.SerialiseTextEnvelope
import Cardano.Api.SerialiseUsing
import qualified Cardano.Crypto.DSIGN.Class as Crypto
import qualified Cardano.Crypto.Hash.Class as Crypto
import qualified Cardano.Crypto.KES.Class as Crypto
import qualified Cardano.Crypto.VRF.Class as Crypto
import Cardano.Ledger.Hashes (HASH)
import Cardano.Protocol.Crypto (Crypto (..), StandardCrypto)
import Data.String (IsString (..))

--
-- KES keys
--

data UnsoundPureKesKey

instance HasTypeProxy UnsoundPureKesKey where
  data AsType UnsoundPureKesKey = AsUnsoundPureKesKey
  proxyToAsType :: Proxy UnsoundPureKesKey -> AsType UnsoundPureKesKey
proxyToAsType Proxy UnsoundPureKesKey
_ = AsType UnsoundPureKesKey
AsUnsoundPureKesKey

instance Key UnsoundPureKesKey where
  newtype VerificationKey UnsoundPureKesKey
    = KesVerificationKey (Crypto.VerKeyKES (KES StandardCrypto))
    deriving stock VerificationKey UnsoundPureKesKey
-> VerificationKey UnsoundPureKesKey -> Bool
(VerificationKey UnsoundPureKesKey
 -> VerificationKey UnsoundPureKesKey -> Bool)
-> (VerificationKey UnsoundPureKesKey
    -> VerificationKey UnsoundPureKesKey -> Bool)
-> Eq (VerificationKey UnsoundPureKesKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey UnsoundPureKesKey
-> VerificationKey UnsoundPureKesKey -> Bool
== :: VerificationKey UnsoundPureKesKey
-> VerificationKey UnsoundPureKesKey -> Bool
$c/= :: VerificationKey UnsoundPureKesKey
-> VerificationKey UnsoundPureKesKey -> Bool
/= :: VerificationKey UnsoundPureKesKey
-> VerificationKey UnsoundPureKesKey -> Bool
Eq
    deriving (Int -> VerificationKey UnsoundPureKesKey -> ShowS
[VerificationKey UnsoundPureKesKey] -> ShowS
VerificationKey UnsoundPureKesKey -> String
(Int -> VerificationKey UnsoundPureKesKey -> ShowS)
-> (VerificationKey UnsoundPureKesKey -> String)
-> ([VerificationKey UnsoundPureKesKey] -> ShowS)
-> Show (VerificationKey UnsoundPureKesKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey UnsoundPureKesKey -> ShowS
showsPrec :: Int -> VerificationKey UnsoundPureKesKey -> ShowS
$cshow :: VerificationKey UnsoundPureKesKey -> String
show :: VerificationKey UnsoundPureKesKey -> String
$cshowList :: [VerificationKey UnsoundPureKesKey] -> ShowS
showList :: [VerificationKey UnsoundPureKesKey] -> ShowS
Show, String -> VerificationKey UnsoundPureKesKey
(String -> VerificationKey UnsoundPureKesKey)
-> IsString (VerificationKey UnsoundPureKesKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey UnsoundPureKesKey
fromString :: String -> VerificationKey UnsoundPureKesKey
IsString) via UsingRawBytesHex (VerificationKey UnsoundPureKesKey)
    deriving newtype (Typeable (VerificationKey UnsoundPureKesKey)
Typeable (VerificationKey UnsoundPureKesKey) =>
(VerificationKey UnsoundPureKesKey -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy (VerificationKey UnsoundPureKesKey) -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [VerificationKey UnsoundPureKesKey] -> Size)
-> EncCBOR (VerificationKey UnsoundPureKesKey)
VerificationKey UnsoundPureKesKey -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey UnsoundPureKesKey] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey UnsoundPureKesKey) -> 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 :: VerificationKey UnsoundPureKesKey -> Encoding
encCBOR :: VerificationKey UnsoundPureKesKey -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey UnsoundPureKesKey) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey UnsoundPureKesKey) -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey UnsoundPureKesKey] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey UnsoundPureKesKey] -> Size
EncCBOR, Typeable (VerificationKey UnsoundPureKesKey)
Typeable (VerificationKey UnsoundPureKesKey) =>
(forall s. Decoder s (VerificationKey UnsoundPureKesKey))
-> (forall s.
    Proxy (VerificationKey UnsoundPureKesKey) -> Decoder s ())
-> (Proxy (VerificationKey UnsoundPureKesKey) -> Text)
-> DecCBOR (VerificationKey UnsoundPureKesKey)
Proxy (VerificationKey UnsoundPureKesKey) -> Text
forall s. Decoder s (VerificationKey UnsoundPureKesKey)
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (VerificationKey UnsoundPureKesKey) -> Decoder s ()
$cdecCBOR :: forall s. Decoder s (VerificationKey UnsoundPureKesKey)
decCBOR :: forall s. Decoder s (VerificationKey UnsoundPureKesKey)
$cdropCBOR :: forall s. Proxy (VerificationKey UnsoundPureKesKey) -> Decoder s ()
dropCBOR :: forall s. Proxy (VerificationKey UnsoundPureKesKey) -> Decoder s ()
$clabel :: Proxy (VerificationKey UnsoundPureKesKey) -> Text
label :: Proxy (VerificationKey UnsoundPureKesKey) -> Text
DecCBOR, Typeable (VerificationKey UnsoundPureKesKey)
Typeable (VerificationKey UnsoundPureKesKey) =>
(VerificationKey UnsoundPureKesKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (VerificationKey UnsoundPureKesKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [VerificationKey UnsoundPureKesKey] -> Size)
-> ToCBOR (VerificationKey UnsoundPureKesKey)
VerificationKey UnsoundPureKesKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey UnsoundPureKesKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey UnsoundPureKesKey) -> 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 :: VerificationKey UnsoundPureKesKey -> Encoding
toCBOR :: VerificationKey UnsoundPureKesKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey UnsoundPureKesKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey UnsoundPureKesKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey UnsoundPureKesKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey UnsoundPureKesKey] -> Size
ToCBOR, Typeable (VerificationKey UnsoundPureKesKey)
Typeable (VerificationKey UnsoundPureKesKey) =>
(forall s. Decoder s (VerificationKey UnsoundPureKesKey))
-> (Proxy (VerificationKey UnsoundPureKesKey) -> Text)
-> FromCBOR (VerificationKey UnsoundPureKesKey)
Proxy (VerificationKey UnsoundPureKesKey) -> Text
forall s. Decoder s (VerificationKey UnsoundPureKesKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (VerificationKey UnsoundPureKesKey)
fromCBOR :: forall s. Decoder s (VerificationKey UnsoundPureKesKey)
$clabel :: Proxy (VerificationKey UnsoundPureKesKey) -> Text
label :: Proxy (VerificationKey UnsoundPureKesKey) -> Text
FromCBOR)
    deriving anyclass HasTypeProxy (VerificationKey UnsoundPureKesKey)
HasTypeProxy (VerificationKey UnsoundPureKesKey) =>
(VerificationKey UnsoundPureKesKey -> ByteString)
-> (AsType (VerificationKey UnsoundPureKesKey)
    -> ByteString
    -> Either DecoderError (VerificationKey UnsoundPureKesKey))
-> SerialiseAsCBOR (VerificationKey UnsoundPureKesKey)
AsType (VerificationKey UnsoundPureKesKey)
-> ByteString
-> Either DecoderError (VerificationKey UnsoundPureKesKey)
VerificationKey UnsoundPureKesKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey UnsoundPureKesKey -> ByteString
serialiseToCBOR :: VerificationKey UnsoundPureKesKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey UnsoundPureKesKey)
-> ByteString
-> Either DecoderError (VerificationKey UnsoundPureKesKey)
deserialiseFromCBOR :: AsType (VerificationKey UnsoundPureKesKey)
-> ByteString
-> Either DecoderError (VerificationKey UnsoundPureKesKey)
SerialiseAsCBOR

  newtype SigningKey UnsoundPureKesKey
    = KesSigningKey (Crypto.UnsoundPureSignKeyKES (KES StandardCrypto))
    deriving (Int -> SigningKey UnsoundPureKesKey -> ShowS
[SigningKey UnsoundPureKesKey] -> ShowS
SigningKey UnsoundPureKesKey -> String
(Int -> SigningKey UnsoundPureKesKey -> ShowS)
-> (SigningKey UnsoundPureKesKey -> String)
-> ([SigningKey UnsoundPureKesKey] -> ShowS)
-> Show (SigningKey UnsoundPureKesKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey UnsoundPureKesKey -> ShowS
showsPrec :: Int -> SigningKey UnsoundPureKesKey -> ShowS
$cshow :: SigningKey UnsoundPureKesKey -> String
show :: SigningKey UnsoundPureKesKey -> String
$cshowList :: [SigningKey UnsoundPureKesKey] -> ShowS
showList :: [SigningKey UnsoundPureKesKey] -> ShowS
Show, String -> SigningKey UnsoundPureKesKey
(String -> SigningKey UnsoundPureKesKey)
-> IsString (SigningKey UnsoundPureKesKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> SigningKey UnsoundPureKesKey
fromString :: String -> SigningKey UnsoundPureKesKey
IsString) via UsingRawBytesHex (SigningKey UnsoundPureKesKey)
    deriving newtype (Typeable (SigningKey UnsoundPureKesKey)
Typeable (SigningKey UnsoundPureKesKey) =>
(SigningKey UnsoundPureKesKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (SigningKey UnsoundPureKesKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SigningKey UnsoundPureKesKey] -> Size)
-> ToCBOR (SigningKey UnsoundPureKesKey)
SigningKey UnsoundPureKesKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey UnsoundPureKesKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey UnsoundPureKesKey) -> 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 :: SigningKey UnsoundPureKesKey -> Encoding
toCBOR :: SigningKey UnsoundPureKesKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey UnsoundPureKesKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey UnsoundPureKesKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey UnsoundPureKesKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey UnsoundPureKesKey] -> Size
ToCBOR, Typeable (SigningKey UnsoundPureKesKey)
Typeable (SigningKey UnsoundPureKesKey) =>
(forall s. Decoder s (SigningKey UnsoundPureKesKey))
-> (Proxy (SigningKey UnsoundPureKesKey) -> Text)
-> FromCBOR (SigningKey UnsoundPureKesKey)
Proxy (SigningKey UnsoundPureKesKey) -> Text
forall s. Decoder s (SigningKey UnsoundPureKesKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (SigningKey UnsoundPureKesKey)
fromCBOR :: forall s. Decoder s (SigningKey UnsoundPureKesKey)
$clabel :: Proxy (SigningKey UnsoundPureKesKey) -> Text
label :: Proxy (SigningKey UnsoundPureKesKey) -> Text
FromCBOR)
    deriving anyclass (Typeable (SigningKey UnsoundPureKesKey)
Typeable (SigningKey UnsoundPureKesKey) =>
(SigningKey UnsoundPureKesKey -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy (SigningKey UnsoundPureKesKey) -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [SigningKey UnsoundPureKesKey] -> Size)
-> EncCBOR (SigningKey UnsoundPureKesKey)
SigningKey UnsoundPureKesKey -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SigningKey UnsoundPureKesKey] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (SigningKey UnsoundPureKesKey) -> 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 :: SigningKey UnsoundPureKesKey -> Encoding
encCBOR :: SigningKey UnsoundPureKesKey -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (SigningKey UnsoundPureKesKey) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (SigningKey UnsoundPureKesKey) -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SigningKey UnsoundPureKesKey] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SigningKey UnsoundPureKesKey] -> Size
EncCBOR, Typeable (SigningKey UnsoundPureKesKey)
Typeable (SigningKey UnsoundPureKesKey) =>
(forall s. Decoder s (SigningKey UnsoundPureKesKey))
-> (forall s. Proxy (SigningKey UnsoundPureKesKey) -> Decoder s ())
-> (Proxy (SigningKey UnsoundPureKesKey) -> Text)
-> DecCBOR (SigningKey UnsoundPureKesKey)
Proxy (SigningKey UnsoundPureKesKey) -> Text
forall s. Decoder s (SigningKey UnsoundPureKesKey)
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (SigningKey UnsoundPureKesKey) -> Decoder s ()
$cdecCBOR :: forall s. Decoder s (SigningKey UnsoundPureKesKey)
decCBOR :: forall s. Decoder s (SigningKey UnsoundPureKesKey)
$cdropCBOR :: forall s. Proxy (SigningKey UnsoundPureKesKey) -> Decoder s ()
dropCBOR :: forall s. Proxy (SigningKey UnsoundPureKesKey) -> Decoder s ()
$clabel :: Proxy (SigningKey UnsoundPureKesKey) -> Text
label :: Proxy (SigningKey UnsoundPureKesKey) -> Text
DecCBOR, HasTypeProxy (SigningKey UnsoundPureKesKey)
HasTypeProxy (SigningKey UnsoundPureKesKey) =>
(SigningKey UnsoundPureKesKey -> ByteString)
-> (AsType (SigningKey UnsoundPureKesKey)
    -> ByteString
    -> Either DecoderError (SigningKey UnsoundPureKesKey))
-> SerialiseAsCBOR (SigningKey UnsoundPureKesKey)
AsType (SigningKey UnsoundPureKesKey)
-> ByteString -> Either DecoderError (SigningKey UnsoundPureKesKey)
SigningKey UnsoundPureKesKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey UnsoundPureKesKey -> ByteString
serialiseToCBOR :: SigningKey UnsoundPureKesKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey UnsoundPureKesKey)
-> ByteString -> Either DecoderError (SigningKey UnsoundPureKesKey)
deserialiseFromCBOR :: AsType (SigningKey UnsoundPureKesKey)
-> ByteString -> Either DecoderError (SigningKey UnsoundPureKesKey)
SerialiseAsCBOR)

  -- This loses the mlock safety of the seed, since it starts from a normal in-memory seed.
  deterministicSigningKey :: AsType UnsoundPureKesKey -> Crypto.Seed -> SigningKey UnsoundPureKesKey
  deterministicSigningKey :: AsType UnsoundPureKesKey -> Seed -> SigningKey UnsoundPureKesKey
deterministicSigningKey AsType UnsoundPureKesKey
R:AsTypeUnsoundPureKesKey
AsUnsoundPureKesKey =
    UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> SigningKey UnsoundPureKesKey
UnsoundPureSignKeyKES (KES StandardCrypto)
-> SigningKey UnsoundPureKesKey
KesSigningKey (UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
 -> SigningKey UnsoundPureKesKey)
-> (Seed
    -> UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256))
-> Seed
-> SigningKey UnsoundPureKesKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seed -> UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
forall v.
UnsoundPureKESAlgorithm v =>
Seed -> UnsoundPureSignKeyKES v
Crypto.unsoundPureGenKeyKES

  deterministicSigningKeySeedSize :: AsType UnsoundPureKesKey -> Word
  deterministicSigningKeySeedSize :: AsType UnsoundPureKesKey -> Word
deterministicSigningKeySeedSize AsType UnsoundPureKesKey
R:AsTypeUnsoundPureKesKey
AsUnsoundPureKesKey =
    Proxy (Sum6KES Ed25519DSIGN Blake2b_256) -> Word
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
Crypto.seedSizeKES Proxy (Sum6KES Ed25519DSIGN Blake2b_256)
Proxy (KES StandardCrypto)
proxy
   where
    proxy :: Proxy (KES StandardCrypto)
    proxy :: Proxy (KES StandardCrypto)
proxy = Proxy (Sum6KES Ed25519DSIGN Blake2b_256)
Proxy (KES StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

  getVerificationKey :: SigningKey UnsoundPureKesKey -> VerificationKey UnsoundPureKesKey
  getVerificationKey :: SigningKey UnsoundPureKesKey -> VerificationKey UnsoundPureKesKey
getVerificationKey (KesSigningKey UnsoundPureSignKeyKES (KES StandardCrypto)
sk) =
    VerKeyKES (KES StandardCrypto) -> VerificationKey UnsoundPureKesKey
KesVerificationKey (UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> VerKeyKES v
Crypto.unsoundPureDeriveVerKeyKES UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
UnsoundPureSignKeyKES (KES StandardCrypto)
sk)

  verificationKeyHash :: VerificationKey UnsoundPureKesKey -> Hash UnsoundPureKesKey
  verificationKeyHash :: VerificationKey UnsoundPureKesKey -> Hash UnsoundPureKesKey
verificationKeyHash (KesVerificationKey VerKeyKES (KES StandardCrypto)
vkey) =
    Hash Blake2b_256 (VerKeyKES (KES StandardCrypto))
-> Hash UnsoundPureKesKey
UnsoundPureKesKeyHash (VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> Hash Blake2b_256 (VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256))
forall h.
HashAlgorithm h =>
VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> Hash h (VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256))
forall v h.
(KESAlgorithm v, HashAlgorithm h) =>
VerKeyKES v -> Hash h (VerKeyKES v)
Crypto.hashVerKeyKES VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
VerKeyKES (KES StandardCrypto)
vkey)

instance SerialiseAsRawBytes (VerificationKey UnsoundPureKesKey) where
  serialiseToRawBytes :: VerificationKey UnsoundPureKesKey -> ByteString
serialiseToRawBytes (KesVerificationKey VerKeyKES (KES StandardCrypto)
vk) =
    VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256) -> ByteString
forall v. KESAlgorithm v => VerKeyKES v -> ByteString
Crypto.rawSerialiseVerKeyKES VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
VerKeyKES (KES StandardCrypto)
vk

  deserialiseFromRawBytes :: AsType (VerificationKey UnsoundPureKesKey)
-> ByteString -> Maybe (VerificationKey UnsoundPureKesKey)
deserialiseFromRawBytes (AsVerificationKey AsType UnsoundPureKesKey
R:AsTypeUnsoundPureKesKey
AsUnsoundPureKesKey) ByteString
bs =
    VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> VerificationKey UnsoundPureKesKey
VerKeyKES (KES StandardCrypto) -> VerificationKey UnsoundPureKesKey
KesVerificationKey
      (VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
 -> VerificationKey UnsoundPureKesKey)
-> Maybe (VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256))
-> Maybe (VerificationKey UnsoundPureKesKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256))
forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
Crypto.rawDeserialiseVerKeyKES ByteString
bs

instance SerialiseAsRawBytes (SigningKey UnsoundPureKesKey) where
  serialiseToRawBytes :: SigningKey UnsoundPureKesKey -> ByteString
serialiseToRawBytes (KesSigningKey UnsoundPureSignKeyKES (KES StandardCrypto)
sk) =
    UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> ByteString
forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> ByteString
Crypto.rawSerialiseUnsoundPureSignKeyKES UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
UnsoundPureSignKeyKES (KES StandardCrypto)
sk

  deserialiseFromRawBytes :: AsType (SigningKey UnsoundPureKesKey)
-> ByteString -> Maybe (SigningKey UnsoundPureKesKey)
deserialiseFromRawBytes (AsSigningKey AsType UnsoundPureKesKey
R:AsTypeUnsoundPureKesKey
AsUnsoundPureKesKey) ByteString
bs =
    UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> SigningKey UnsoundPureKesKey
UnsoundPureSignKeyKES (KES StandardCrypto)
-> SigningKey UnsoundPureKesKey
KesSigningKey (UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
 -> SigningKey UnsoundPureKesKey)
-> Maybe (UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256))
-> Maybe (SigningKey UnsoundPureKesKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> Maybe (UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN Blake2b_256))
forall v.
UnsoundPureKESAlgorithm v =>
ByteString -> Maybe (UnsoundPureSignKeyKES v)
Crypto.rawDeserialiseUnsoundPureSignKeyKES ByteString
bs

instance SerialiseAsBech32 (VerificationKey UnsoundPureKesKey) where
  bech32PrefixFor :: VerificationKey UnsoundPureKesKey -> Text
bech32PrefixFor VerificationKey UnsoundPureKesKey
_ = Text
"kes_vk"
  bech32PrefixesPermitted :: AsType (VerificationKey UnsoundPureKesKey) -> [Text]
bech32PrefixesPermitted AsType (VerificationKey UnsoundPureKesKey)
_ = [Text
"kes_vk"]

instance SerialiseAsBech32 (SigningKey UnsoundPureKesKey) where
  bech32PrefixFor :: SigningKey UnsoundPureKesKey -> Text
bech32PrefixFor SigningKey UnsoundPureKesKey
_ = Text
"kes_sk"
  bech32PrefixesPermitted :: AsType (SigningKey UnsoundPureKesKey) -> [Text]
bech32PrefixesPermitted AsType (SigningKey UnsoundPureKesKey)
_ = [Text
"kes_sk"]

newtype instance Hash UnsoundPureKesKey
  = UnsoundPureKesKeyHash
      ( Crypto.Hash
          HASH
          (Crypto.VerKeyKES (KES StandardCrypto))
      )
  deriving stock (Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
(Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool)
-> (Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool)
-> Eq (Hash UnsoundPureKesKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
== :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
$c/= :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
/= :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
Eq, Eq (Hash UnsoundPureKesKey)
Eq (Hash UnsoundPureKesKey) =>
(Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Ordering)
-> (Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool)
-> (Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool)
-> (Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool)
-> (Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool)
-> (Hash UnsoundPureKesKey
    -> Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey)
-> (Hash UnsoundPureKesKey
    -> Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey)
-> Ord (Hash UnsoundPureKesKey)
Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Ordering
Hash UnsoundPureKesKey
-> Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey
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 :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Ordering
compare :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Ordering
$c< :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
< :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
$c<= :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
<= :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
$c> :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
> :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
$c>= :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
>= :: Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey -> Bool
$cmax :: Hash UnsoundPureKesKey
-> Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey
max :: Hash UnsoundPureKesKey
-> Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey
$cmin :: Hash UnsoundPureKesKey
-> Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey
min :: Hash UnsoundPureKesKey
-> Hash UnsoundPureKesKey -> Hash UnsoundPureKesKey
Ord)
  deriving (Int -> Hash UnsoundPureKesKey -> ShowS
[Hash UnsoundPureKesKey] -> ShowS
Hash UnsoundPureKesKey -> String
(Int -> Hash UnsoundPureKesKey -> ShowS)
-> (Hash UnsoundPureKesKey -> String)
-> ([Hash UnsoundPureKesKey] -> ShowS)
-> Show (Hash UnsoundPureKesKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash UnsoundPureKesKey -> ShowS
showsPrec :: Int -> Hash UnsoundPureKesKey -> ShowS
$cshow :: Hash UnsoundPureKesKey -> String
show :: Hash UnsoundPureKesKey -> String
$cshowList :: [Hash UnsoundPureKesKey] -> ShowS
showList :: [Hash UnsoundPureKesKey] -> ShowS
Show, String -> Hash UnsoundPureKesKey
(String -> Hash UnsoundPureKesKey)
-> IsString (Hash UnsoundPureKesKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash UnsoundPureKesKey
fromString :: String -> Hash UnsoundPureKesKey
IsString) via UsingRawBytesHex (Hash UnsoundPureKesKey)
  deriving (Typeable (Hash UnsoundPureKesKey)
Typeable (Hash UnsoundPureKesKey) =>
(Hash UnsoundPureKesKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Hash UnsoundPureKesKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Hash UnsoundPureKesKey] -> Size)
-> ToCBOR (Hash UnsoundPureKesKey)
Hash UnsoundPureKesKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash UnsoundPureKesKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash UnsoundPureKesKey) -> 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 :: Hash UnsoundPureKesKey -> Encoding
toCBOR :: Hash UnsoundPureKesKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash UnsoundPureKesKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash UnsoundPureKesKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash UnsoundPureKesKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash UnsoundPureKesKey] -> Size
ToCBOR, Typeable (Hash UnsoundPureKesKey)
Typeable (Hash UnsoundPureKesKey) =>
(forall s. Decoder s (Hash UnsoundPureKesKey))
-> (Proxy (Hash UnsoundPureKesKey) -> Text)
-> FromCBOR (Hash UnsoundPureKesKey)
Proxy (Hash UnsoundPureKesKey) -> Text
forall s. Decoder s (Hash UnsoundPureKesKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (Hash UnsoundPureKesKey)
fromCBOR :: forall s. Decoder s (Hash UnsoundPureKesKey)
$clabel :: Proxy (Hash UnsoundPureKesKey) -> Text
label :: Proxy (Hash UnsoundPureKesKey) -> Text
FromCBOR) via UsingRawBytes (Hash UnsoundPureKesKey)
  deriving anyclass HasTypeProxy (Hash UnsoundPureKesKey)
Hash UnsoundPureKesKey -> ByteString
HasTypeProxy (Hash UnsoundPureKesKey) =>
(Hash UnsoundPureKesKey -> ByteString)
-> (AsType (Hash UnsoundPureKesKey)
    -> ByteString -> Either DecoderError (Hash UnsoundPureKesKey))
-> SerialiseAsCBOR (Hash UnsoundPureKesKey)
AsType (Hash UnsoundPureKesKey)
-> ByteString -> Either DecoderError (Hash UnsoundPureKesKey)
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: Hash UnsoundPureKesKey -> ByteString
serialiseToCBOR :: Hash UnsoundPureKesKey -> ByteString
$cdeserialiseFromCBOR :: AsType (Hash UnsoundPureKesKey)
-> ByteString -> Either DecoderError (Hash UnsoundPureKesKey)
deserialiseFromCBOR :: AsType (Hash UnsoundPureKesKey)
-> ByteString -> Either DecoderError (Hash UnsoundPureKesKey)
SerialiseAsCBOR

instance SerialiseAsRawBytes (Hash UnsoundPureKesKey) where
  serialiseToRawBytes :: Hash UnsoundPureKesKey -> ByteString
serialiseToRawBytes (UnsoundPureKesKeyHash Hash Blake2b_256 (VerKeyKES (KES StandardCrypto))
vkh) =
    Hash Blake2b_256 (VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256))
-> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_256 (VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256))
Hash Blake2b_256 (VerKeyKES (KES StandardCrypto))
vkh

  deserialiseFromRawBytes :: AsType (Hash UnsoundPureKesKey)
-> ByteString -> Maybe (Hash UnsoundPureKesKey)
deserialiseFromRawBytes (AsHash AsType UnsoundPureKesKey
R:AsTypeUnsoundPureKesKey
AsUnsoundPureKesKey) ByteString
bs =
    Hash Blake2b_256 (VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256))
-> Hash UnsoundPureKesKey
Hash Blake2b_256 (VerKeyKES (KES StandardCrypto))
-> Hash UnsoundPureKesKey
UnsoundPureKesKeyHash (Hash Blake2b_256 (VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256))
 -> Hash UnsoundPureKesKey)
-> Maybe
     (Hash Blake2b_256 (VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)))
-> Maybe (Hash UnsoundPureKesKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> Maybe
     (Hash Blake2b_256 (VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance HasTextEnvelope (VerificationKey UnsoundPureKesKey) where
  textEnvelopeType :: AsType (VerificationKey UnsoundPureKesKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey UnsoundPureKesKey)
_ =
    TextEnvelopeType
"KesVerificationKey_"
      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy (Sum6KES Ed25519DSIGN Blake2b_256) -> String
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> String
forall (proxy :: * -> *).
proxy (Sum6KES Ed25519DSIGN Blake2b_256) -> String
Crypto.algorithmNameKES Proxy (Sum6KES Ed25519DSIGN Blake2b_256)
Proxy (KES StandardCrypto)
proxy)
   where
    proxy :: Proxy (KES StandardCrypto)
    proxy :: Proxy (KES StandardCrypto)
proxy = Proxy (Sum6KES Ed25519DSIGN Blake2b_256)
Proxy (KES StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

instance HasTextEnvelope (SigningKey UnsoundPureKesKey) where
  textEnvelopeType :: AsType (SigningKey UnsoundPureKesKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey UnsoundPureKesKey)
_ =
    TextEnvelopeType
"KesSigningKey_"
      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy (Sum6KES Ed25519DSIGN Blake2b_256) -> String
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> String
forall (proxy :: * -> *).
proxy (Sum6KES Ed25519DSIGN Blake2b_256) -> String
Crypto.algorithmNameKES Proxy (Sum6KES Ed25519DSIGN Blake2b_256)
Proxy (KES StandardCrypto)
proxy)
   where
    proxy :: Proxy (KES StandardCrypto)
    proxy :: Proxy (KES StandardCrypto)
proxy = Proxy (Sum6KES Ed25519DSIGN Blake2b_256)
Proxy (KES StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

--
-- VRF keys
--

data VrfKey

instance HasTypeProxy VrfKey where
  data AsType VrfKey = AsVrfKey
  proxyToAsType :: Proxy VrfKey -> AsType VrfKey
proxyToAsType Proxy VrfKey
_ = AsType VrfKey
AsVrfKey

instance Key VrfKey where
  newtype VerificationKey VrfKey
    = VrfVerificationKey (Crypto.VerKeyVRF (VRF StandardCrypto))
    deriving stock VerificationKey VrfKey -> VerificationKey VrfKey -> Bool
(VerificationKey VrfKey -> VerificationKey VrfKey -> Bool)
-> (VerificationKey VrfKey -> VerificationKey VrfKey -> Bool)
-> Eq (VerificationKey VrfKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey VrfKey -> VerificationKey VrfKey -> Bool
== :: VerificationKey VrfKey -> VerificationKey VrfKey -> Bool
$c/= :: VerificationKey VrfKey -> VerificationKey VrfKey -> Bool
/= :: VerificationKey VrfKey -> VerificationKey VrfKey -> Bool
Eq
    deriving (Int -> VerificationKey VrfKey -> ShowS
[VerificationKey VrfKey] -> ShowS
VerificationKey VrfKey -> String
(Int -> VerificationKey VrfKey -> ShowS)
-> (VerificationKey VrfKey -> String)
-> ([VerificationKey VrfKey] -> ShowS)
-> Show (VerificationKey VrfKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey VrfKey -> ShowS
showsPrec :: Int -> VerificationKey VrfKey -> ShowS
$cshow :: VerificationKey VrfKey -> String
show :: VerificationKey VrfKey -> String
$cshowList :: [VerificationKey VrfKey] -> ShowS
showList :: [VerificationKey VrfKey] -> ShowS
Show, String -> VerificationKey VrfKey
(String -> VerificationKey VrfKey)
-> IsString (VerificationKey VrfKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey VrfKey
fromString :: String -> VerificationKey VrfKey
IsString) via UsingRawBytesHex (VerificationKey VrfKey)
    deriving newtype (Typeable (VerificationKey VrfKey)
Typeable (VerificationKey VrfKey) =>
(VerificationKey VrfKey -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy (VerificationKey VrfKey) -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [VerificationKey VrfKey] -> Size)
-> EncCBOR (VerificationKey VrfKey)
VerificationKey VrfKey -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey VrfKey] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey VrfKey) -> 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 :: VerificationKey VrfKey -> Encoding
encCBOR :: VerificationKey VrfKey -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey VrfKey) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey VrfKey) -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey VrfKey] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey VrfKey] -> Size
EncCBOR, Typeable (VerificationKey VrfKey)
Typeable (VerificationKey VrfKey) =>
(forall s. Decoder s (VerificationKey VrfKey))
-> (forall s. Proxy (VerificationKey VrfKey) -> Decoder s ())
-> (Proxy (VerificationKey VrfKey) -> Text)
-> DecCBOR (VerificationKey VrfKey)
Proxy (VerificationKey VrfKey) -> Text
forall s. Decoder s (VerificationKey VrfKey)
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (VerificationKey VrfKey) -> Decoder s ()
$cdecCBOR :: forall s. Decoder s (VerificationKey VrfKey)
decCBOR :: forall s. Decoder s (VerificationKey VrfKey)
$cdropCBOR :: forall s. Proxy (VerificationKey VrfKey) -> Decoder s ()
dropCBOR :: forall s. Proxy (VerificationKey VrfKey) -> Decoder s ()
$clabel :: Proxy (VerificationKey VrfKey) -> Text
label :: Proxy (VerificationKey VrfKey) -> Text
DecCBOR, Typeable (VerificationKey VrfKey)
Typeable (VerificationKey VrfKey) =>
(VerificationKey VrfKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (VerificationKey VrfKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [VerificationKey VrfKey] -> Size)
-> ToCBOR (VerificationKey VrfKey)
VerificationKey VrfKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey VrfKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey VrfKey) -> 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 :: VerificationKey VrfKey -> Encoding
toCBOR :: VerificationKey VrfKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey VrfKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey VrfKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey VrfKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey VrfKey] -> Size
ToCBOR, Typeable (VerificationKey VrfKey)
Typeable (VerificationKey VrfKey) =>
(forall s. Decoder s (VerificationKey VrfKey))
-> (Proxy (VerificationKey VrfKey) -> Text)
-> FromCBOR (VerificationKey VrfKey)
Proxy (VerificationKey VrfKey) -> Text
forall s. Decoder s (VerificationKey VrfKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (VerificationKey VrfKey)
fromCBOR :: forall s. Decoder s (VerificationKey VrfKey)
$clabel :: Proxy (VerificationKey VrfKey) -> Text
label :: Proxy (VerificationKey VrfKey) -> Text
FromCBOR)
    deriving anyclass HasTypeProxy (VerificationKey VrfKey)
HasTypeProxy (VerificationKey VrfKey) =>
(VerificationKey VrfKey -> ByteString)
-> (AsType (VerificationKey VrfKey)
    -> ByteString -> Either DecoderError (VerificationKey VrfKey))
-> SerialiseAsCBOR (VerificationKey VrfKey)
AsType (VerificationKey VrfKey)
-> ByteString -> Either DecoderError (VerificationKey VrfKey)
VerificationKey VrfKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey VrfKey -> ByteString
serialiseToCBOR :: VerificationKey VrfKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey VrfKey)
-> ByteString -> Either DecoderError (VerificationKey VrfKey)
deserialiseFromCBOR :: AsType (VerificationKey VrfKey)
-> ByteString -> Either DecoderError (VerificationKey VrfKey)
SerialiseAsCBOR

  newtype SigningKey VrfKey
    = VrfSigningKey (Crypto.SignKeyVRF (VRF StandardCrypto))
    deriving (Int -> SigningKey VrfKey -> ShowS
[SigningKey VrfKey] -> ShowS
SigningKey VrfKey -> String
(Int -> SigningKey VrfKey -> ShowS)
-> (SigningKey VrfKey -> String)
-> ([SigningKey VrfKey] -> ShowS)
-> Show (SigningKey VrfKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey VrfKey -> ShowS
showsPrec :: Int -> SigningKey VrfKey -> ShowS
$cshow :: SigningKey VrfKey -> String
show :: SigningKey VrfKey -> String
$cshowList :: [SigningKey VrfKey] -> ShowS
showList :: [SigningKey VrfKey] -> ShowS
Show, String -> SigningKey VrfKey
(String -> SigningKey VrfKey) -> IsString (SigningKey VrfKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> SigningKey VrfKey
fromString :: String -> SigningKey VrfKey
IsString) via UsingRawBytesHex (SigningKey VrfKey)
    deriving newtype (Typeable (SigningKey VrfKey)
Typeable (SigningKey VrfKey) =>
(SigningKey VrfKey -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy (SigningKey VrfKey) -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [SigningKey VrfKey] -> Size)
-> EncCBOR (SigningKey VrfKey)
SigningKey VrfKey -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SigningKey VrfKey] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (SigningKey VrfKey) -> 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 :: SigningKey VrfKey -> Encoding
encCBOR :: SigningKey VrfKey -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (SigningKey VrfKey) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (SigningKey VrfKey) -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SigningKey VrfKey] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SigningKey VrfKey] -> Size
EncCBOR, Typeable (SigningKey VrfKey)
Typeable (SigningKey VrfKey) =>
(forall s. Decoder s (SigningKey VrfKey))
-> (forall s. Proxy (SigningKey VrfKey) -> Decoder s ())
-> (Proxy (SigningKey VrfKey) -> Text)
-> DecCBOR (SigningKey VrfKey)
Proxy (SigningKey VrfKey) -> Text
forall s. Decoder s (SigningKey VrfKey)
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (SigningKey VrfKey) -> Decoder s ()
$cdecCBOR :: forall s. Decoder s (SigningKey VrfKey)
decCBOR :: forall s. Decoder s (SigningKey VrfKey)
$cdropCBOR :: forall s. Proxy (SigningKey VrfKey) -> Decoder s ()
dropCBOR :: forall s. Proxy (SigningKey VrfKey) -> Decoder s ()
$clabel :: Proxy (SigningKey VrfKey) -> Text
label :: Proxy (SigningKey VrfKey) -> Text
DecCBOR, Typeable (SigningKey VrfKey)
Typeable (SigningKey VrfKey) =>
(SigningKey VrfKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (SigningKey VrfKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SigningKey VrfKey] -> Size)
-> ToCBOR (SigningKey VrfKey)
SigningKey VrfKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey VrfKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey VrfKey) -> 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 :: SigningKey VrfKey -> Encoding
toCBOR :: SigningKey VrfKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey VrfKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey VrfKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey VrfKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey VrfKey] -> Size
ToCBOR, Typeable (SigningKey VrfKey)
Typeable (SigningKey VrfKey) =>
(forall s. Decoder s (SigningKey VrfKey))
-> (Proxy (SigningKey VrfKey) -> Text)
-> FromCBOR (SigningKey VrfKey)
Proxy (SigningKey VrfKey) -> Text
forall s. Decoder s (SigningKey VrfKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (SigningKey VrfKey)
fromCBOR :: forall s. Decoder s (SigningKey VrfKey)
$clabel :: Proxy (SigningKey VrfKey) -> Text
label :: Proxy (SigningKey VrfKey) -> Text
FromCBOR)
    deriving anyclass HasTypeProxy (SigningKey VrfKey)
HasTypeProxy (SigningKey VrfKey) =>
(SigningKey VrfKey -> ByteString)
-> (AsType (SigningKey VrfKey)
    -> ByteString -> Either DecoderError (SigningKey VrfKey))
-> SerialiseAsCBOR (SigningKey VrfKey)
AsType (SigningKey VrfKey)
-> ByteString -> Either DecoderError (SigningKey VrfKey)
SigningKey VrfKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey VrfKey -> ByteString
serialiseToCBOR :: SigningKey VrfKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey VrfKey)
-> ByteString -> Either DecoderError (SigningKey VrfKey)
deserialiseFromCBOR :: AsType (SigningKey VrfKey)
-> ByteString -> Either DecoderError (SigningKey VrfKey)
SerialiseAsCBOR

  deterministicSigningKey :: AsType VrfKey -> Crypto.Seed -> SigningKey VrfKey
  deterministicSigningKey :: AsType VrfKey -> Seed -> SigningKey VrfKey
deterministicSigningKey AsType VrfKey
R:AsTypeVrfKey
AsVrfKey Seed
seed =
    SignKeyVRF (VRF StandardCrypto) -> SigningKey VrfKey
VrfSigningKey (Seed -> SignKeyVRF PraosVRF
forall v. VRFAlgorithm v => Seed -> SignKeyVRF v
Crypto.genKeyVRF Seed
seed)

  deterministicSigningKeySeedSize :: AsType VrfKey -> Word
  deterministicSigningKeySeedSize :: AsType VrfKey -> Word
deterministicSigningKeySeedSize AsType VrfKey
R:AsTypeVrfKey
AsVrfKey =
    Proxy PraosVRF -> Word
forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Word
forall (proxy :: * -> *). proxy PraosVRF -> Word
Crypto.seedSizeVRF Proxy PraosVRF
Proxy (VRF StandardCrypto)
proxy
   where
    proxy :: Proxy (VRF StandardCrypto)
    proxy :: Proxy (VRF StandardCrypto)
proxy = Proxy PraosVRF
Proxy (VRF StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

  getVerificationKey :: SigningKey VrfKey -> VerificationKey VrfKey
  getVerificationKey :: SigningKey VrfKey -> VerificationKey VrfKey
getVerificationKey (VrfSigningKey SignKeyVRF (VRF StandardCrypto)
sk) =
    VerKeyVRF (VRF StandardCrypto) -> VerificationKey VrfKey
VrfVerificationKey (SignKeyVRF PraosVRF -> VerKeyVRF PraosVRF
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
Crypto.deriveVerKeyVRF SignKeyVRF PraosVRF
SignKeyVRF (VRF StandardCrypto)
sk)

  verificationKeyHash :: VerificationKey VrfKey -> Hash VrfKey
  verificationKeyHash :: VerificationKey VrfKey -> Hash VrfKey
verificationKeyHash (VrfVerificationKey VerKeyVRF (VRF StandardCrypto)
vkey) =
    Hash Blake2b_256 (VerKeyVRF (VRF StandardCrypto)) -> Hash VrfKey
VrfKeyHash (VerKeyVRF PraosVRF -> Hash Blake2b_256 (VerKeyVRF PraosVRF)
forall h.
HashAlgorithm h =>
VerKeyVRF PraosVRF -> Hash h (VerKeyVRF PraosVRF)
forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
Crypto.hashVerKeyVRF VerKeyVRF PraosVRF
VerKeyVRF (VRF StandardCrypto)
vkey)

instance SerialiseAsRawBytes (VerificationKey VrfKey) where
  serialiseToRawBytes :: VerificationKey VrfKey -> ByteString
serialiseToRawBytes (VrfVerificationKey VerKeyVRF (VRF StandardCrypto)
vk) =
    VerKeyVRF PraosVRF -> ByteString
forall v. VRFAlgorithm v => VerKeyVRF v -> ByteString
Crypto.rawSerialiseVerKeyVRF VerKeyVRF PraosVRF
VerKeyVRF (VRF StandardCrypto)
vk

  deserialiseFromRawBytes :: AsType (VerificationKey VrfKey)
-> ByteString -> Maybe (VerificationKey VrfKey)
deserialiseFromRawBytes (AsVerificationKey AsType VrfKey
R:AsTypeVrfKey
AsVrfKey) ByteString
bs =
    VerKeyVRF PraosVRF -> VerificationKey VrfKey
VerKeyVRF (VRF StandardCrypto) -> VerificationKey VrfKey
VrfVerificationKey (VerKeyVRF PraosVRF -> VerificationKey VrfKey)
-> Maybe (VerKeyVRF PraosVRF) -> Maybe (VerificationKey VrfKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (VerKeyVRF PraosVRF)
forall v. VRFAlgorithm v => ByteString -> Maybe (VerKeyVRF v)
Crypto.rawDeserialiseVerKeyVRF ByteString
bs

instance SerialiseAsRawBytes (SigningKey VrfKey) where
  serialiseToRawBytes :: SigningKey VrfKey -> ByteString
serialiseToRawBytes (VrfSigningKey SignKeyVRF (VRF StandardCrypto)
sk) =
    SignKeyVRF PraosVRF -> ByteString
forall v. VRFAlgorithm v => SignKeyVRF v -> ByteString
Crypto.rawSerialiseSignKeyVRF SignKeyVRF PraosVRF
SignKeyVRF (VRF StandardCrypto)
sk

  deserialiseFromRawBytes :: AsType (SigningKey VrfKey)
-> ByteString -> Maybe (SigningKey VrfKey)
deserialiseFromRawBytes (AsSigningKey AsType VrfKey
R:AsTypeVrfKey
AsVrfKey) ByteString
bs =
    SignKeyVRF PraosVRF -> SigningKey VrfKey
SignKeyVRF (VRF StandardCrypto) -> SigningKey VrfKey
VrfSigningKey (SignKeyVRF PraosVRF -> SigningKey VrfKey)
-> Maybe (SignKeyVRF PraosVRF) -> Maybe (SigningKey VrfKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (SignKeyVRF PraosVRF)
forall v. VRFAlgorithm v => ByteString -> Maybe (SignKeyVRF v)
Crypto.rawDeserialiseSignKeyVRF ByteString
bs

instance SerialiseAsBech32 (VerificationKey VrfKey) where
  bech32PrefixFor :: VerificationKey VrfKey -> Text
bech32PrefixFor VerificationKey VrfKey
_ = Text
"vrf_vk"
  bech32PrefixesPermitted :: AsType (VerificationKey VrfKey) -> [Text]
bech32PrefixesPermitted AsType (VerificationKey VrfKey)
_ = [Text
"vrf_vk"]

instance SerialiseAsBech32 (SigningKey VrfKey) where
  bech32PrefixFor :: SigningKey VrfKey -> Text
bech32PrefixFor SigningKey VrfKey
_ = Text
"vrf_sk"
  bech32PrefixesPermitted :: AsType (SigningKey VrfKey) -> [Text]
bech32PrefixesPermitted AsType (SigningKey VrfKey)
_ = [Text
"vrf_sk"]

newtype instance Hash VrfKey
  = VrfKeyHash
      ( Crypto.Hash
          HASH
          (Crypto.VerKeyVRF (VRF StandardCrypto))
      )
  deriving stock (Hash VrfKey -> Hash VrfKey -> Bool
(Hash VrfKey -> Hash VrfKey -> Bool)
-> (Hash VrfKey -> Hash VrfKey -> Bool) -> Eq (Hash VrfKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash VrfKey -> Hash VrfKey -> Bool
== :: Hash VrfKey -> Hash VrfKey -> Bool
$c/= :: Hash VrfKey -> Hash VrfKey -> Bool
/= :: Hash VrfKey -> Hash VrfKey -> Bool
Eq, Eq (Hash VrfKey)
Eq (Hash VrfKey) =>
(Hash VrfKey -> Hash VrfKey -> Ordering)
-> (Hash VrfKey -> Hash VrfKey -> Bool)
-> (Hash VrfKey -> Hash VrfKey -> Bool)
-> (Hash VrfKey -> Hash VrfKey -> Bool)
-> (Hash VrfKey -> Hash VrfKey -> Bool)
-> (Hash VrfKey -> Hash VrfKey -> Hash VrfKey)
-> (Hash VrfKey -> Hash VrfKey -> Hash VrfKey)
-> Ord (Hash VrfKey)
Hash VrfKey -> Hash VrfKey -> Bool
Hash VrfKey -> Hash VrfKey -> Ordering
Hash VrfKey -> Hash VrfKey -> Hash VrfKey
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 :: Hash VrfKey -> Hash VrfKey -> Ordering
compare :: Hash VrfKey -> Hash VrfKey -> Ordering
$c< :: Hash VrfKey -> Hash VrfKey -> Bool
< :: Hash VrfKey -> Hash VrfKey -> Bool
$c<= :: Hash VrfKey -> Hash VrfKey -> Bool
<= :: Hash VrfKey -> Hash VrfKey -> Bool
$c> :: Hash VrfKey -> Hash VrfKey -> Bool
> :: Hash VrfKey -> Hash VrfKey -> Bool
$c>= :: Hash VrfKey -> Hash VrfKey -> Bool
>= :: Hash VrfKey -> Hash VrfKey -> Bool
$cmax :: Hash VrfKey -> Hash VrfKey -> Hash VrfKey
max :: Hash VrfKey -> Hash VrfKey -> Hash VrfKey
$cmin :: Hash VrfKey -> Hash VrfKey -> Hash VrfKey
min :: Hash VrfKey -> Hash VrfKey -> Hash VrfKey
Ord)
  deriving (Int -> Hash VrfKey -> ShowS
[Hash VrfKey] -> ShowS
Hash VrfKey -> String
(Int -> Hash VrfKey -> ShowS)
-> (Hash VrfKey -> String)
-> ([Hash VrfKey] -> ShowS)
-> Show (Hash VrfKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash VrfKey -> ShowS
showsPrec :: Int -> Hash VrfKey -> ShowS
$cshow :: Hash VrfKey -> String
show :: Hash VrfKey -> String
$cshowList :: [Hash VrfKey] -> ShowS
showList :: [Hash VrfKey] -> ShowS
Show, String -> Hash VrfKey
(String -> Hash VrfKey) -> IsString (Hash VrfKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash VrfKey
fromString :: String -> Hash VrfKey
IsString) via UsingRawBytesHex (Hash VrfKey)
  deriving (Typeable (Hash VrfKey)
Typeable (Hash VrfKey) =>
(Hash VrfKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Hash VrfKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Hash VrfKey] -> Size)
-> ToCBOR (Hash VrfKey)
Hash VrfKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash VrfKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash VrfKey) -> 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 :: Hash VrfKey -> Encoding
toCBOR :: Hash VrfKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash VrfKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash VrfKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash VrfKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash VrfKey] -> Size
ToCBOR, Typeable (Hash VrfKey)
Typeable (Hash VrfKey) =>
(forall s. Decoder s (Hash VrfKey))
-> (Proxy (Hash VrfKey) -> Text) -> FromCBOR (Hash VrfKey)
Proxy (Hash VrfKey) -> Text
forall s. Decoder s (Hash VrfKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (Hash VrfKey)
fromCBOR :: forall s. Decoder s (Hash VrfKey)
$clabel :: Proxy (Hash VrfKey) -> Text
label :: Proxy (Hash VrfKey) -> Text
FromCBOR) via UsingRawBytes (Hash VrfKey)
  deriving anyclass HasTypeProxy (Hash VrfKey)
Hash VrfKey -> ByteString
HasTypeProxy (Hash VrfKey) =>
(Hash VrfKey -> ByteString)
-> (AsType (Hash VrfKey)
    -> ByteString -> Either DecoderError (Hash VrfKey))
-> SerialiseAsCBOR (Hash VrfKey)
AsType (Hash VrfKey)
-> ByteString -> Either DecoderError (Hash VrfKey)
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: Hash VrfKey -> ByteString
serialiseToCBOR :: Hash VrfKey -> ByteString
$cdeserialiseFromCBOR :: AsType (Hash VrfKey)
-> ByteString -> Either DecoderError (Hash VrfKey)
deserialiseFromCBOR :: AsType (Hash VrfKey)
-> ByteString -> Either DecoderError (Hash VrfKey)
SerialiseAsCBOR

instance SerialiseAsRawBytes (Hash VrfKey) where
  serialiseToRawBytes :: Hash VrfKey -> ByteString
serialiseToRawBytes (VrfKeyHash Hash Blake2b_256 (VerKeyVRF (VRF StandardCrypto))
vkh) =
    Hash Blake2b_256 (VerKeyVRF PraosVRF) -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_256 (VerKeyVRF PraosVRF)
Hash Blake2b_256 (VerKeyVRF (VRF StandardCrypto))
vkh

  deserialiseFromRawBytes :: AsType (Hash VrfKey) -> ByteString -> Maybe (Hash VrfKey)
deserialiseFromRawBytes (AsHash AsType VrfKey
R:AsTypeVrfKey
AsVrfKey) ByteString
bs =
    Hash Blake2b_256 (VerKeyVRF PraosVRF) -> Hash VrfKey
Hash Blake2b_256 (VerKeyVRF (VRF StandardCrypto)) -> Hash VrfKey
VrfKeyHash (Hash Blake2b_256 (VerKeyVRF PraosVRF) -> Hash VrfKey)
-> Maybe (Hash Blake2b_256 (VerKeyVRF PraosVRF))
-> Maybe (Hash VrfKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_256 (VerKeyVRF PraosVRF))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance HasTextEnvelope (VerificationKey VrfKey) where
  textEnvelopeType :: AsType (VerificationKey VrfKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey VrfKey)
_ = TextEnvelopeType
"VrfVerificationKey_" TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy PraosVRF -> String
forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy PraosVRF -> String
Crypto.algorithmNameVRF Proxy PraosVRF
Proxy (VRF StandardCrypto)
proxy)
   where
    proxy :: Proxy (VRF StandardCrypto)
    proxy :: Proxy (VRF StandardCrypto)
proxy = Proxy PraosVRF
Proxy (VRF StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

instance HasTextEnvelope (SigningKey VrfKey) where
  textEnvelopeType :: AsType (SigningKey VrfKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey VrfKey)
_ = TextEnvelopeType
"VrfSigningKey_" TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy PraosVRF -> String
forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy PraosVRF -> String
Crypto.algorithmNameVRF Proxy PraosVRF
Proxy (VRF StandardCrypto)
proxy)
   where
    proxy :: Proxy (VRF StandardCrypto)
    proxy :: Proxy (VRF StandardCrypto)
proxy = Proxy PraosVRF
Proxy (VRF StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy