{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoStarIsType #-}

-- | A key evolving signatures implementation.
--
-- It is a naive recursive implementation of the sum composition from
-- section 3.1 of the \"MMM\" paper:
--
-- /Composition and Efficiency Tradeoffs for Forward-Secure Digital Signatures/
-- By Tal Malkin, Daniele Micciancio and Sara Miner
-- <https://eprint.iacr.org/2001/034>
--
-- Specfically we do the binary sum composition directly as in the paper, and
-- then use that in a nested\/recursive fashion to construct a 7-level deep
-- binary tree version.
--
-- This relies on "Cardano.Crypto.KES.Single" for the base case.
--
-- NOTE - some functions in this module have been deliberately marked NOINLINE;
-- this is necessary to avoid an edge case in GHC that causes the simplifier to
-- go haywire, leading to a @Simplifier ticks exhausted@ error and very long
-- compilation times. Worse yet, this error will only appear when compiling
-- code that depends on this module, not when compiling the module itself.
module Cardano.Crypto.KES.Sum (
  SumKES,
  VerKeyKES (..),
  SignKeyKES (..),
  SigKES (..),

  -- * Type aliases for powers of binary sums
  Sum0KES,
  Sum1KES,
  Sum2KES,
  Sum3KES,
  Sum4KES,
  Sum5KES,
  Sum6KES,
  Sum7KES,
) where

import Control.Monad (guard, (<$!>))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (..))

import Cardano.Binary (FromCBOR (..), ToCBOR (..))

import Cardano.Crypto.DirectSerialise
import Cardano.Crypto.Hash.Class
import Cardano.Crypto.KES.Class
import Cardano.Crypto.KES.Single (SingleKES)
import Cardano.Crypto.Libsodium
import Cardano.Crypto.Libsodium.MLockedSeed
import Cardano.Crypto.Libsodium.Memory
import Cardano.Crypto.Seed
import Cardano.Crypto.Util

import Control.DeepSeq (NFData (..))
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Foreign.Ptr (castPtr)
import GHC.TypeLits (KnownNat, type (*), type (+))

-- | A 2^0 period KES
type Sum0KES d = SingleKES d

-- | A 2^1 period KES
type Sum1KES d h = SumKES h (Sum0KES d)

-- | A 2^2 period KES
type Sum2KES d h = SumKES h (Sum1KES d h)

-- | A 2^3 period KES
type Sum3KES d h = SumKES h (Sum2KES d h)

-- | A 2^4 period KES
type Sum4KES d h = SumKES h (Sum3KES d h)

-- | A 2^5 period KES
type Sum5KES d h = SumKES h (Sum4KES d h)

-- | A 2^6 period KES
type Sum6KES d h = SumKES h (Sum5KES d h)

-- | A 2^7 period KES
type Sum7KES d h = SumKES h (Sum6KES d h)

-- | A composition of two KES schemes to give a KES scheme with the sum of
-- the time periods.
--
-- While we could do this with two independent KES schemes (i.e. two types)
-- we only need it for two instances of the same scheme, and we save
-- substantially on the size of the type and runtime dictionaries if we do it
-- this way, especially when we start applying it recursively.
data SumKES h d

instance
  (NFData (SigKES d), NFData (VerKeyKES d)) =>
  NFData (SigKES (SumKES h d))

instance
  (NFData (SignKeyKES d), NFData (VerKeyKES d)) =>
  NFData (SignKeyKES (SumKES h d))
  where
  rnf :: SignKeyKES (SumKES h d) -> ()
rnf (SignKeySumKES SignKeyKES d
sk MLockedSeed (SeedSizeKES d)
r VerKeyKES d
vk1 VerKeyKES d
vk2) =
    forall a. NFData a => a -> ()
rnf (SignKeyKES d
sk, MLockedSeed (SeedSizeKES d)
r, VerKeyKES d
vk1, VerKeyKES d
vk2)

instance
  ( KESAlgorithm d
  , SodiumHashAlgorithm h -- needed for secure forgetting
  , SizeHash h ~ SeedSizeKES d -- can be relaxed
  , KnownNat ((SizeSignKeyKES d + SeedSizeKES d) + (2 * SizeVerKeyKES d))
  , KnownNat (SizeSigKES d + (SizeVerKeyKES d * 2))
  ) =>
  KESAlgorithm (SumKES h d)
  where
  -- \| From Figure 3: @(sk_0, r_1, vk_0, vk_1)@
  data SignKeyKES (SumKES h d)
    = SignKeySumKES
        !(SignKeyKES d)
        !(MLockedSeed (SeedSizeKES d))
        !(VerKeyKES d)
        !(VerKeyKES d)

  type SeedSizeKES (SumKES h d) = SeedSizeKES d

  --
  -- Key and signature types
  --

  -- \| From Section 3,1:
  --
  -- The verification key @vk@ for the sum scheme is the hash of the
  -- verification keys @vk_0, vk_1@ of the two constituent schemes.
  newtype VerKeyKES (SumKES h d)
    = VerKeySumKES (Hash h (VerKeyKES d, VerKeyKES d))
    deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall h d x.
Rep (VerKeyKES (SumKES h d)) x -> VerKeyKES (SumKES h d)
forall h d x.
VerKeyKES (SumKES h d) -> Rep (VerKeyKES (SumKES h d)) x
$cto :: forall h d x.
Rep (VerKeyKES (SumKES h d)) x -> VerKeyKES (SumKES h d)
$cfrom :: forall h d x.
VerKeyKES (SumKES h d) -> Rep (VerKeyKES (SumKES h d)) x
Generic)
    deriving newtype (VerKeyKES (SumKES h d) -> ()
forall a. (a -> ()) -> NFData a
forall h d. VerKeyKES (SumKES h d) -> ()
rnf :: VerKeyKES (SumKES h d) -> ()
$crnf :: forall h d. VerKeyKES (SumKES h d) -> ()
NFData)

  -- \| From Figure 3: @(sigma, vk_0, vk_1)@
  data SigKES (SumKES h d)
    = SigSumKES
        !(SigKES d)
        !(VerKeyKES d)
        !(VerKeyKES d)
    deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall h d x. Rep (SigKES (SumKES h d)) x -> SigKES (SumKES h d)
