{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Abstract key evolving signatures.
module Cardano.Crypto.KES.Class (
  -- * KES algorithm class
  KESAlgorithm (..),
  genKeyKES,
  updateKES,
  forgetSignKeyKES,
  Period,
  OptimizedKESAlgorithm (..),
  verifyOptimizedKES,

  -- * Deprecated size synonyms
  sizeVerKeyKES,
  sizeSignKeyKES,
  sizeSigKES,

  -- * 'SignKeyWithPeriodKES' wrapper
  SignKeyWithPeriodKES (..),
  updateKESWithPeriod,

  -- * 'SignedKES' wrapper
  SignedKES (..),
  signedKES,
  verifySignedKES,

  -- * CBOR encoding and decoding
  encodeVerKeyKES,
  decodeVerKeyKES,
  encodeSigKES,
  decodeSigKES,
  encodeSignedKES,
  decodeSignedKES,

  -- * Encoded 'Size' expressions
  encodedVerKeyKESSizeExpr,
  encodedSignKeyKESSizeExpr,
  encodedSigKESSizeExpr,

  -- * Raw sizes
  fixedSize,
  verKeySizeKES,
  sigSizeKES,
  signKeySizeKES,
  seedSizeKES,

  -- * Unsound APIs
  UnsoundKESAlgorithm (..),
  encodeSignKeyKES,
  decodeSignKeyKES,
  rawDeserialiseSignKeyKES,
  UnsoundPureKESAlgorithm (..),
  unsoundPureSignedKES,
  encodeUnsoundPureSignKeyKES,
  decodeUnsoundPureSignKeyKES,

  -- * Utility functions

  -- These are used between multiple KES implementations. User code will
  -- most likely not need these, but they are required for recursive
  -- definitions of the SumKES algorithms, and can be expressed entirely in
  -- terms of the KES, DSIGN and Hash typeclasses, so we keep them here for
  -- convenience.
  hashPairOfVKeys,
  mungeName,
  unsoundPureSignKeyKESToSoundSignKeyKESViaSer,
)
where

import Control.Monad.Class.MonadST (MonadST)
import Control.Monad.Class.MonadThrow (MonadThrow)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Kind (Type)
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
import GHC.Exts (Constraint)
import GHC.Generics (Generic)
import GHC.Stack
import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal)
import NoThunks.Class (NoThunks)

import Cardano.Binary (Decoder, Encoding, Size, decodeBytes, encodeBytes, withWordSize)

import Cardano.Binary.FixedSizeCodec (
  FixedSizeCodec (..),
  decodeFixedSized,
  encodeFixedSized,
  fixedSize,
 )
import Cardano.Crypto.Hash.Class (Hash, HashAlgorithm, hashWith)
import Cardano.Crypto.Libsodium (MLockedAllocator, mlockedMalloc)
import Cardano.Crypto.Libsodium.MLockedSeed
import Cardano.Crypto.Seed
import Cardano.Crypto.Util (Empty)