forall h d x. SigKES (SumKES h d) -> Rep (SigKES (SumKES h d)) x
$cto :: forall h d x. Rep (SigKES (SumKES h d)) x -> SigKES (SumKES h d)
$cfrom :: forall h d x. SigKES (SumKES h d) -> Rep (SigKES (SumKES h d)) x
Generic)

  --
  -- Metadata and basic key operations
  --

  algorithmNameKES :: forall (proxy :: Type -> Type). proxy (SumKES h d) -> String
algorithmNameKES proxy (SumKES h d)
_ = String -> String
mungeName (forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> String
algorithmNameKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d))

  -- The verification key in this scheme is actually a hash already
  -- however the type of hashVerKeyKES says the caller gets to choose
  -- the hash, not the implementation. So that's why we have to hash
  -- the hash here. We could alternatively provide a "key identifier"
  -- function and let the implementation choose what that is.
  hashVerKeyKES :: forall h.
HashAlgorithm h =>
VerKeyKES (SumKES h d) -> Hash h (VerKeyKES (SumKES h d))
hashVerKeyKES (VerKeySumKES Hash h (VerKeyKES d, VerKeyKES d)
vk) = forall h a b. Hash h a -> Hash h b
castHash (forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith forall h a. Hash h a -> ByteString
hashToBytes Hash h (VerKeyKES d, VerKeyKES d)
vk)

  --
  -- Core algorithm operations
  --

  type Signable (SumKES h d) = Signable d
  type ContextKES (SumKES h d) = ContextKES d

  verifyKES :: forall a.
(Signable (SumKES h d) a, HasCallStack) =>
ContextKES (SumKES h d)
-> VerKeyKES (SumKES h d)
-> Period
-> a
-> SigKES (SumKES h d)
-> Either String ()
verifyKES ContextKES (SumKES h d)
ctxt (VerKeySumKES Hash h (VerKeyKES d, VerKeyKES d)
vk) Period
t a
a (SigSumKES SigKES d
sigma VerKeyKES d
vk_0 VerKeyKES d
vk_1)
    | forall d h.
(KESAlgorithm d, HashAlgorithm h) =>
(VerKeyKES d, VerKeyKES d) -> Hash h (VerKeyKES d, VerKeyKES d)
hashPairOfVKeys (VerKeyKES d
vk_0, VerKeyKES d
vk_1) forall a. Eq a => a -> a -> Bool
/= Hash h (VerKeyKES d, VerKeyKES d)
vk =
        forall a b. a -> Either a b
Left String
"Reject"
    | Period
t forall a. Ord a => a -> a -> Bool
< Period
_T = forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v
-> VerKeyKES v -> Period -> a -> SigKES v -> Either String ()
verifyKES ContextKES (SumKES h d)
ctxt VerKeyKES d
vk_0 Period
t a
a SigKES d
sigma
    | Bool
otherwise = forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v
-> VerKeyKES v -> Period -> a -> SigKES v -> Either String ()
verifyKES ContextKES (SumKES h d)
ctxt VerKeyKES d
vk_1 (Period
t forall a. Num a => a -> a -> a
- Period
_T) a
a SigKES d
sigma
    where
      _T :: Period
_T = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
totalPeriodsKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)

  totalPeriodsKES :: forall (proxy :: Type -> Type). proxy (SumKES h d) -> Period
totalPeriodsKES proxy (SumKES h d)
_ = Period
2 forall a. Num a => a -> a -> a
* forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
totalPeriodsKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)

  --
  -- raw serialise/deserialise
  --

  type SizeVerKeyKES (SumKES h d) = SizeHash h
  type
    SizeSignKeyKES (SumKES h d) =
      SizeSignKeyKES d
        + SeedSizeKES d
        + 2 * SizeVerKeyKES d
  type
    SizeSigKES (SumKES h d) =
      SizeSigKES d
        + SizeVerKeyKES d * 2

  rawSerialiseVerKeyKES :: VerKeyKES (SumKES h d) -> ByteString
rawSerialiseVerKeyKES (VerKeySumKES Hash h (VerKeyKES d, VerKeyKES d)
vk) = forall h a. Hash h a -> ByteString
hashToBytes Hash h (VerKeyKES d, VerKeyKES d)
vk

  rawSerialiseSigKES :: SigKES (SumKES h d) -> ByteString
rawSerialiseSigKES (SigSumKES SigKES d
sigma VerKeyKES d
vk_0 VerKeyKES d
vk_1) =
    forall a. Monoid a => [a] -> a
mconcat
      [ forall v. KESAlgorithm v => SigKES v -> ByteString
rawSerialiseSigKES SigKES d
sigma
      , forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES d
vk_0
      , forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES d
vk_1
      ]

  rawDeserialiseVerKeyKES :: ByteString -> Maybe (VerKeyKES (SumKES h d))
rawDeserialiseVerKeyKES = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall h d.
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d)
VerKeySumKES forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes
  {-# INLINE rawDeserialiseVerKeyKES #-}

  rawDeserialiseSigKES :: ByteString -> Maybe (SigKES (SumKES h d))
rawDeserialiseSigKES ByteString
b = do
    forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
b forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
size_total)
    SigKES d
sigma <- forall v. KESAlgorithm v => ByteString -> Maybe (SigKES v)
rawDeserialiseSigKES ByteString
b_sig
    VerKeyKES d
vk_0 <- forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
b_vk0
    VerKeyKES d
vk_1 <- forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
b_vk1
    forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall h d.
SigKES d -> VerKeyKES d -> VerKeyKES d -> SigKES (SumKES h d)
SigSumKES SigKES d
sigma VerKeyKES d
vk_0 VerKeyKES d
vk_1)
    where
      b_sig :: ByteString
b_sig = Period -> Period -> ByteString -> ByteString
slice Period
off_sig Period
size_sig ByteString
b
      b_vk0 :: ByteString
b_vk0 = Period -> Period -> ByteString -> ByteString
slice Period
off_vk0 Period
size_vk ByteString
b
      b_vk1 :: ByteString
b_vk1 = Period -> Period -> ByteString -> ByteString
slice Period
off_vk1 Period
size_vk ByteString
b

      size_sig :: Period
size_sig = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSigKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_vk :: Period
size_vk = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeVerKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_total :: Period
size_total = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSigKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy (SumKES h d))

      off_sig :: Period
off_sig = Period
0 :: Word
      off_vk0 :: Period
off_vk0 = Period
size_sig
      off_vk1 :: Period
off_vk1 = Period
off_vk0 forall a. Num a => a -> a -> a
+ Period
size_vk
  {-# INLINEABLE rawDeserialiseSigKES #-}

  deriveVerKeyKES :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
SignKeyKES (SumKES h d) -> m (VerKeyKES (SumKES h d))
deriveVerKeyKES (SignKeySumKES SignKeyKES d
_ MLockedSeed (SeedSizeKES d)
_ VerKeyKES d
vk_0 VerKeyKES d
vk_1) =
    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall h d.
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d)
VerKeySumKES (forall d h.
(KESAlgorithm d, HashAlgorithm h) =>
(VerKeyKES d, VerKeyKES d) -> Hash h (VerKeyKES d, VerKeyKES d)
hashPairOfVKeys (VerKeyKES d
vk_0, VerKeyKES d
vk_1))

  signKES :: forall a (m :: Type -> Type).
(Signable (SumKES h d) a, MonadST m, MonadThrow m) =>
ContextKES (SumKES h d)
-> Period
-> a
-> SignKeyKES (SumKES h d)
-> m (SigKES (SumKES h d))
signKES ContextKES (SumKES h d)
ctxt Period
t a
a (SignKeySumKES SignKeyKES d
sk MLockedSeed (SeedSizeKES d)
_r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1) = do
    SigKES d
sigma <- m (SigKES d)
getSigma
    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall h d.
SigKES d -> VerKeyKES d -> VerKeyKES d -> SigKES (SumKES h d)
SigSumKES SigKES d
sigma VerKeyKES d
vk_0 VerKeyKES d
vk_1
    where
      getSigma :: m (SigKES d)
getSigma
        | Period
t forall a. Ord a => a -> a -> Bool
< Period
_T = forall v a (m :: Type -> Type).
(KESAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextKES v -> Period -> a -> SignKeyKES v -> m (SigKES v)
signKES ContextKES (SumKES h d)
ctxt Period
t a
a SignKeyKES d
sk
        | Bool
otherwise = forall v a (m :: Type -> Type).
(KESAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextKES v -> Period -> a -> SignKeyKES v -> m (SigKES v)
signKES ContextKES (SumKES h d)
ctxt (Period
t forall a. Num a => a -> a -> a
- Period
_T) a
a SignKeyKES d
sk

      _T :: Period
_T = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
totalPeriodsKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)

  {-# NOINLINE updateKESWith #-}
  updateKESWith :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ContextKES (SumKES h d)
-> SignKeyKES (SumKES h d)
-> Period
-> m (Maybe (SignKeyKES (SumKES h d)))
updateKESWith MLockedAllocator m
allocator ContextKES (SumKES h d)
ctx (SignKeySumKES SignKeyKES d
sk MLockedSeed (SeedSizeKES d)
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1) Period
t
    | Period
t forall a. Num a => a -> a -> a
+ Period
1 forall a. Ord a => a -> a -> Bool
< Period
_T =
        forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$!
          do
            SignKeyKES d
sk' <- forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$! forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ContextKES v
-> SignKeyKES v
-> Period
-> m (Maybe (SignKeyKES v))
updateKESWith MLockedAllocator m
allocator ContextKES (SumKES h d)
ctx SignKeyKES d
sk Period
t
            MLockedSeed (SeedSizeKES d)
r_1' <- forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall (m :: Type -> Type) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall (n :: Nat) (m :: Type -> Type).
(KnownNat n, MonadST m) =>
MLockedSeed n -> m (MLockedSeed n)
mlockedSeedCopy MLockedSeed (SeedSizeKES d)
r_1
            forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES SignKeyKES d
sk' MLockedSeed (SeedSizeKES d)
r_1' VerKeyKES d
vk_0 VerKeyKES d
vk_1
    | Period
t forall a. Num a => a -> a -> a
+ Period
1 forall a. Eq a => a -> a -> Bool
== Period
_T = do
        SignKeyKES d
sk' <- forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES v) -> m (SignKeyKES v)
genKeyKESWith MLockedAllocator m
allocator MLockedSeed (SeedSizeKES d)
r_1
        MLockedSeed (SeedSizeKES d)
r_1' <- forall (n :: Nat) (m :: Type -> Type).
(KnownNat n, MonadST m) =>
MLockedAllocator m -> m (MLockedSeed n)
mlockedSeedNewZeroWith MLockedAllocator m
allocator
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES SignKeyKES d
sk' MLockedSeed (SeedSizeKES d)
r_1' VerKeyKES d
vk_0 VerKeyKES d
vk_1
    | Bool
otherwise = forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$
        do
          SignKeyKES d
sk' <- forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$! forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ContextKES v
-> SignKeyKES v
-> Period
-> m (Maybe (SignKeyKES v))
updateKESWith MLockedAllocator m
allocator ContextKES (SumKES h d)
ctx SignKeyKES d
sk (Period
t forall a. Num a => a -> a -> a
- Period
_T)
          MLockedSeed (SeedSizeKES d)
r_1' <- forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall (m :: Type -> Type) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall (n :: Nat) (m :: Type -> Type).
(KnownNat n, MonadST m) =>
MLockedAllocator m -> MLockedSeed n -> m (MLockedSeed n)
mlockedSeedCopyWith MLockedAllocator m
allocator MLockedSeed (SeedSizeKES d)
r_1
          forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES SignKeyKES d
sk' MLockedSeed (SeedSizeKES d)
r_1' VerKeyKES d
vk_0 VerKeyKES d
vk_1
    where
      _T :: Period
_T = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
totalPeriodsKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)

  --
  -- Key generation
  --

  {-# NOINLINE genKeyKESWith #-}
  genKeyKESWith :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES (SumKES h d))
-> m (SignKeyKES (SumKES h d))
genKeyKESWith MLockedAllocator m
allocator MLockedSeed (SeedSizeKES (SumKES h d))
r = do
    (MLockedSizedBytes (SeedSizeKES d)
r0raw, MLockedSizedBytes (SeedSizeKES d)
r1raw) <- forall h (m :: Type -> Type) (proxy :: Type -> Type).
(SodiumHashAlgorithm h, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> proxy h
-> MLockedSizedBytes (SizeHash h)
-> m (MLockedSizedBytes (SizeHash h),
      MLockedSizedBytes (SizeHash h))
expandHashWith MLockedAllocator m
allocator (forall {k} (t :: k). Proxy t
Proxy :: Proxy h) (forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB MLockedSeed (SeedSizeKES (SumKES h d))
r)
    let r0 :: MLockedSeed (SeedSizeKES d)
r0 = forall (n :: Nat). MLockedSizedBytes n -> MLockedSeed n
MLockedSeed MLockedSizedBytes (SeedSizeKES d)
r0raw
        r1 :: MLockedSeed (SeedSizeKES d)
r1 = forall (n :: Nat). MLockedSizedBytes n -> MLockedSeed n
MLockedSeed MLockedSizedBytes (SeedSizeKES d)
r1raw
    SignKeyKES d
sk_0 <- forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES v) -> m (SignKeyKES v)
genKeyKESWith MLockedAllocator m
allocator MLockedSeed (SeedSizeKES d)
r0
    VerKeyKES d
vk_0 <- forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyKES v -> m (VerKeyKES v)
deriveVerKeyKES SignKeyKES d
sk_0
    SignKeyKES d
sk_1 <- forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES v) -> m (SignKeyKES v)
genKeyKESWith MLockedAllocator m
allocator MLockedSeed (SeedSizeKES d)
r1
    VerKeyKES d