{-# DEPRECATED SizeVerKeyKES "In favor of `VerKeySizeKES`" #-}
{-# DEPRECATED SizeSignKeyKES "In favor of `SignKeySizeKES`" #-}
{-# DEPRECATED SizeSigKES "In favor of `SigSizeKES`" #-}

class
  ( Typeable v
  , Show (VerKeyKES v)
  , Eq (VerKeyKES v)
  , Show (SigKES v)
  , Eq (SigKES v)
  , NoThunks (SigKES v)
  , NoThunks (SignKeyKES v)
  , NoThunks (VerKeyKES v)
  , KnownNat (SeedSizeKES v)
  , KnownNat (VerKeySizeKES v)
  , KnownNat (SignKeySizeKES v)
  , KnownNat (SigSizeKES v)
  , KnownNat (TotalPeriodsKES v)
  , FixedSizeCodec (VerKeyKES v)
  , FixedSizeCodec (SigKES v)
  ) =>
  KESAlgorithm v
  where
  --
  -- Key and signature types
  --
  data VerKeyKES v :: Type
  data SigKES v :: Type
  data SignKeyKES v :: Type

  type SeedSizeKES v :: Nat
  type VerKeySizeKES v :: Nat
  type VerKeySizeKES v = FixedSize (VerKeyKES v)
  type SignKeySizeKES v :: Nat
  type SignKeySizeKES v = FixedSize (SignKeyKES v)
  type SigSizeKES v :: Nat
  type SigSizeKES v = FixedSize (SigKES v)
  type TotalPeriodsKES v :: Nat

  type SizeVerKeyKES v :: Nat
  type SizeVerKeyKES v = VerKeySizeKES v
  type SizeSignKeyKES v :: Nat
  type SizeSignKeyKES v = SignKeySizeKES v
  type SizeSigKES v :: Nat
  type SizeSigKES v = SigSizeKES v

  --
  -- Metadata and basic key operations
  --
  algorithmNameKES :: proxy v -> String

  hashVerKeyKES :: HashAlgorithm h => VerKeyKES v -> Hash h (VerKeyKES v)
  hashVerKeyKES = (VerKeyKES v -> ByteString) -> VerKeyKES v -> Hash h (VerKeyKES v)
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith VerKeyKES v -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized

  -- | Context required to run the KES algorithm
  --
  -- Unit by default (no context required)
  type ContextKES v :: Type

  type ContextKES v = ()

  type Signable v :: Type -> Constraint
  type Signable v = Empty

  --
  -- Core algorithm operations
  --

  -- | Full KES verification. This method checks that the signature itself
  -- checks out (as per 'verifySigKES'), and also makes sure that it matches
  -- the provided VerKey.
  verifyKES ::
    (Signable v a, HasCallStack) =>
    ContextKES v ->
    VerKeyKES v ->
    -- | The /current/ period for the key
    Period ->
    a ->
    SigKES v ->
    Either String ()

  -- | Return the total number of KES periods supported by this algorithm. The
  -- KES algorithm is assumed to support a fixed maximum number of periods, not
  -- a variable number.
  --
  -- Do note that this is the total number of /periods/ not the total number of
  -- evolutions. The difference is off-by-one. For example if there are 2
  -- periods (period 0 and 1) then there is only one evolution.
  totalPeriodsKES ::
    proxy v -> Word
  totalPeriodsKES proxy v
_ =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Word (Integer -> Word) -> Integer -> Word
forall a b. (a -> b) -> a -> b
$ Proxy (TotalPeriodsKES v) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(TotalPeriodsKES v))

  --
  -- Serialisation/(de)serialisation in fixed-size raw format
  --

  rawSerialiseVerKeyKES :: VerKeyKES v -> ByteString
  rawSerialiseVerKeyKES = VerKeyKES v -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized
  rawSerialiseSigKES :: SigKES v -> ByteString
  rawSerialiseSigKES = SigKES v -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized

  rawDeserialiseVerKeyKES :: ByteString -> Maybe (VerKeyKES v)
  rawDeserialiseVerKeyKES = ByteString -> Maybe (VerKeyKES v)
forall a (m :: * -> *).
(FixedSizeCodec a, MonadFail m) =>
ByteString -> m a
forall (m :: * -> *). MonadFail m => ByteString -> m (VerKeyKES v)
rawDecodeFixedSized
  rawDeserialiseSigKES :: ByteString -> Maybe (SigKES v)
  rawDeserialiseSigKES = ByteString -> Maybe (SigKES v)
forall a (m :: * -> *).
(FixedSizeCodec a, MonadFail m) =>
ByteString -> m a
forall (m :: * -> *). MonadFail m => ByteString -> m (SigKES v)
rawDecodeFixedSized

  deriveVerKeyKES :: (MonadST m, MonadThrow m) => SignKeyKES v -> m (VerKeyKES v)

  --
  -- Core algorithm operations
  --

  signKES ::
    forall a m.
    (Signable v a, MonadST m, MonadThrow m) =>
    ContextKES v ->
    -- | The /current/ period for the key
    Period ->
    a ->
    SignKeyKES v ->
    m (SigKES v)

  updateKESWith ::
    (MonadST m, MonadThrow m) =>
    MLockedAllocator m ->
    ContextKES v ->
    SignKeyKES v ->
    -- | The /current/ period for the key, not the target period.
    Period ->
    m (Maybe (SignKeyKES v))

  genKeyKESWith ::
    (MonadST m, MonadThrow m) =>
    MLockedAllocator m ->
    MLockedSeed (SeedSizeKES v) ->
    m (SignKeyKES v)

  --
  -- Secure forgetting
  --

  -- | Forget a signing key synchronously, rather than waiting for GC. In some
  -- non-mock instances this provides a guarantee that the signing key is no
  -- longer in memory.
  --
  -- The precondition is that this key value will not be used again.
  forgetSignKeyKESWith ::
    (MonadST m, MonadThrow m) =>
    MLockedAllocator m ->
    SignKeyKES v ->
    m ()

{-# DEPRECATED rawSerialiseVerKeyKES "Use `rawEncodeFixedSized` instead" #-}
{-# DEPRECATED rawSerialiseSigKES "Use `rawEncodeFixedSized` instead" #-}
{-# DEPRECATED rawDeserialiseVerKeyKES "Use `rawDecodeFixedSized` instead" #-}
{-# DEPRECATED rawDeserialiseSigKES "Use `rawDecodeFixedSized` instead" #-}

verKeySizeKES :: forall v proxy. KESAlgorithm v => proxy v -> Word
verKeySizeKES :: forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
verKeySizeKES proxy v
_ = Proxy (VerKeyKES v) -> Word
forall a (proxy :: * -> *). FixedSizeCodec a => proxy a -> Word
fixedSize (Proxy (VerKeyKES v) -> Word) -> Proxy (VerKeyKES v) -> Word
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(VerKeyKES v)
{-# DEPRECATED verKeySizeKES "Use `fixedSize` instead" #-}

sigSizeKES :: forall v proxy. KESAlgorithm v => proxy v -> Word
sigSizeKES :: forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sigSizeKES proxy v
_ = Proxy (SigKES v) -> Word
forall a (proxy :: * -> *). FixedSizeCodec a => proxy a -> Word
fixedSize (Proxy (SigKES v) -> Word) -> Proxy (SigKES v) -> Word
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SigKES v)
{-# DEPRECATED sigSizeKES "Use `fixedSize` instead" #-}

signKeySizeKES :: forall v proxy. KESAlgorithm v => proxy v -> Word
signKeySizeKES :: forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
signKeySizeKES proxy v
_ = Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Proxy (SignKeySizeKES v) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SignKeySizeKES v)))

{-# DEPRECATED sizeVerKeyKES "Use `fixedSize` instead" #-}
sizeVerKeyKES :: forall v proxy. KESAlgorithm v => proxy v -> Word
sizeVerKeyKES :: forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sizeVerKeyKES proxy v
_ = Proxy (VerKeyKES v) -> Word
forall a (proxy :: * -> *). FixedSizeCodec a => proxy a -> Word
fixedSize (Proxy (VerKeyKES v) -> Word) -> Proxy (VerKeyKES v) -> Word
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(VerKeyKES v)

{-# DEPRECATED sizeSignKeyKES "In favor of `signKeySizeKES`" #-}
sizeSignKeyKES :: forall v proxy. KESAlgorithm v => proxy v -> Word
sizeSignKeyKES :: forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sizeSignKeyKES = proxy v -> Word
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
signKeySizeKES

{-# DEPRECATED sizeSigKES "Use `fixedSize` instead" #-}
sizeSigKES :: forall v proxy. KESAlgorithm v => proxy v -> Word
sizeSigKES :: forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
sizeSigKES proxy v
_ = Proxy (SigKES v) -> Word
forall a (proxy :: * -> *). FixedSizeCodec a => proxy a -> Word
fixedSize (Proxy (SigKES v) -> Word) -> Proxy (SigKES v) -> Word
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SigKES v)

-- | The upper bound on the 'Seed' size needed by 'genKeyKES'
seedSizeKES :: forall v proxy. KESAlgorithm v => proxy v -> Word
seedSizeKES :: forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
seedSizeKES proxy v
_ = Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Proxy (SeedSizeKES v) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SeedSizeKES v)))

-- | Forget a signing key synchronously, rather than waiting for GC. In some
-- non-mock instances this provides a guarantee that the signing key is no
-- longer in memory.
--
-- The precondition is that this key value will not be used again.
forgetSignKeyKES ::
  (KESAlgorithm v, MonadST m, MonadThrow m) =>
  SignKeyKES v ->
  m ()
forgetSignKeyKES :: forall v (m :: * -> *).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyKES v -> m ()
forgetSignKeyKES = MLockedAllocator m -> SignKeyKES v -> m ()
forall v (m :: * -> *).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyKES v -> m ()
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyKES v -> m ()
forgetSignKeyKESWith MLockedAllocator m
forall (m :: * -> *). MonadST m => MLockedAllocator m
mlockedMalloc

-- | Key generation
genKeyKES ::
  forall v m.
  (KESAlgorithm v, MonadST m, MonadThrow m) =>
  MLockedSeed (SeedSizeKES v) ->
  m (SignKeyKES v)
genKeyKES :: forall v (m :: * -> *).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedSeed (SeedSizeKES v) -> m (SignKeyKES v)
genKeyKES = MLockedAllocator m
-> MLockedSeed (SeedSizeKES v) -> m (SignKeyKES v)
forall v (m :: * -> *).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES v) -> m (SignKeyKES v)
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES v) -> m (SignKeyKES v)
genKeyKESWith MLockedAllocator m
forall (m :: * -> *). MonadST m => MLockedAllocator m
mlockedMalloc

-- | Update the KES signature key to the /next/ period, given the /current/
-- period.
--
-- It returns 'Nothing' if the cannot be evolved any further.
--
-- The precondition (to get a 'Just' result) is that the current KES period
-- of the input key is not the last period. The given period must be the
-- current KES period of the input key (not the next or target).
--
-- The postcondition is that in case a key is returned, its current KES
-- period is incremented by one compared to before.
--
-- Note that you must track the current period separately, and to skip to a
-- later period requires repeated use of this function, since it only
-- increments one period at once.
updateKES ::
  forall v m.
  (KESAlgorithm v, MonadST m, MonadThrow m) =>
  ContextKES v ->
  SignKeyKES v ->
  -- | The /current/ period for the key, not the target period.
  Period ->
  m (Maybe (SignKeyKES v))
updateKES :: forall v (m :: * -> *).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
ContextKES v -> SignKeyKES v -> Word -> m (Maybe (SignKeyKES v))
updateKES = MLockedAllocator m
-> ContextKES v -> SignKeyKES v -> Word -> m (Maybe (SignKeyKES v))
forall v (m :: * -> *).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ContextKES v -> SignKeyKES v -> Word -> m (Maybe (SignKeyKES v))
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ContextKES v -> SignKeyKES v -> Word -> m (Maybe (SignKeyKES v))
updateKESWith MLockedAllocator m
forall (m :: * -> *). MonadST m => MLockedAllocator m
mlockedMalloc

-- | Pure implementations of the core KES operations. These are unsound, because
-- proper handling of KES secrets (seeds, sign keys) requires mlocking and
-- deterministic erasure (\"secure forgetting\"), which is not possible in pure
-- code.
-- This API is only provided for testing purposes; it must not be used to
-- generate or use real KES keys.
class
  ( KESAlgorithm v
  , NoThunks (UnsoundPureSignKeyKES v)
  , FixedSizeCodec (UnsoundPureSignKeyKES v)
  ) =>
  UnsoundPureKESAlgorithm v
  where
  data UnsoundPureSignKeyKES v :: Type

  unsoundPureSignKES ::
    forall a.
    Signable v a =>
    ContextKES v ->
    -- | The /current/ period for the key
    Period ->
    a ->
    UnsoundPureSignKeyKES v ->
    SigKES v

  unsoundPureUpdateKES ::
    ContextKES v ->
    UnsoundPureSignKeyKES v ->
    -- | The /current/ period for the key, not the target period.
    Period ->
    Maybe (UnsoundPureSignKeyKES v)

  unsoundPureGenKeyKES ::
    Seed ->
    UnsoundPureSignKeyKES v

  unsoundPureDeriveVerKeyKES ::
    UnsoundPureSignKeyKES v ->
    VerKeyKES v

  unsoundPureSignKeyKESToSoundSignKeyKES ::
    (MonadST m, MonadThrow m) =>
    UnsoundPureSignKeyKES v ->
    m (SignKeyKES v)

  rawSerialiseUnsoundPureSignKeyKES :: UnsoundPureSignKeyKES v -> ByteString
  rawSerialiseUnsoundPureSignKeyKES = UnsoundPureSignKeyKES v -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized
  rawDeserialiseUnsoundPureSignKeyKES :: ByteString -> Maybe (UnsoundPureSignKeyKES v)
  rawDeserialiseUnsoundPureSignKeyKES = ByteString -> Maybe (UnsoundPureSignKeyKES v)
forall a (m :: * -> *).
(FixedSizeCodec a, MonadFail m) =>
ByteString -> m a
forall (m :: * -> *).
MonadFail m =>
ByteString -> m (UnsoundPureSignKeyKES v)
rawDecodeFixedSized

{-# DEPRECATED rawSerialiseUnsoundPureSignKeyKES "Use `rawEncodeFixedSized` instead" #-}
{-# DEPRECATED rawDeserialiseUnsoundPureSignKeyKES "Use `rawDecodeFixedSized` instead" #-}

-- | Unsound operations on KES sign keys. These operations violate secure
-- forgetting constraints by leaking secrets to unprotected memory. Consider
-- using the 'DirectSerialise' / 'DirectDeserialise' APIs instead.
class KESAlgorithm v => UnsoundKESAlgorithm v where
  rawDeserialiseSignKeyKESWith ::
    (MonadST m, MonadThrow m) =>
    MLockedAllocator m ->
    ByteString ->
    m (Maybe (SignKeyKES v))

  rawSerialiseSignKeyKES :: (MonadST m, MonadThrow m) => SignKeyKES v -> m ByteString

rawDeserialiseSignKeyKES ::
  (UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
  ByteString ->
  m (Maybe (SignKeyKES v))
rawDeserialiseSignKeyKES :: forall v (m :: * -> *).
(UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
ByteString -> m (Maybe (SignKeyKES v))
rawDeserialiseSignKeyKES = MLockedAllocator m -> ByteString -> m (Maybe (SignKeyKES v))
forall v (m :: * -> *).
(UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m -> ByteString -> m (Maybe (SignKeyKES v))
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m -> ByteString -> m (Maybe (SignKeyKES v))
rawDeserialiseSignKeyKESWith MLockedAllocator m
forall (m :: * -> *). MonadST m => MLockedAllocator m
mlockedMalloc

-- | Helper function for implementing 'unsoundPureSignKeyKESToSoundSignKeyKES'
-- for KES algorithms that support both 'UnsoundKESAlgorithm' and
-- 'UnsoundPureKESAlgorithm'. For such KES algorithms, unsound sign keys can be
-- marshalled to sound sign keys by serializing and then deserializing them.
unsoundPureSignKeyKESToSoundSignKeyKESViaSer ::
  (MonadST m, MonadThrow m, UnsoundKESAlgorithm k, UnsoundPureKESAlgorithm k) =>
  UnsoundPureSignKeyKES k ->
  m (SignKeyKES k)
unsoundPureSignKeyKESToSoundSignKeyKESViaSer :: forall (m :: * -> *) k.
(MonadST m, MonadThrow m, UnsoundKESAlgorithm k,
 UnsoundPureKESAlgorithm k) =>
UnsoundPureSignKeyKES k -> m (SignKeyKES k)
unsoundPureSignKeyKESToSoundSignKeyKESViaSer UnsoundPureSignKeyKES k
sk =
  m (SignKeyKES k)
-> (SignKeyKES k -> m (SignKeyKES k))
-> Maybe (SignKeyKES k)
-> m (SignKeyKES k)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m (SignKeyKES k)
forall a. HasCallStack => String -> a
error String
"unsoundPureSignKeyKESToSoundSignKeyKES: deserialisation failure") SignKeyKES k -> m (SignKeyKES k)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    (Maybe (SignKeyKES k) -> m (SignKeyKES k))
-> m (Maybe (SignKeyKES k)) -> m (SignKeyKES k)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ByteString -> m (Maybe (SignKeyKES k))
forall v (m :: * -> *).
(UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
ByteString -> m (Maybe (SignKeyKES v))
rawDeserialiseSignKeyKES (ByteString -> m (Maybe (SignKeyKES k)))
-> (UnsoundPureSignKeyKES k -> ByteString)
-> UnsoundPureSignKeyKES k
-> m (Maybe (SignKeyKES k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsoundPureSignKeyKES k -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized (UnsoundPureSignKeyKES k -> m (Maybe (SignKeyKES k)))
-> UnsoundPureSignKeyKES k -> m (Maybe (SignKeyKES k))
forall a b. (a -> b) -> a -> b
$ UnsoundPureSignKeyKES k
sk)

-- | Subclass for KES algorithms that embed a copy of the VerKey into the
-- signature itself, rather than relying on the externally supplied VerKey
-- alone. Some optimizations made in the 'Cardano.Crypto.KES.CompactSingleKES'
-- and 'Cardano.Crypto.KES.CompactSumKES' implementations require this
-- additional interface in order to avoid redundant computations.
class KESAlgorithm v => OptimizedKESAlgorithm v where
  -- | Partial verification: this method only verifies the signature itself,
  -- but it does not check it against any externally-provided VerKey. Use
  -- 'verifyKES' for full KES verification.
  verifySigKES ::
    (Signable v a, HasCallStack) =>
    ContextKES v ->
    -- | The /current/ period for the key
    Period ->
    a ->
    SigKES v ->
    Either String ()

  -- | Extract a VerKey from a SigKES. Note that a VerKey embedded in or
  -- derived from a SigKES is effectively user-supplied, so it is not enough
  -- to validate a SigKES against this VerKey (like 'verifySigKES' does); you
  -- must also compare the VerKey against an externally-provided key that you
  -- want to verify against (see 'verifyKES').
  verKeyFromSigKES ::
    ContextKES v ->
    Period ->
    SigKES v ->
    VerKeyKES v

verifyOptimizedKES ::
  (OptimizedKESAlgorithm v, Signable v a, HasCallStack) =>
  ContextKES v ->
  VerKeyKES v ->
  Period ->
  a ->
  SigKES v ->
  Either String ()
verifyOptimizedKES :: forall v a.
(OptimizedKESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v
-> VerKeyKES v -> Word -> a -> SigKES v -> Either String ()
verifyOptimizedKES ContextKES v
ctx VerKeyKES v
vk Word
t a
a SigKES v
sig = do
  ContextKES v -> Word -> a -> SigKES v -> Either String ()
forall v a.
(OptimizedKESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v -> Word -> a -> SigKES v -> Either String ()
forall a.
(Signable v a, HasCallStack) =>
ContextKES v -> Word -> a -> SigKES v -> Either String ()
verifySigKES ContextKES v
ctx Word
t a
a SigKES v
sig
  let vk' :: VerKeyKES v
vk' = ContextKES v -> Word -> SigKES v -> VerKeyKES v
forall v.
OptimizedKESAlgorithm v =>
ContextKES v -> Word -> SigKES v -> VerKeyKES v
verKeyFromSigKES ContextKES v
ctx Word
t SigKES v
sig
  if VerKeyKES v
vk' VerKeyKES v -> VerKeyKES v -> Bool
forall a. Eq a => a -> a -> Bool
== VerKeyKES v
vk
    then () -> Either String ()
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else String -> Either String ()
forall a b. a -> Either a b
Left String
"KES verification failed"

--
-- Do not provide Ord instances for keys, see #38
--

instance
  ( TypeError ('Text "Ord not supported for signing keys, use the hash instead")
  , Eq (SignKeyKES v)
  ) =>
  Ord (SignKeyKES v)
  where
  compare :: SignKeyKES v -> SignKeyKES v -> Ordering
compare = String -> SignKeyKES v -> SignKeyKES v -> Ordering
forall a. HasCallStack => String -> a
error String
"unsupported"

instance
  ( TypeError ('Text "Ord not supported for verification keys, use the hash instead")
  , KESAlgorithm v
  ) =>
  Ord (VerKeyKES v)
  where
  compare :: VerKeyKES v -> VerKeyKES v -> Ordering
compare = String -> VerKeyKES v -> VerKeyKES v -> Ordering
forall a. HasCallStack => String -> a
error String
"unsupported"

--
-- Convenient CBOR encoding/decoding
--
-- Implementations in terms of the raw (de)serialise
--

encodeVerKeyKES :: KESAlgorithm v => VerKeyKES v -> Encoding
encodeVerKeyKES :: forall v. KESAlgorithm v => VerKeyKES v -> Encoding
encodeVerKeyKES = ByteString -> Encoding
encodeBytes (ByteString -> Encoding)
-> (VerKeyKES v -> ByteString) -> VerKeyKES v -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyKES v -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized
{-# DEPRECATED encodeVerKeyKES "Use `encodeFixedSized` instead" #-}

encodeUnsoundPureSignKeyKES :: UnsoundPureKESAlgorithm v => UnsoundPureSignKeyKES v -> Encoding
encodeUnsoundPureSignKeyKES :: forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> Encoding
encodeUnsoundPureSignKeyKES = ByteString -> Encoding
encodeBytes (ByteString -> Encoding)
-> (UnsoundPureSignKeyKES v -> ByteString)
-> UnsoundPureSignKeyKES v
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnsoundPureSignKeyKES v -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized
{-# DEPRECATED encodeUnsoundPureSignKeyKES "Use `encodeFixedSized` instead" #-}

encodeSigKES :: KESAlgorithm v => SigKES v -> Encoding
encodeSigKES :: forall v. KESAlgorithm v => SigKES v -> Encoding
encodeSigKES = ByteString -> Encoding
encodeBytes (ByteString -> Encoding)
-> (SigKES v -> ByteString) -> SigKES v -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigKES v -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized
{-# DEPRECATED encodeSigKES "Use `encodeFixedSized` instead" #-}

encodeSignKeyKES ::
  forall v m.
  (UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
  SignKeyKES v ->
  m Encoding
encodeSignKeyKES :: forall v (m :: * -> *).
(UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyKES v -> m Encoding
encodeSignKeyKES = (ByteString -> Encoding) -> m ByteString -> m Encoding
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Encoding
encodeBytes (m ByteString -> m Encoding)
-> (SignKeyKES v -> m ByteString) -> SignKeyKES v -> m Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyKES v -> m ByteString
forall v (m :: * -> *).
(UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyKES v -> m ByteString
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
SignKeyKES v -> m ByteString
rawSerialiseSignKeyKES

decodeVerKeyKES :: forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES :: forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES = Decoder s (VerKeyKES v)
forall a s. FixedSizeCodec a => Decoder s a
decodeFixedSized
{-# INLINE decodeVerKeyKES #-}
{-# DEPRECATED decodeVerKeyKES "Use `decodeFixedSized` instead" #-}

decodeUnsoundPureSignKeyKES ::
  forall v s. UnsoundPureKESAlgorithm v => Decoder s (UnsoundPureSignKeyKES v)
decodeUnsoundPureSignKeyKES :: forall v s.
UnsoundPureKESAlgorithm v =>
Decoder s (UnsoundPureSignKeyKES v)
decodeUnsoundPureSignKeyKES = Decoder s (UnsoundPureSignKeyKES v)
forall a s. FixedSizeCodec a => Decoder s a
decodeFixedSized
{-# INLINE decodeUnsoundPureSignKeyKES #-}
{-# DEPRECATED decodeUnsoundPureSignKeyKES "Use `decodeFixedSized` instead" #-}

decodeSigKES :: forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES :: forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES = Decoder s (SigKES v)
forall a s. FixedSizeCodec a => Decoder s a
decodeFixedSized
{-# INLINE decodeSigKES #-}
{-# DEPRECATED decodeSigKES "Use `decodeFixedSized` instead" #-}

decodeSignKeyKES ::
  forall v s m.
  (UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
  Decoder s (m (Maybe (SignKeyKES v)))
decodeSignKeyKES :: forall v s (m :: * -> *).
(UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
Decoder s (m (Maybe (SignKeyKES v)))
decodeSignKeyKES = do
  ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  let expected :: Int
expected = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Int (Proxy v -> Word
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
signKeySizeKES (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v))
      actual :: Int
actual = ByteString -> Int
BS.length ByteString
bs
  if Int
actual Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
expected
    then
      String -> Decoder s (m (Maybe (SignKeyKES v)))
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
        ( String
"decodeSignKeyKES: wrong length, expected "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
expected
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" bytes but got "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
actual
        )
    else m (Maybe (SignKeyKES v)) -> Decoder s (m (Maybe (SignKeyKES v)))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (m (Maybe (SignKeyKES v)) -> Decoder s (m (Maybe (SignKeyKES v))))
-> m (Maybe (SignKeyKES v)) -> Decoder s (m (Maybe (SignKeyKES v)))
forall a b. (a -> b) -> a -> b
$ ByteString -> m (Maybe (SignKeyKES v))
forall v (m :: * -> *).
(UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
ByteString -> m (Maybe (SignKeyKES v))
rawDeserialiseSignKeyKES ByteString
bs

-- | The KES period. Periods are enumerated from zero.
--
-- Be careful of fencepost errors: if there are 2 periods (period 0 and 1)
-- then there is only one key evolution.
type Period = Word

newtype SignedKES v a = SignedKES {forall v a. SignedKES v a -> SigKES v
getSig :: SigKES v}
  deriving ((forall x. SignedKES v a -> Rep (SignedKES v a) x)
-> (forall x. Rep (SignedKES v a) x -> SignedKES v a)
-> Generic (SignedKES v a)
forall x. Rep (SignedKES v a) x -> SignedKES v a
forall x. SignedKES v a -> Rep (SignedKES v a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v a x. Rep (SignedKES v a) x -> SignedKES v a
forall v a x. SignedKES v a -> Rep (SignedKES v a) x
$cfrom :: forall v a x. SignedKES v a -> Rep (SignedKES v a) x
from :: forall x. SignedKES v a -> Rep (SignedKES v a) x
$cto :: forall v a x. Rep (SignedKES v a) x -> SignedKES v a
to :: forall x. Rep (SignedKES v a) x -> SignedKES v a
Generic)

deriving instance KESAlgorithm v => Show (SignedKES v a)
deriving instance KESAlgorithm v => Eq (SignedKES v a)

instance KESAlgorithm v => NoThunks (SignedKES v a)

instance KESAlgorithm v => FixedSizeCodec (SignedKES v a) where
  type FixedSize (SignedKES v a) = FixedSize (SigKES v)

  rawEncodeFixedSized :: SignedKES v a -> ByteString
rawEncodeFixedSized (SignedKES SigKES v
x) = SigKES v -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized SigKES v
x
  rawDecodeFixedSized :: forall (m :: * -> *).
MonadFail m =>
ByteString -> m (SignedKES v a)
rawDecodeFixedSized ByteString
bs = SigKES v -> SignedKES v a
forall v a. SigKES v -> SignedKES v a
SignedKES (SigKES v -> SignedKES v a) -> m (SigKES v) -> m (SignedKES v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m (SigKES v)
forall a (m :: * -> *).
(FixedSizeCodec a, MonadFail m) =>
ByteString -> m a
forall (m :: * -> *). MonadFail m => ByteString -> m (SigKES v)
rawDecodeFixedSized ByteString
bs

-- use generic instance

signedKES ::
  (KESAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
  ContextKES v ->
  Period ->
  a ->
  SignKeyKES v ->
  m (SignedKES v a)
signedKES :: forall v a (m :: * -> *).
(KESAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextKES v -> Word -> a -> SignKeyKES v -> m (SignedKES v a)
signedKES ContextKES v
ctxt Word
time a
a SignKeyKES v
key = SigKES v -> SignedKES v a
forall v a. SigKES v -> SignedKES v a
SignedKES (SigKES v -> SignedKES v a) -> m (SigKES v) -> m (SignedKES v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContextKES v -> Word -> a -> SignKeyKES v -> m (SigKES v)
forall v a (m :: * -> *).
(KESAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextKES v -> Word -> a -> SignKeyKES v -> m (SigKES v)
forall a (m :: * -> *).
(Signable v a, MonadST m, MonadThrow m) =>
ContextKES v -> Word -> a -> SignKeyKES v -> m (SigKES v)
signKES ContextKES v
ctxt Word
time a
a SignKeyKES v
key

verifySignedKES ::
  (KESAlgorithm v, Signable v a) =>
  ContextKES v ->
  VerKeyKES v ->
  Period ->
  a ->
  SignedKES v a ->
  Either String ()
verifySignedKES :: forall v a.
(KESAlgorithm v, Signable v a) =>
ContextKES v
-> VerKeyKES v -> Word -> a -> SignedKES v a -> Either String ()
verifySignedKES ContextKES v
ctxt VerKeyKES v
vk Word
j a
a (SignedKES SigKES v
sig) = ContextKES v
-> VerKeyKES v -> Word -> a -> SigKES v -> Either String ()
forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v
-> VerKeyKES v -> Word -> a -> SigKES v -> Either String ()
forall a.
(Signable v a, HasCallStack) =>
ContextKES v
-> VerKeyKES v -> Word -> a -> SigKES v -> Either String ()
verifyKES ContextKES v
ctxt VerKeyKES v
vk Word
j a
a SigKES v
sig

unsoundPureSignedKES ::
  (UnsoundPureKESAlgorithm v, Signable v a) =>
  ContextKES v ->
  Period ->
  a ->
  UnsoundPureSignKeyKES v ->
  SignedKES v a
unsoundPureSignedKES :: forall v a.
(UnsoundPureKESAlgorithm v, Signable v a) =>
ContextKES v
-> Word -> a -> UnsoundPureSignKeyKES v -> SignedKES v a
unsoundPureSignedKES ContextKES v
ctxt Word
time a
a UnsoundPureSignKeyKES v
key = SigKES v -> SignedKES v a
forall v a. SigKES v -> SignedKES v a
SignedKES (SigKES v -> SignedKES v a) -> SigKES v -> SignedKES v a
forall a b. (a -> b) -> a -> b
$ ContextKES v -> Word -> a -> UnsoundPureSignKeyKES v -> SigKES v
forall v a.
(UnsoundPureKESAlgorithm v, Signable v a) =>
ContextKES v -> Word -> a -> UnsoundPureSignKeyKES v -> SigKES v
forall a.
Signable v a =>
ContextKES v -> Word -> a -> UnsoundPureSignKeyKES v -> SigKES v
unsoundPureSignKES ContextKES v
ctxt Word
time a
a UnsoundPureSignKeyKES v
key

encodeSignedKES :: KESAlgorithm v => SignedKES v a -> Encoding
encodeSignedKES :: forall v a. KESAlgorithm v => SignedKES v a -> Encoding
encodeSignedKES = SignedKES v a -> Encoding
forall a. FixedSizeCodec a => a -> Encoding
encodeFixedSized
{-# DEPRECATED encodeSignedKES "Use `encodeFixedSized` instead" #-}

decodeSignedKES :: KESAlgorithm v => Decoder s (SignedKES v a)
decodeSignedKES :: forall v s a. KESAlgorithm v => Decoder s (SignedKES v a)
decodeSignedKES = Decoder s (SignedKES v a)
forall a s. FixedSizeCodec a => Decoder s a
decodeFixedSized
{-# INLINE decodeSignedKES #-}
{-# DEPRECATED decodeSignedKES "Use `decodeFixedSized` instead" #-}

-- | A sign key bundled with its associated period.
data SignKeyWithPeriodKES v = SignKeyWithPeriodKES
  { forall v. SignKeyWithPeriodKES v -> SignKeyKES v
skWithoutPeriodKES :: !(SignKeyKES v)
  , forall v. SignKeyWithPeriodKES v -> Word
periodKES :: !Period
  }
  deriving ((forall x.
 SignKeyWithPeriodKES v -> Rep (SignKeyWithPeriodKES v) x)
-> (forall x.
    Rep (SignKeyWithPeriodKES v) x -> SignKeyWithPeriodKES v)
-> Generic (SignKeyWithPeriodKES v)
forall x. Rep (SignKeyWithPeriodKES v) x -> SignKeyWithPeriodKES v
forall x. SignKeyWithPeriodKES v -> Rep (SignKeyWithPeriodKES v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x.
Rep (SignKeyWithPeriodKES v) x -> SignKeyWithPeriodKES v
forall v x.
SignKeyWithPeriodKES v -> Rep (SignKeyWithPeriodKES v) x
$cfrom :: forall v x.
SignKeyWithPeriodKES v -> Rep (SignKeyWithPeriodKES v) x
from :: forall x. SignKeyWithPeriodKES v -> Rep (SignKeyWithPeriodKES v) x
$cto :: forall v x.
Rep (SignKeyWithPeriodKES v) x -> SignKeyWithPeriodKES v
to :: forall x. Rep (SignKeyWithPeriodKES v) x -> SignKeyWithPeriodKES v
Generic)

deriving instance (KESAlgorithm v, Eq (SignKeyKES v)) => Eq (SignKeyWithPeriodKES v)

deriving instance (KESAlgorithm v, Show (SignKeyKES v)) => Show (SignKeyWithPeriodKES v)

instance KESAlgorithm v => NoThunks (SignKeyWithPeriodKES v)

-- use generic instance

updateKESWithPeriod ::
  (KESAlgorithm v, MonadST m, MonadThrow m) =>
  ContextKES v ->
  SignKeyWithPeriodKES v ->
  m (Maybe (SignKeyWithPeriodKES v))
updateKESWithPeriod :: forall v (m :: * -> *).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
ContextKES v
-> SignKeyWithPeriodKES v -> m (Maybe (SignKeyWithPeriodKES v))
updateKESWithPeriod ContextKES v
c (SignKeyWithPeriodKES SignKeyKES v
sk Word
t) = MaybeT m (SignKeyWithPeriodKES v)
-> m (Maybe (SignKeyWithPeriodKES v))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m (SignKeyWithPeriodKES v)
 -> m (Maybe (SignKeyWithPeriodKES v)))
-> MaybeT m (SignKeyWithPeriodKES v)
-> m (Maybe (SignKeyWithPeriodKES v))
forall a b. (a -> b) -> a -> b
$ do
  SignKeyKES v
sk' <- m (Maybe (SignKeyKES v)) -> MaybeT m (SignKeyKES v)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (SignKeyKES v)) -> MaybeT m (SignKeyKES v))
-> m (Maybe (SignKeyKES v)) -> MaybeT m (SignKeyKES v)
forall a b. (a -> b) -> a -> b
$ ContextKES v -> SignKeyKES v -> Word -> m (Maybe (SignKeyKES v))
forall v (m :: * -> *).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
ContextKES v -> SignKeyKES v -> Word -> m (Maybe (SignKeyKES v))
updateKES ContextKES v
c SignKeyKES v
sk Word
t
  SignKeyWithPeriodKES v -> MaybeT m (SignKeyWithPeriodKES v)
forall a. a -> MaybeT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SignKeyWithPeriodKES v -> MaybeT m (SignKeyWithPeriodKES v))
-> SignKeyWithPeriodKES v -> MaybeT m (SignKeyWithPeriodKES v)
forall a b. (a -> b) -> a -> b
$ SignKeyKES v -> Word -> SignKeyWithPeriodKES v
forall v. SignKeyKES v -> Word -> SignKeyWithPeriodKES v
SignKeyWithPeriodKES SignKeyKES v
sk' (Word -> Word
forall a. Enum a => a -> a
succ Word
t)

--
-- 'Size' expressions for 'ToCBOR' instances.
--

encodedVerKeyKESSizeExpr :: forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size
encodedVerKeyKESSizeExpr :: forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size
encodedVerKeyKESSizeExpr Proxy (VerKeyKES v)
_proxy =
  -- 'encodeBytes' envelope
  forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Size (Word -> Integer
forall s a. (Integral s, Integral a) => s -> a
withWordSize (Proxy (VerKeyKES v) -> Word
forall a (proxy :: * -> *). FixedSizeCodec a => proxy a -> Word
fixedSize (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(VerKeyKES v))))
    -- payload
    Size -> Size -> Size
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Size (Proxy (VerKeyKES v) -> Word
forall a (proxy :: * -> *). FixedSizeCodec a => proxy a -> Word
fixedSize (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(VerKeyKES v)))

-- | 'Size' expression for 'SignKeyKES' which is using 'signKeySizeKES' encoded
-- as 'Size'.
encodedSignKeyKESSizeExpr :: forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr :: forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr Proxy (SignKeyKES v)
_proxy =
  -- 'encodeBytes' envelope
  forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Size (Word -> Integer
forall s a. (Integral s, Integral a) => s -> a
withWordSize (Proxy v -> Word
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
signKeySizeKES (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v)))
    -- payload
    Size -> Size -> Size
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Size (Proxy v -> Word
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
signKeySizeKES (Proxy v
forall {k} (t :: k). Proxy t
Proxy :: Proxy v))

encodedSigKESSizeExpr :: forall v. KESAlgorithm v => Proxy (SigKES v) -> Size
encodedSigKESSizeExpr :: forall v. KESAlgorithm v => Proxy (SigKES v) -> Size
encodedSigKESSizeExpr Proxy (SigKES v)
_proxy =
  -- 'encodeBytes' envelope
  forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer @Size (Word -> Integer
forall s a. (Integral s, Integral a) => s -> a
withWordSize (Proxy (SigKES v) -> Word
forall a (proxy :: * -> *). FixedSizeCodec a => proxy a -> Word
fixedSize (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SigKES v))))
    -- payload
    Size -> Size -> Size
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Size (Proxy (SigKES v) -> Word
forall a (proxy :: * -> *). FixedSizeCodec a => proxy a -> Word
fixedSize (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SigKES v)))

hashPairOfVKeys ::
  (KESAlgorithm d, HashAlgorithm h) =>
  (VerKeyKES d, VerKeyKES d) ->
  Hash h (VerKeyKES d, VerKeyKES d)
hashPairOfVKeys :: forall d h.
(KESAlgorithm d, HashAlgorithm h) =>
(VerKeyKES d, VerKeyKES d) -> Hash h (VerKeyKES d, VerKeyKES d)
hashPairOfVKeys =
  ((VerKeyKES d, VerKeyKES d) -> ByteString)
-> (VerKeyKES d, VerKeyKES d) -> Hash h (VerKeyKES d, VerKeyKES d)
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith (((VerKeyKES d, VerKeyKES d) -> ByteString)
 -> (VerKeyKES d, VerKeyKES d) -> Hash h (VerKeyKES d, VerKeyKES d))
-> ((VerKeyKES d, VerKeyKES d) -> ByteString)
-> (VerKeyKES d, VerKeyKES d)
-> Hash h (VerKeyKES d, VerKeyKES d)
forall a b. (a -> b) -> a -> b
$ \(VerKeyKES d
a, VerKeyKES d
b) ->
    VerKeyKES d -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized VerKeyKES d
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> VerKeyKES d -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized VerKeyKES d
b

mungeName :: String -> String
mungeName :: String -> String
mungeName String
basename
  | (String
name, Char
'^' : String
nstr) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'^') String
basename
  , [(Word
n, String
"")] <- ReadS Word
forall a. Read a => ReadS a
reads String
nstr =
      String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'^' Char -> String -> String
forall a. a -> [a] -> [a]
: Word -> String
forall a. Show a => a -> String
show (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1 :: Word)
  | Bool
otherwise =
      String
basename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_2^1"