vk_1 <- forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyKES v -> m (VerKeyKES v)
deriveVerKeyKES SignKeyKES d
sk_1
    forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyKES v -> m ()
forgetSignKeyKES SignKeyKES d
sk_1
    forall (m :: Type -> Type) (n :: Nat).
MonadST m =>
MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed (SeedSizeKES d)
r0
    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES SignKeyKES d
sk_0 MLockedSeed (SeedSizeKES d)
r1 VerKeyKES d
vk_0 VerKeyKES d
vk_1

  --
  -- forgetting
  --
  forgetSignKeyKESWith :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyKES (SumKES h d) -> m ()
forgetSignKeyKESWith MLockedAllocator m
allocator (SignKeySumKES SignKeyKES d
sk_0 MLockedSeed (SeedSizeKES d)
r1 VerKeyKES d
_ VerKeyKES d
_) = do
    forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyKES v -> m ()
forgetSignKeyKESWith MLockedAllocator m
allocator SignKeyKES d
sk_0
    forall (m :: Type -> Type) (n :: Nat).
MonadST m =>
MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed (SeedSizeKES d)
r1

instance
  ( KESAlgorithm (SumKES h d)
  , UnsoundKESAlgorithm d
  ) =>
  UnsoundKESAlgorithm (SumKES h d)
  where
  --
  -- Raw serialise/deserialise - dangerous, do not use in production code.
  --

  {-# NOINLINE rawSerialiseSignKeyKES #-}
  rawSerialiseSignKeyKES :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
SignKeyKES (SumKES h d) -> m ByteString
rawSerialiseSignKeyKES (SignKeySumKES SignKeyKES d
sk MLockedSeed (SeedSizeKES d)
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1) = do
    ByteString
ssk <- forall v (m :: Type -> Type).
(UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyKES v -> m ByteString
rawSerialiseSignKeyKES SignKeyKES d
sk
    ByteString
sr1 <- forall (n :: Nat) (m :: Type -> Type).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB forall a b. (a -> b) -> a -> b
$ MLockedSeed (SeedSizeKES d)
r_1
    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      forall a. Monoid a => [a] -> a
mconcat
        [ ByteString
ssk
        , ByteString
sr1
        , forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES d
vk_0
        , forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES d
vk_1
        ]

  {-# NOINLINE rawDeserialiseSignKeyKESWith #-}
  rawDeserialiseSignKeyKESWith :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ByteString -> m (Maybe (SignKeyKES (SumKES h d)))
rawDeserialiseSignKeyKESWith MLockedAllocator m
allocator ByteString
b = forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
    forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
b forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
size_total)
    SignKeyKES d
sk <- forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall v (m :: Type -> Type).
(UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m -> ByteString -> m (Maybe (SignKeyKES v))
rawDeserialiseSignKeyKESWith MLockedAllocator m
allocator ByteString
b_sk
    MLockedSizedBytes (SeedSizeKES d)
r <- forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (m :: Type -> Type).
(KnownNat n, MonadST m) =>
MLockedAllocator m -> ByteString -> m (Maybe (MLockedSizedBytes n))
mlsbFromByteStringCheckWith MLockedAllocator m
allocator ByteString
b_r
    VerKeyKES d
vk_0 <- forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
b_vk0
    VerKeyKES d
vk_1 <- forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
b_vk1
    forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES SignKeyKES d
sk (forall (n :: Nat). MLockedSizedBytes n -> MLockedSeed n
MLockedSeed MLockedSizedBytes (SeedSizeKES d)
r) VerKeyKES d
vk_0 VerKeyKES d
vk_1)
    where
      b_sk :: ByteString
b_sk = Period -> Period -> ByteString -> ByteString
slice Period
off_sk Period
size_sk ByteString
b
      b_r :: ByteString
b_r = Period -> Period -> ByteString -> ByteString
slice Period
off_r Period
size_r ByteString
b
      b_vk0 :: ByteString
b_vk0 = Period -> Period -> ByteString -> ByteString
slice Period
off_vk0 Period
size_vk ByteString
b
      b_vk1 :: ByteString
b_vk1 = Period -> Period -> ByteString -> ByteString
slice Period
off_vk1 Period
size_vk ByteString
b

      size_sk :: Period
size_sk = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSignKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_r :: Period
size_r = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
seedSizeKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_vk :: Period
size_vk = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeVerKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_total :: Period
size_total = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSignKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy (SumKES h d))

      off_sk :: Period
off_sk = Period
0 :: Word
      off_r :: Period
off_r = Period
size_sk
      off_vk0 :: Period
off_vk0 = Period
off_r forall a. Num a => a -> a -> a
+ Period
size_r
      off_vk1 :: Period
off_vk1 = Period
off_vk0 forall a. Num a => a -> a -> a
+ Period
size_vk

--
-- VerKey instances
--

deriving instance HashAlgorithm h => Show (VerKeyKES (SumKES h d))
deriving instance Eq (VerKeyKES (SumKES h d))

instance
  (KESAlgorithm (SumKES h d), SodiumHashAlgorithm h, SizeHash h ~ SeedSizeKES d) =>
  ToCBOR (VerKeyKES (SumKES h d))
  where
  toCBOR :: VerKeyKES (SumKES h d) -> Encoding
toCBOR = forall v. KESAlgorithm v => VerKeyKES v -> Encoding
encodeVerKeyKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerKeyKES (SumKES h d)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size
encodedVerKeyKESSizeExpr

instance
  (KESAlgorithm (SumKES h d), SodiumHashAlgorithm h, SizeHash h ~ SeedSizeKES d) =>
  FromCBOR (VerKeyKES (SumKES h d))
  where
  fromCBOR :: forall s. Decoder s (VerKeyKES (SumKES h d))
fromCBOR = forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES
  {-# INLINE fromCBOR #-}

instance KESAlgorithm d => NoThunks (VerKeyKES (SumKES h d))

--
-- SignKey instances
--

-- These instances would violate mlocking protections, bleeding secret keys
-- onto the GHC heap.
--
-- instance (KESAlgorithm d, HashAlgorithm h, SizeHash h ~ SeedSizeKES d)
--       => ToCBOR (SignKeyKES (SumKES h d)) where
--   toCBOR = encodeSignKeyKES
--   encodedSizeExpr _size = encodedSignKeyKESSizeExpr
--
-- instance (KESAlgorithm d, HashAlgorithm h, SizeHash h ~ SeedSizeKES d)
--       => FromCBOR (SignKeyKES (SumKES h d)) where
--   fromCBOR = decodeSignKeyKES

deriving via
  OnlyCheckWhnfNamed "SignKeyKES (SumKES h d)" (SignKeyKES (SumKES h d))
  instance
    NoThunks (SignKeyKES (SumKES h d))

--
-- Sig instances
--

deriving instance (KESAlgorithm d, KESAlgorithm (SumKES h d)) => Show (SigKES (SumKES h d))
deriving instance (KESAlgorithm d, KESAlgorithm (SumKES h d)) => Eq (SigKES (SumKES h d))

instance KESAlgorithm d => NoThunks (SigKES (SumKES h d))

instance
  (KESAlgorithm (SumKES h d), SodiumHashAlgorithm h, SizeHash h ~ SeedSizeKES d) =>
  ToCBOR (SigKES (SumKES h d))
  where
  toCBOR :: SigKES (SumKES h d) -> Encoding
toCBOR = forall v. KESAlgorithm v => SigKES v -> Encoding
encodeSigKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigKES (SumKES h d)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = forall v. KESAlgorithm v => Proxy (SigKES v) -> Size
encodedSigKESSizeExpr

instance
  (KESAlgorithm (SumKES h d), SodiumHashAlgorithm h, SizeHash h ~ SeedSizeKES d) =>
  FromCBOR (SigKES (SumKES h d))
  where
  fromCBOR :: forall s. Decoder s (SigKES (SumKES h d))
fromCBOR = forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES

--
-- Unsound pure KES API
--
instance
  ( KESAlgorithm (SumKES h d)
  , HashAlgorithm h
  , UnsoundPureKESAlgorithm d
  ) =>
  UnsoundPureKESAlgorithm (SumKES h d)
  where
  data UnsoundPureSignKeyKES (SumKES h d)
    = UnsoundPureSignKeySumKES
        !(UnsoundPureSignKeyKES d)
        !Seed
        !(VerKeyKES d)
        !(VerKeyKES d)
    deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall h d x.
Rep (UnsoundPureSignKeyKES (SumKES h d)) x
-> UnsoundPureSignKeyKES (SumKES h d)
forall h d x.
UnsoundPureSignKeyKES (SumKES h d)
-> Rep (UnsoundPureSignKeyKES (SumKES h d)) x
$cto :: forall h d x.
Rep (UnsoundPureSignKeyKES (SumKES h d)) x
-> UnsoundPureSignKeyKES (SumKES h d)
$cfrom :: forall h d x.
UnsoundPureSignKeyKES (SumKES h d)
-> Rep (UnsoundPureSignKeyKES (SumKES h d)) x
Generic)

  unsoundPureSignKES :: forall a.
Signable (SumKES h d) a =>
ContextKES (SumKES h d)
-> Period
-> a
-> UnsoundPureSignKeyKES (SumKES h d)
-> SigKES (SumKES h d)
unsoundPureSignKES ContextKES (SumKES h d)
ctxt Period
t a
a (UnsoundPureSignKeySumKES UnsoundPureSignKeyKES d
sk Seed
_r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1) =
    forall h d.
SigKES d -> VerKeyKES d -> VerKeyKES d -> SigKES (SumKES h d)
SigSumKES SigKES d
sigma VerKeyKES d
vk_0 VerKeyKES d
vk_1
    where
      sigma :: SigKES d
sigma
        | Period
t forall a. Ord a => a -> a -> Bool
< Period
_T = forall v a.
(UnsoundPureKESAlgorithm v, Signable v a) =>
ContextKES v -> Period -> a -> UnsoundPureSignKeyKES v -> SigKES v
unsoundPureSignKES ContextKES (SumKES h d)
ctxt Period
t a
a UnsoundPureSignKeyKES d
sk
        | Bool
otherwise = forall v a.
(UnsoundPureKESAlgorithm v, Signable v a) =>
ContextKES v -> Period -> a -> UnsoundPureSignKeyKES v -> SigKES v
unsoundPureSignKES ContextKES (SumKES h d)
ctxt (Period
t forall a. Num a => a -> a -> a
- Period
_T) a
a UnsoundPureSignKeyKES d
sk

      _T :: Period
_T = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
totalPeriodsKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)

  unsoundPureUpdateKES :: ContextKES (SumKES h d)
-> UnsoundPureSignKeyKES (SumKES h d)
-> Period
-> Maybe (UnsoundPureSignKeyKES (SumKES h d))
unsoundPureUpdateKES ContextKES (SumKES h d)
ctx (UnsoundPureSignKeySumKES UnsoundPureSignKeyKES d
sk Seed
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1) Period
t
    | Period
t forall a. Num a => a -> a -> a
+ Period
1 forall a. Ord a => a -> a -> Bool
< Period
_T = do
        UnsoundPureSignKeyKES d
sk' <- forall v.
UnsoundPureKESAlgorithm v =>
ContextKES v
-> UnsoundPureSignKeyKES v
-> Period
-> Maybe (UnsoundPureSignKeyKES v)
unsoundPureUpdateKES ContextKES (SumKES h d)
ctx UnsoundPureSignKeyKES d
sk Period
t
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall h d.
UnsoundPureSignKeyKES d
-> Seed
-> VerKeyKES d
-> VerKeyKES d
-> UnsoundPureSignKeyKES (SumKES h d)
UnsoundPureSignKeySumKES UnsoundPureSignKeyKES d
sk' Seed
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1
    | Period
t forall a. Num a => a -> a -> a
+ Period
1 forall a. Eq a => a -> a -> Bool
== Period
_T = do
        let sk' :: UnsoundPureSignKeyKES d
sk' = forall v.
UnsoundPureKESAlgorithm v =>
Seed -> UnsoundPureSignKeyKES v
unsoundPureGenKeyKES Seed
r_1
        let r_1' :: Seed
r_1' = ByteString -> Seed
mkSeedFromBytes (Int -> Word8 -> ByteString
BS.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
seedSizeKES (forall {k} (t :: k). Proxy t
Proxy @d))) Word8
0)
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall h d.
UnsoundPureSignKeyKES d
-> Seed
-> VerKeyKES d
-> VerKeyKES d
-> UnsoundPureSignKeyKES (SumKES h d)
UnsoundPureSignKeySumKES UnsoundPureSignKeyKES d
sk' Seed
r_1' VerKeyKES d
vk_0 VerKeyKES d
vk_1
    | Bool
otherwise = do
        UnsoundPureSignKeyKES d
sk' <- forall v.
UnsoundPureKESAlgorithm v =>
ContextKES v
-> UnsoundPureSignKeyKES v
-> Period
-> Maybe (UnsoundPureSignKeyKES v)
unsoundPureUpdateKES ContextKES (SumKES h d)
ctx UnsoundPureSignKeyKES d
sk (Period
t forall a. Num a => a -> a -> a
- Period
_T)
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall h d.
UnsoundPureSignKeyKES d
-> Seed
-> VerKeyKES d
-> VerKeyKES d
-> UnsoundPureSignKeyKES (SumKES h d)
UnsoundPureSignKeySumKES UnsoundPureSignKeyKES d
sk' Seed
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1
    where
      _T :: Period
_T = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
totalPeriodsKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)

  --
  -- Key generation
  --

  unsoundPureGenKeyKES :: Seed -> UnsoundPureSignKeyKES (SumKES h d)
unsoundPureGenKeyKES Seed
r =
    let (Seed
r0, Seed
r1) = forall h (proxy :: Type -> Type).
HashAlgorithm h =>
proxy h -> Seed -> (Seed, Seed)
expandSeed (forall {k} (t :: k). Proxy t
Proxy @h) Seed
r
        sk_0 :: UnsoundPureSignKeyKES d
sk_0 = forall v.
UnsoundPureKESAlgorithm v =>
Seed -> UnsoundPureSignKeyKES v
unsoundPureGenKeyKES Seed
r0
        vk_0 :: VerKeyKES d
vk_0 = forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> VerKeyKES v
unsoundPureDeriveVerKeyKES UnsoundPureSignKeyKES d
sk_0
        sk_1 :: UnsoundPureSignKeyKES d
sk_1 = forall v.
UnsoundPureKESAlgorithm v =>
Seed -> UnsoundPureSignKeyKES v
unsoundPureGenKeyKES Seed
r1
        vk_1 :: VerKeyKES d
vk_1 = forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> VerKeyKES v
unsoundPureDeriveVerKeyKES UnsoundPureSignKeyKES d
sk_1
     in forall h d.
UnsoundPureSignKeyKES d
-> Seed
-> VerKeyKES d
-> VerKeyKES d
-> UnsoundPureSignKeyKES (SumKES h d)
UnsoundPureSignKeySumKES UnsoundPureSignKeyKES d
sk_0 Seed
r1 VerKeyKES d
vk_0 VerKeyKES d
vk_1

  unsoundPureDeriveVerKeyKES :: UnsoundPureSignKeyKES (SumKES h d) -> VerKeyKES (SumKES h d)
unsoundPureDeriveVerKeyKES (UnsoundPureSignKeySumKES UnsoundPureSignKeyKES d
_ Seed
_ VerKeyKES d
vk_0 VerKeyKES d
vk_1) =
    forall h d.
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d)
VerKeySumKES (forall d h.
(KESAlgorithm d, HashAlgorithm h) =>
(VerKeyKES d, VerKeyKES d) -> Hash h (VerKeyKES d, VerKeyKES d)
hashPairOfVKeys (VerKeyKES d
vk_0, VerKeyKES d
vk_1))

  unsoundPureSignKeyKESToSoundSignKeyKES :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
UnsoundPureSignKeyKES (SumKES h d) -> m (SignKeyKES (SumKES h d))
unsoundPureSignKeyKESToSoundSignKeyKES (UnsoundPureSignKeySumKES UnsoundPureSignKeyKES d
sk Seed
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1) =
    forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES
      forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v (m :: Type -> Type).
(UnsoundPureKESAlgorithm v, MonadST m, MonadThrow m) =>
UnsoundPureSignKeyKES v -> m (SignKeyKES v)
unsoundPureSignKeyKESToSoundSignKeyKES UnsoundPureSignKeyKES d
sk
      forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (n :: Nat). MLockedSizedBytes n -> MLockedSeed n
MLockedSeed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (m :: Type -> Type).
(KnownNat n, MonadST m) =>
ByteString -> m (MLockedSizedBytes n)
mlsbFromByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seed -> ByteString
getSeedBytes forall a b. (a -> b) -> a -> b
$ Seed
r_1)
      forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure VerKeyKES d
vk_0
      forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure VerKeyKES d
vk_1

  rawSerialiseUnsoundPureSignKeyKES :: UnsoundPureSignKeyKES (SumKES h d) -> ByteString
rawSerialiseUnsoundPureSignKeyKES (UnsoundPureSignKeySumKES UnsoundPureSignKeyKES d
sk Seed
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1) =
    let ssk :: ByteString
ssk = forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> ByteString
rawSerialiseUnsoundPureSignKeyKES UnsoundPureSignKeyKES d
sk
        sr1 :: ByteString
sr1 = Seed -> ByteString
getSeedBytes Seed
r_1
     in forall a. Monoid a => [a] -> a
mconcat
          [ ByteString
ssk
          , ByteString
sr1
          , forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES d
vk_0
          , forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES d
vk_1
          ]

  rawDeserialiseUnsoundPureSignKeyKES :: ByteString -> Maybe (UnsoundPureSignKeyKES (SumKES h d))
rawDeserialiseUnsoundPureSignKeyKES ByteString
b = do
    forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
b forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
size_total)
    UnsoundPureSignKeyKES d
sk <- forall v.
UnsoundPureKESAlgorithm v =>
ByteString -> Maybe (UnsoundPureSignKeyKES v)
rawDeserialiseUnsoundPureSignKeyKES ByteString
b_sk
    let r :: Seed
r = ByteString -> Seed
mkSeedFromBytes ByteString
b_r
    VerKeyKES d
vk_0 <- forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
b_vk0
    VerKeyKES d
vk_1 <- forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
b_vk1
    forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall h d.
UnsoundPureSignKeyKES d
-> Seed
-> VerKeyKES d
-> VerKeyKES d
-> UnsoundPureSignKeyKES (SumKES h d)
UnsoundPureSignKeySumKES UnsoundPureSignKeyKES d
sk Seed
r VerKeyKES d
vk_0 VerKeyKES d
vk_1)
    where
      b_sk :: ByteString
b_sk = Period -> Period -> ByteString -> ByteString
slice Period
off_sk Period
size_sk ByteString
b
      b_r :: ByteString
b_r = Period -> Period -> ByteString -> ByteString
slice Period
off_r Period
size_r ByteString
b
      b_vk0 :: ByteString
b_vk0 = Period -> Period -> ByteString -> ByteString
slice Period
off_vk0 Period
size_vk ByteString
b
      b_vk1 :: ByteString
b_vk1 = Period -> Period -> ByteString -> ByteString
slice Period
off_vk1 Period
size_vk ByteString
b

      size_sk :: Period
size_sk = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSignKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_r :: Period
size_r = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
seedSizeKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_vk :: Period
size_vk = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeVerKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_total :: Period
size_total = forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSignKeyKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy (SumKES h d))

      off_sk :: Period
off_sk = Period
0 :: Word
      off_r :: Period
off_r = Period
size_sk
      off_vk0 :: Period
off_vk0 = Period
off_r forall a. Num a => a -> a -> a
+ Period
size_r
      off_vk1 :: Period
off_vk1 = Period
off_vk0 forall a. Num a => a -> a -> a
+ Period
size_vk

--
-- UnsoundPureSignKey instances
--

deriving instance
  (KESAlgorithm d, Show (UnsoundPureSignKeyKES d)) => Show (UnsoundPureSignKeyKES (SumKES h d))
deriving instance
  (KESAlgorithm d, Eq (UnsoundPureSignKeyKES d)) => Eq (UnsoundPureSignKeyKES (SumKES h d))

instance
  ( SizeHash h ~ SeedSizeKES d
  , UnsoundPureKESAlgorithm d
  , SodiumHashAlgorithm h
  , KnownNat (SizeVerKeyKES (SumKES h d))
  , KnownNat (SizeSignKeyKES (SumKES h d))
  , KnownNat (SizeSigKES (SumKES h d))
  ) =>
  ToCBOR (UnsoundPureSignKeyKES (SumKES h d))
  where
  toCBOR :: UnsoundPureSignKeyKES (SumKES h d) -> Encoding
toCBOR = forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> Encoding
encodeUnsoundPureSignKeyKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (UnsoundPureSignKeyKES (SumKES h d)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size Proxy (UnsoundPureSignKeyKES (SumKES h d))
_skProxy = forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr (forall {k} (t :: k). Proxy t
Proxy :: Proxy (SignKeyKES (SumKES h d)))

instance
  ( SizeHash h ~ SeedSizeKES d
  , UnsoundPureKESAlgorithm d
  , SodiumHashAlgorithm h
  , KnownNat (SizeVerKeyKES (SumKES h d))
  , KnownNat (SizeSignKeyKES (SumKES h d))
  , KnownNat (SizeSigKES (SumKES h d))
  ) =>
  FromCBOR (UnsoundPureSignKeyKES (SumKES h d))
  where
  fromCBOR :: forall s. Decoder s (UnsoundPureSignKeyKES (SumKES h d))
fromCBOR = forall v s.
UnsoundPureKESAlgorithm v =>
Decoder s (UnsoundPureSignKeyKES v)
decodeUnsoundPureSignKeyKES

instance
  (NoThunks (UnsoundPureSignKeyKES d), KESAlgorithm d) =>
  NoThunks (UnsoundPureSignKeyKES (SumKES h d))

--
-- Direct ser/deser
--

instance
  ( DirectSerialise (SignKeyKES d)
  , DirectSerialise (VerKeyKES d)
  , KESAlgorithm d
  ) =>
  DirectSerialise (SignKeyKES (SumKES h d))
  where
  directSerialise :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> SignKeyKES (SumKES h d) -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push (SignKeySumKES SignKeyKES d
sk MLockedSeed (SeedSizeKES d)
r VerKeyKES d
vk0 VerKeyKES d
vk1) = do
    forall a (m :: Type -> Type).
(DirectSerialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> a -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push SignKeyKES d
sk
    forall (m :: Type -> Type) (n :: Nat) b.
MonadST m =>
MLockedSeed n -> (Ptr Word8 -> m b) -> m b
mlockedSeedUseAsCPtr MLockedSeed (SeedSizeKES d)
r forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
      Ptr CChar -> CSize -> m ()
push (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
seedSizeKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d))
    forall a (m :: Type -> Type).
(DirectSerialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> a -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push VerKeyKES d
vk0
    forall a (m :: Type -> Type).
(DirectSerialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> a -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push VerKeyKES d
vk1

instance
  ( DirectDeserialise (SignKeyKES d)
  , DirectDeserialise (VerKeyKES d)
  , KESAlgorithm d
  ) =>
  DirectDeserialise (SignKeyKES (SumKES h d))
  where
  directDeserialise :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m (SignKeyKES (SumKES h d))
directDeserialise Ptr CChar -> CSize -> m ()
pull = do
    SignKeyKES d
sk <- forall a (m :: Type -> Type).
(DirectDeserialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m a
directDeserialise Ptr CChar -> CSize -> m ()
pull

    MLockedSeed (SeedSizeKES d)
r <- forall (n :: Nat) (m :: Type -> Type).
(KnownNat n, MonadST m) =>
m (MLockedSeed n)
mlockedSeedNew
    forall (m :: Type -> Type) (n :: Nat) b.
MonadST m =>
MLockedSeed n -> (Ptr Word8 -> m b) -> m b
mlockedSeedUseAsCPtr MLockedSeed (SeedSizeKES d)
r forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
      Ptr CChar -> CSize -> m ()
pull (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
seedSizeKES (forall {k} (t :: k). Proxy t
Proxy :: Proxy d))

    VerKeyKES d
vk0 <- forall a (m :: Type -> Type).
(DirectDeserialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m a
directDeserialise Ptr CChar -> CSize -> m ()
pull
    VerKeyKES d
vk1 <- forall a (m :: Type -> Type).
(DirectDeserialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m a
directDeserialise Ptr CChar -> CSize -> m ()
pull

    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES SignKeyKES d
sk MLockedSeed (SeedSizeKES d)
r VerKeyKES d
vk0 VerKeyKES d
vk1

instance DirectSerialise (VerKeyKES (SumKES h d)) where
  directSerialise :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> VerKeyKES (SumKES h d) -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push (VerKeySumKES Hash h (VerKeyKES d, VerKeyKES d)
h) =
    forall (m :: Type -> Type) a.
(MonadThrow m, MonadST m) =>
ByteString -> (CStringLen -> m a) -> m a
unpackByteStringCStringLen (forall h a. Hash h a -> ByteString
hashToBytes Hash h (VerKeyKES d, VerKeyKES d)
h) forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len) ->
      Ptr CChar -> CSize -> m ()
push (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

instance
  HashAlgorithm h =>
  DirectDeserialise (VerKeyKES (SumKES h d))
  where
  directDeserialise :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m (VerKeyKES (SumKES h d))
directDeserialise Ptr CChar -> CSize -> m ()
pull = do
    let len :: Num a => a
        len :: forall a. Num a => a
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall h (proxy :: Type -> Type).
HashAlgorithm h =>
proxy h -> Period
sizeHash (forall {k} (t :: k). Proxy t
Proxy @h)
    ForeignPtr m Word8
fptr <- forall (m :: Type -> Type) a.
MonadST m =>
Int -> m (ForeignPtr m a)
mallocForeignPtrBytes forall a. Num a => a
len
    forall (m :: Type -> Type) a b.
MonadST m =>
ForeignPtr m a -> (Ptr a -> m b) -> m b
withForeignPtr ForeignPtr m Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
      Ptr CChar -> CSize -> m ()
pull (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) forall a. Num a => a
len
    let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (forall (m :: Type -> Type) a. ForeignPtr m a -> ForeignPtr a
unsafeRawForeignPtr ForeignPtr m Word8
fptr) Int
0 forall a. Num a => a
len
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error String
"Invalid hash") forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall h d.
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d)
VerKeySumKES forall (m :: Type -> Type) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs