{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# 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.CompactSingle" for the base case.
--
-- Compared to the implementation in 'Cardano.Crypto.KES.Sum', this flavor
-- stores only one VerKey in the branch node.
--
-- Consider the following Merkle tree:
--
-- @
--       (A)
--      /   \
--   (B)     (C)
--   / \     / \
-- (D) (E) (F) (G)
--      ^
--  0   1   2   3
-- @
--
-- The caret points at leaf node E, indicating that the current period is 1.
-- The signatures for leaf nodes D through G all contain their respective
-- DSIGN keys; the signature for branch node B however only holds the signature
-- for node E, and the VerKey for node D. It can reconstruct its own VerKey
-- from these two. The signature for branch node A (the root node), then, only
-- contains the VerKey for node C, and the signature for node B. In other
-- words, the number of individual hashes to be stored equals the depth of the
-- Merkle tree. Compare that to the older, naive 'SumKES', where each branch
-- node stores two VerKeys: here, the number of keys to store is the depth of
-- the tree times two.
--
-- Note that when we verify such a signature, we need to also compare the
-- ultimate VerKey at the root against the one passed in externally, because
-- all VerKeys until that point have been derived from the (user-supplied, so
-- untrusted) signature. But we only need to do this once, at the tree root,
-- so we split up the verification into two parts: verifying a signature
-- against its embedded VerKey, and comparing that VerKey against the
-- externally supplied target key.
--
-- 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.CompactSum (
  CompactSumKES,
  VerKeyKES (..),
  SignKeyKES (..),
  SigKES (..),

  -- * Type aliases for powers of binary sums
  CompactSum0KES,
  CompactSum1KES,
  CompactSum2KES,
  CompactSum3KES,
  CompactSum4KES,
  CompactSum5KES,
  CompactSum6KES,
  CompactSum7KES,
) 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.CompactSingle (CompactSingleKES)
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 (lift)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Foreign.Ptr (castPtr)
import GHC.TypeLits (KnownNat, type (*), type (+))

-- | A 2^0 period KES
type CompactSum0KES d = CompactSingleKES d

-- | A 2^1 period KES
type CompactSum1KES d h = CompactSumKES h (CompactSum0KES d)

-- | A 2^2 period KES
type CompactSum2KES d h = CompactSumKES h (CompactSum1KES d h)

-- | A 2^3 period KES
type CompactSum3KES d h = CompactSumKES h (CompactSum2KES d h)

-- | A 2^4 period KES
type CompactSum4KES d h = CompactSumKES h (CompactSum3KES d h)

-- | A 2^5 period KES
type CompactSum5KES d h = CompactSumKES h (CompactSum4KES d h)

-- | A 2^6 period KES
type CompactSum6KES d h = CompactSumKES h (CompactSum5KES d h)

-- | A 2^7 period KES
type CompactSum7KES d h = CompactSumKES h (CompactSum6KES 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 CompactSumKES h d

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

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

instance
  ( OptimizedKESAlgorithm d
  , SodiumHashAlgorithm h -- needed for secure forgetting
  , SizeHash h ~ SeedSizeKES d -- can be relaxed
  , NoThunks (VerKeyKES (CompactSumKES h d))
  , KnownNat (SizeVerKeyKES (CompactSumKES h d))
  , KnownNat (SizeSignKeyKES (CompactSumKES h d))
  , KnownNat (SizeSigKES (CompactSumKES h d))
  ) =>
  KESAlgorithm (CompactSumKES h d)
  where
  type SeedSizeKES (CompactSumKES 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 (CompactSumKES h d)
    = VerKeyCompactSumKES (Hash h (VerKeyKES d, VerKeyKES d))
    deriving ((forall x.
 VerKeyKES (CompactSumKES h d)
 -> Rep (VerKeyKES (CompactSumKES h d)) x)
-> (forall x.
    Rep (VerKeyKES (CompactSumKES h d)) x
    -> VerKeyKES (CompactSumKES h d))
-> Generic (VerKeyKES (CompactSumKES h d))
forall x.
Rep (VerKeyKES (CompactSumKES h d)) x
-> VerKeyKES (CompactSumKES h d)
forall x.
VerKeyKES (CompactSumKES h d)
-> Rep (VerKeyKES (CompactSumKES h d)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall h d x.
Rep (VerKeyKES (CompactSumKES h d)) x
-> VerKeyKES (CompactSumKES h d)
forall h d x.
VerKeyKES (CompactSumKES h d)
-> Rep (VerKeyKES (CompactSumKES h d)) x
$cfrom :: forall h d x.
VerKeyKES (CompactSumKES h d)
-> Rep (VerKeyKES (CompactSumKES h d)) x
from :: forall x.
VerKeyKES (CompactSumKES h d)
-> Rep (VerKeyKES (CompactSumKES h d)) x
$cto :: forall h d x.
Rep (VerKeyKES (CompactSumKES h d)) x
-> VerKeyKES (CompactSumKES h d)
to :: forall x.
Rep (VerKeyKES (CompactSumKES h d)) x
-> VerKeyKES (CompactSumKES h d)
Generic)
    deriving newtype (VerKeyKES (CompactSumKES h d) -> ()
(VerKeyKES (CompactSumKES h d) -> ())
-> NFData (VerKeyKES (CompactSumKES h d))
forall a. (a -> ()) -> NFData a
forall h d. VerKeyKES (CompactSumKES h d) -> ()
$crnf :: forall h d. VerKeyKES (CompactSumKES h d) -> ()
rnf :: VerKeyKES (CompactSumKES h d) -> ()
NFData)

  -- \| Figure 3 gives: @(sigma, vk_0, vk_1)@ - however, we store only the
  -- \"off-side\" VK in the branch, and calculate the \"on-side\" one from
  -- the leaf VK (stored in the leaf node, see 'CompactSingleKES') and the
  -- \"off-side\" VK's along the Merkle path.
  data SigKES (CompactSumKES h d)
    = SigCompactSumKES
        !(SigKES d) -- includes VerKeys for the Merkle subpath
        !(VerKeyKES d)
    deriving ((forall x.
 SigKES (CompactSumKES h d) -> Rep (SigKES (CompactSumKES h d)) x)
-> (forall x.
    Rep (SigKES (CompactSumKES h d)) x -> SigKES (CompactSumKES h d))
-> Generic (SigKES (CompactSumKES h d))
forall x.
Rep (SigKES (CompactSumKES h d)) x -> SigKES (CompactSumKES h d)
forall x.
SigKES (CompactSumKES h d) -> Rep (SigKES (CompactSumKES h d)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall h d x.
Rep (SigKES (CompactSumKES h d)) x -> SigKES (CompactSumKES h d)
forall h d x.
SigKES (CompactSumKES h d) -> Rep (SigKES (CompactSumKES h d)) x
$cfrom :: forall h d x.
SigKES (CompactSumKES h d) -> Rep (SigKES (CompactSumKES h d)) x
from :: forall x.
SigKES (CompactSumKES h d) -> Rep (SigKES (CompactSumKES h d)) x
$cto :: forall h d x.
Rep (SigKES (CompactSumKES h d)) x -> SigKES (CompactSumKES h d)
to :: forall x.
Rep (SigKES (CompactSumKES h d)) x -> SigKES (CompactSumKES h d)
Generic)

  -- \| From Figure 3: @(sk_0, r_1, vk_0, vk_1)@
  data SignKeyKES (CompactSumKES h d)
    = SignKeyCompactSumKES
        !(SignKeyKES d)
        !(MLockedSeed (SeedSizeKES d))
        !(VerKeyKES d)
        !(VerKeyKES d)

  --
  -- Metadata and basic key operations
  --

  algorithmNameKES :: forall (proxy :: Type -> Type). proxy (CompactSumKES h d) -> String
algorithmNameKES proxy (CompactSumKES h d)
_ = String -> String
mungeName (Proxy d -> String
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> String
forall (proxy :: Type -> Type). proxy d -> String
algorithmNameKES (Proxy d
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 (CompactSumKES h d)
-> Hash h (VerKeyKES (CompactSumKES h d))
hashVerKeyKES (VerKeyCompactSumKES Hash h (VerKeyKES d, VerKeyKES d)
vk) = Hash h (Hash h (VerKeyKES d, VerKeyKES d))
-> Hash h (VerKeyKES (CompactSumKES h d))
forall h a b. Hash h a -> Hash h b
castHash ((Hash h (VerKeyKES d, VerKeyKES d) -> ByteString)
-> Hash h (VerKeyKES d, VerKeyKES d)
-> Hash h (Hash h (VerKeyKES d, VerKeyKES d))
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith Hash h (VerKeyKES d, VerKeyKES d) -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash h (VerKeyKES d, VerKeyKES d)
vk)

  --
  -- Core algorithm operations
  --

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

  verifyKES :: forall a.
(Signable (CompactSumKES h d) a, HasCallStack) =>
ContextKES (CompactSumKES h d)
-> VerKeyKES (CompactSumKES h d)
-> Period
-> a
-> SigKES (CompactSumKES h d)
-> Either String ()
verifyKES = ContextKES (CompactSumKES h d)
-> VerKeyKES (CompactSumKES h d)
-> Period
-> a
-> SigKES (CompactSumKES h d)
-> Either String ()
forall v a.
(OptimizedKESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v
-> VerKeyKES v -> Period -> a -> SigKES v -> Either String ()
verifyOptimizedKES

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

  --
  -- raw serialise/deserialise
  --

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

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

  rawSerialiseSigKES :: SigKES (CompactSumKES h d) -> ByteString
rawSerialiseSigKES (SigCompactSumKES SigKES d
sigma VerKeyKES d
vk_other) =
    [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
      [ SigKES d -> ByteString
forall v. KESAlgorithm v => SigKES v -> ByteString
rawSerialiseSigKES SigKES d
sigma
      , VerKeyKES d -> ByteString
forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES d
vk_other
      ]

  rawDeserialiseVerKeyKES :: ByteString -> Maybe (VerKeyKES (CompactSumKES h d))
rawDeserialiseVerKeyKES = (Hash h (VerKeyKES d, VerKeyKES d)
 -> VerKeyKES (CompactSumKES h d))
-> Maybe (Hash h (VerKeyKES d, VerKeyKES d))
-> Maybe (VerKeyKES (CompactSumKES h d))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (CompactSumKES h d)
forall h d.
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (CompactSumKES h d)
VerKeyCompactSumKES (Maybe (Hash h (VerKeyKES d, VerKeyKES d))
 -> Maybe (VerKeyKES (CompactSumKES h d)))
-> (ByteString -> Maybe (Hash h (VerKeyKES d, VerKeyKES d)))
-> ByteString
-> Maybe (VerKeyKES (CompactSumKES h d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Hash h (VerKeyKES d, VerKeyKES d))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes

  rawDeserialiseSigKES :: ByteString -> Maybe (SigKES (CompactSumKES h d))
rawDeserialiseSigKES ByteString
b = do
    Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
size_total)
    SigKES d
sigma <- ByteString -> Maybe (SigKES d)
forall v. KESAlgorithm v => ByteString -> Maybe (SigKES v)
rawDeserialiseSigKES ByteString
b_sig
    VerKeyKES d
vk <- ByteString -> Maybe (VerKeyKES d)
forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
b_vk
    SigKES (CompactSumKES h d) -> Maybe (SigKES (CompactSumKES h d))
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SigKES d -> VerKeyKES d -> SigKES (CompactSumKES h d)
forall h d. SigKES d -> VerKeyKES d -> SigKES (CompactSumKES h d)
SigCompactSumKES SigKES d
sigma VerKeyKES d
vk)
    where
      b_sig :: ByteString
b_sig = Period -> Period -> ByteString -> ByteString
slice Period
off_sig Period
size_sig ByteString
b
      b_vk :: ByteString
b_vk = Period -> Period -> ByteString -> ByteString
slice Period
off_vk Period
size_vk ByteString
b

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

      off_sig :: Period
off_sig = Period
0 :: Word
      off_vk :: Period
off_vk = Period
size_sig

  deriveVerKeyKES :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
SignKeyKES (CompactSumKES h d) -> m (VerKeyKES (CompactSumKES h d))
deriveVerKeyKES (SignKeyCompactSumKES SignKeyKES d
_ MLockedSeed (SeedSizeKES d)
_ VerKeyKES d
vk_0 VerKeyKES d
vk_1) =
    VerKeyKES (CompactSumKES h d) -> m (VerKeyKES (CompactSumKES h d))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (VerKeyKES (CompactSumKES h d)
 -> m (VerKeyKES (CompactSumKES h d)))
-> VerKeyKES (CompactSumKES h d)
-> m (VerKeyKES (CompactSumKES h d))
forall a b. (a -> b) -> a -> b
$! Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (CompactSumKES h d)
forall h d.
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (CompactSumKES h d)
VerKeyCompactSumKES ((VerKeyKES d, VerKeyKES d) -> Hash h (VerKeyKES d, VerKeyKES d)
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))

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

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

  {-# NOINLINE updateKESWith #-}
  updateKESWith :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ContextKES (CompactSumKES h d)
-> SignKeyKES (CompactSumKES h d)
-> Period
-> m (Maybe (SignKeyKES (CompactSumKES h d)))
updateKESWith MLockedAllocator m
allocator ContextKES (CompactSumKES h d)
ctx (SignKeyCompactSumKES SignKeyKES d
sk MLockedSeed (SeedSizeKES d)
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1) Period
t
    | Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Period
1 Period -> Period -> Bool
forall a. Ord a => a -> a -> Bool
< Period
_T =
        MaybeT m (SignKeyKES (CompactSumKES h d))
-> m (Maybe (SignKeyKES (CompactSumKES h d)))
forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m (SignKeyKES (CompactSumKES h d))
 -> m (Maybe (SignKeyKES (CompactSumKES h d))))
-> MaybeT m (SignKeyKES (CompactSumKES h d))
-> m (Maybe (SignKeyKES (CompactSumKES h d)))
forall a b. (a -> b) -> a -> b
$!
          do
            SignKeyKES d
sk' <- m (Maybe (SignKeyKES d)) -> MaybeT m (SignKeyKES d)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (SignKeyKES d)) -> MaybeT m (SignKeyKES d))
-> m (Maybe (SignKeyKES d)) -> MaybeT m (SignKeyKES d)
forall a b. (a -> b) -> a -> b
$! MLockedAllocator m
-> ContextKES d
-> SignKeyKES d
-> Period
-> m (Maybe (SignKeyKES d))
forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ContextKES v
-> SignKeyKES v
-> Period
-> m (Maybe (SignKeyKES v))
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ContextKES d
-> SignKeyKES d
-> Period
-> m (Maybe (SignKeyKES d))
updateKESWith MLockedAllocator m
allocator ContextKES d
ContextKES (CompactSumKES h d)
ctx SignKeyKES d
sk Period
t
            MLockedSeed (SeedSizeKES d)
r_1' <- m (MLockedSeed (SeedSizeKES d))
-> MaybeT m (MLockedSeed (SeedSizeKES d))
forall (m :: Type -> Type) a. Monad m => m a -> MaybeT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (MLockedSeed (SeedSizeKES d))
 -> MaybeT m (MLockedSeed (SeedSizeKES d)))
-> m (MLockedSeed (SeedSizeKES d))
-> MaybeT m (MLockedSeed (SeedSizeKES d))
forall a b. (a -> b) -> a -> b
$! MLockedAllocator m
-> MLockedSeed (SeedSizeKES d) -> m (MLockedSeed (SeedSizeKES d))
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
            SignKeyKES (CompactSumKES h d)
-> MaybeT m (SignKeyKES (CompactSumKES h d))
forall a. a -> MaybeT m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SignKeyKES (CompactSumKES h d)
 -> MaybeT m (SignKeyKES (CompactSumKES h d)))
-> SignKeyKES (CompactSumKES h d)
-> MaybeT m (SignKeyKES (CompactSumKES h d))
forall a b. (a -> b) -> a -> b
$! SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (CompactSumKES h d)
forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (CompactSumKES h d)
SignKeyCompactSumKES SignKeyKES d
sk' MLockedSeed (SeedSizeKES d)
r_1' VerKeyKES d
vk_0 VerKeyKES d
vk_1
    | Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Period
1 Period -> Period -> Bool
forall a. Eq a => a -> a -> Bool
== Period
_T = do
        SignKeyKES d
sk' <- MLockedAllocator m
-> MLockedSeed (SeedSizeKES d) -> m (SignKeyKES d)
forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES v) -> m (SignKeyKES v)
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES d) -> m (SignKeyKES d)
genKeyKESWith MLockedAllocator m
allocator MLockedSeed (SeedSizeKES d)
r_1
        MLockedSeed (SeedSizeKES d)
zero <- MLockedAllocator m -> m (MLockedSeed (SeedSizeKES d))
forall (n :: Nat) (m :: Type -> Type).
(KnownNat n, MonadST m) =>
MLockedAllocator m -> m (MLockedSeed n)
mlockedSeedNewZeroWith MLockedAllocator m
allocator
        Maybe (SignKeyKES (CompactSumKES h d))
-> m (Maybe (SignKeyKES (CompactSumKES h d)))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (SignKeyKES (CompactSumKES h d))
 -> m (Maybe (SignKeyKES (CompactSumKES h d))))
-> Maybe (SignKeyKES (CompactSumKES h d))
-> m (Maybe (SignKeyKES (CompactSumKES h d)))
forall a b. (a -> b) -> a -> b
$! SignKeyKES (CompactSumKES h d)
-> Maybe (SignKeyKES (CompactSumKES h d))
forall a. a -> Maybe a
Just (SignKeyKES (CompactSumKES h d)
 -> Maybe (SignKeyKES (CompactSumKES h d)))
-> SignKeyKES (CompactSumKES h d)
-> Maybe (SignKeyKES (CompactSumKES h d))
forall a b. (a -> b) -> a -> b
$! SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (CompactSumKES h d)
forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (CompactSumKES h d)
SignKeyCompactSumKES SignKeyKES d
sk' MLockedSeed (SeedSizeKES d)
zero VerKeyKES d
vk_0 VerKeyKES d
vk_1
    | Bool
otherwise =
        MaybeT m (SignKeyKES (CompactSumKES h d))
-> m (Maybe (SignKeyKES (CompactSumKES h d)))
forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m (SignKeyKES (CompactSumKES h d))
 -> m (Maybe (SignKeyKES (CompactSumKES h d))))
-> MaybeT m (SignKeyKES (CompactSumKES h d))
-> m (Maybe (SignKeyKES (CompactSumKES h d)))
forall a b. (a -> b) -> a -> b
$!
          do
            SignKeyKES d
sk' <- m (Maybe (SignKeyKES d)) -> MaybeT m (SignKeyKES d)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (SignKeyKES d)) -> MaybeT m (SignKeyKES d))
-> m (Maybe (SignKeyKES d)) -> MaybeT m (SignKeyKES d)
forall a b. (a -> b) -> a -> b
$! MLockedAllocator m
-> ContextKES d
-> SignKeyKES d
-> Period
-> m (Maybe (SignKeyKES d))
forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ContextKES v
-> SignKeyKES v
-> Period
-> m (Maybe (SignKeyKES v))
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ContextKES d
-> SignKeyKES d
-> Period
-> m (Maybe (SignKeyKES d))
updateKESWith MLockedAllocator m
allocator ContextKES d
ContextKES (CompactSumKES h d)
ctx SignKeyKES d
sk (Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
- Period
_T)
            MLockedSeed (SeedSizeKES d)
r_1' <- m (MLockedSeed (SeedSizeKES d))
-> MaybeT m (MLockedSeed (SeedSizeKES d))
forall (m :: Type -> Type) a. Monad m => m a -> MaybeT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (MLockedSeed (SeedSizeKES d))
 -> MaybeT m (MLockedSeed (SeedSizeKES d)))
-> m (MLockedSeed (SeedSizeKES d))
-> MaybeT m (MLockedSeed (SeedSizeKES d))
forall a b. (a -> b) -> a -> b
$! MLockedAllocator m
-> MLockedSeed (SeedSizeKES d) -> m (MLockedSeed (SeedSizeKES d))
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
            SignKeyKES (CompactSumKES h d)
-> MaybeT m (SignKeyKES (CompactSumKES h d))
forall a. a -> MaybeT m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SignKeyKES (CompactSumKES h d)
 -> MaybeT m (SignKeyKES (CompactSumKES h d)))
-> SignKeyKES (CompactSumKES h d)
-> MaybeT m (SignKeyKES (CompactSumKES h d))
forall a b. (a -> b) -> a -> b
$! SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (CompactSumKES h d)
forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (CompactSumKES h d)
SignKeyCompactSumKES SignKeyKES d
sk' MLockedSeed (SeedSizeKES d)
r_1' VerKeyKES d
vk_0 VerKeyKES d
vk_1
    where
      _T :: Period
_T = Proxy d -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
forall (proxy :: Type -> Type). proxy d -> Period
totalPeriodsKES (Proxy d
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 (CompactSumKES h d))
-> m (SignKeyKES (CompactSumKES h d))
genKeyKESWith MLockedAllocator m
allocator MLockedSeed (SeedSizeKES (CompactSumKES h d))
r = do
    (MLockedSizedBytes (SeedSizeKES d)
r0raw, MLockedSizedBytes (SeedSizeKES d)
r1raw) <- MLockedAllocator m
-> Proxy h
-> MLockedSizedBytes (SizeHash h)
-> m (MLockedSizedBytes (SizeHash h),
      MLockedSizedBytes (SizeHash h))
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 (Proxy h
forall {k} (t :: k). Proxy t
Proxy :: Proxy h) (MLockedSeed (SeedSizeKES d) -> MLockedSizedBytes (SeedSizeKES d)
forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB MLockedSeed (SeedSizeKES d)
MLockedSeed (SeedSizeKES (CompactSumKES h d))
r)
    let r0 :: MLockedSeed (SeedSizeKES d)
r0 = MLockedSizedBytes (SeedSizeKES d) -> MLockedSeed (SeedSizeKES d)
forall (n :: Nat). MLockedSizedBytes n -> MLockedSeed n
MLockedSeed MLockedSizedBytes (SeedSizeKES d)
r0raw
        r1 :: MLockedSeed (SeedSizeKES d)
r1 = MLockedSizedBytes (SeedSizeKES d) -> MLockedSeed (SeedSizeKES d)
forall (n :: Nat). MLockedSizedBytes n -> MLockedSeed n
MLockedSeed MLockedSizedBytes (SeedSizeKES d)
r1raw
    SignKeyKES d
sk_0 <- MLockedAllocator m
-> MLockedSeed (SeedSizeKES d) -> m (SignKeyKES d)
forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES v) -> m (SignKeyKES v)
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES d) -> m (SignKeyKES d)
genKeyKESWith MLockedAllocator m
allocator MLockedSeed (SeedSizeKES d)
r0
    VerKeyKES d
vk_0 <- SignKeyKES d -> m (VerKeyKES d)
forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyKES v -> m (VerKeyKES v)
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
SignKeyKES d -> m (VerKeyKES d)
deriveVerKeyKES SignKeyKES d
sk_0
    SignKeyKES d
sk_1 <- MLockedAllocator m
-> MLockedSeed (SeedSizeKES d) -> m (SignKeyKES d)
forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES v) -> m (SignKeyKES v)
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES d) -> m (SignKeyKES d)
genKeyKESWith MLockedAllocator m
allocator MLockedSeed (SeedSizeKES d)
r1
    VerKeyKES d
vk_1 <- SignKeyKES d -> m (VerKeyKES d)
forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyKES v -> m (VerKeyKES v)
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
SignKeyKES d -> m (VerKeyKES d)
deriveVerKeyKES SignKeyKES d
sk_1
    SignKeyKES d -> m ()
forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyKES v -> m ()
forgetSignKeyKES SignKeyKES d
sk_1
    MLockedSeed (SeedSizeKES d) -> m ()
forall (m :: Type -> Type) (n :: Nat).
MonadST m =>
MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed (SeedSizeKES d)
r0
    SignKeyKES (CompactSumKES h d)
-> m (SignKeyKES (CompactSumKES h d))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SignKeyKES (CompactSumKES h d)
 -> m (SignKeyKES (CompactSumKES h d)))
-> SignKeyKES (CompactSumKES h d)
-> m (SignKeyKES (CompactSumKES h d))
forall a b. (a -> b) -> a -> b
$! SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (CompactSumKES h d)
forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (CompactSumKES h d)
SignKeyCompactSumKES 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 (CompactSumKES h d) -> m ()
forgetSignKeyKESWith MLockedAllocator m
allocator (SignKeyCompactSumKES SignKeyKES d
sk_0 MLockedSeed (SeedSizeKES d)
r1 VerKeyKES d
_ VerKeyKES d
_) = do
    MLockedAllocator m -> SignKeyKES d -> m ()
forall v (m :: Type -> Type).
(KESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyKES v -> m ()
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyKES d -> m ()
forgetSignKeyKESWith MLockedAllocator m
allocator SignKeyKES d
sk_0
    MLockedSeed (SeedSizeKES d) -> m ()
forall (m :: Type -> Type) (n :: Nat).
MonadST m =>
MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed (SeedSizeKES d)
r1

instance
  ( KESAlgorithm (CompactSumKES h d)
  , UnsoundKESAlgorithm d
  ) =>
  UnsoundKESAlgorithm (CompactSumKES 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 (CompactSumKES h d) -> m ByteString
rawSerialiseSignKeyKES (SignKeyCompactSumKES SignKeyKES d
sk MLockedSeed (SeedSizeKES d)
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1) = do
    ByteString
ssk <- SignKeyKES d -> m ByteString
forall v (m :: Type -> Type).
(UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyKES v -> m ByteString
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
SignKeyKES d -> m ByteString
rawSerialiseSignKeyKES SignKeyKES d
sk
    ByteString
sr1 <- MLockedSizedBytes (SeedSizeKES d) -> m ByteString
forall (n :: Nat) (m :: Type -> Type).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString (MLockedSizedBytes (SeedSizeKES d) -> m ByteString)
-> (MLockedSeed (SeedSizeKES d)
    -> MLockedSizedBytes (SeedSizeKES d))
-> MLockedSeed (SeedSizeKES d)
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MLockedSeed (SeedSizeKES d) -> MLockedSizedBytes (SeedSizeKES d)
forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB (MLockedSeed (SeedSizeKES d) -> m ByteString)
-> MLockedSeed (SeedSizeKES d) -> m ByteString
forall a b. (a -> b) -> a -> b
$ MLockedSeed (SeedSizeKES d)
r_1
    ByteString -> m ByteString
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$
      [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
        [ ByteString
ssk
        , ByteString
sr1
        , VerKeyKES d -> ByteString
forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES d
vk_0
        , VerKeyKES d -> ByteString
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 (CompactSumKES h d)))
rawDeserialiseSignKeyKESWith MLockedAllocator m
allocator ByteString
b = MaybeT m (SignKeyKES (CompactSumKES h d))
-> m (Maybe (SignKeyKES (CompactSumKES h d)))
forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m (SignKeyKES (CompactSumKES h d))
 -> m (Maybe (SignKeyKES (CompactSumKES h d))))
-> MaybeT m (SignKeyKES (CompactSumKES h d))
-> m (Maybe (SignKeyKES (CompactSumKES h d)))
forall a b. (a -> b) -> a -> b
$ do
    Bool -> MaybeT m ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
size_total)
    SignKeyKES d
sk <- m (Maybe (SignKeyKES d)) -> MaybeT m (SignKeyKES d)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (SignKeyKES d)) -> MaybeT m (SignKeyKES d))
-> m (Maybe (SignKeyKES d)) -> MaybeT m (SignKeyKES d)
forall a b. (a -> b) -> a -> b
$ MLockedAllocator m -> ByteString -> m (Maybe (SignKeyKES d))
forall v (m :: Type -> Type).
(UnsoundKESAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m -> ByteString -> m (Maybe (SignKeyKES v))
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m -> ByteString -> m (Maybe (SignKeyKES d))
rawDeserialiseSignKeyKESWith MLockedAllocator m
allocator ByteString
b_sk
    MLockedSizedBytes (SeedSizeKES d)
r <- m (Maybe (MLockedSizedBytes (SeedSizeKES d)))
-> MaybeT m (MLockedSizedBytes (SeedSizeKES d))
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (MLockedSizedBytes (SeedSizeKES d)))
 -> MaybeT m (MLockedSizedBytes (SeedSizeKES d)))
-> m (Maybe (MLockedSizedBytes (SeedSizeKES d)))
-> MaybeT m (MLockedSizedBytes (SeedSizeKES d))
forall a b. (a -> b) -> a -> b
$ MLockedAllocator m
-> ByteString -> m (Maybe (MLockedSizedBytes (SeedSizeKES d)))
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 <- m (Maybe (VerKeyKES d)) -> MaybeT m (VerKeyKES d)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (VerKeyKES d)) -> MaybeT m (VerKeyKES d))
-> (Maybe (VerKeyKES d) -> m (Maybe (VerKeyKES d)))
-> Maybe (VerKeyKES d)
-> MaybeT m (VerKeyKES d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (VerKeyKES d) -> m (Maybe (VerKeyKES d))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (VerKeyKES d) -> MaybeT m (VerKeyKES d))
-> Maybe (VerKeyKES d) -> MaybeT m (VerKeyKES d)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (VerKeyKES d)
forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
b_vk0
    VerKeyKES d
vk_1 <- m (Maybe (VerKeyKES d)) -> MaybeT m (VerKeyKES d)
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (VerKeyKES d)) -> MaybeT m (VerKeyKES d))
-> (Maybe (VerKeyKES d) -> m (Maybe (VerKeyKES d)))
-> Maybe (VerKeyKES d)
-> MaybeT m (VerKeyKES d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (VerKeyKES d) -> m (Maybe (VerKeyKES d))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (VerKeyKES d) -> MaybeT m (VerKeyKES d))
-> Maybe (VerKeyKES d) -> MaybeT m (VerKeyKES d)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (VerKeyKES d)
forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
b_vk1
    SignKeyKES (CompactSumKES h d)
-> MaybeT m (SignKeyKES (CompactSumKES h d))
forall a. a -> MaybeT m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (CompactSumKES h d)
forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (CompactSumKES h d)
SignKeyCompactSumKES SignKeyKES d
sk (MLockedSizedBytes (SeedSizeKES d) -> MLockedSeed (SeedSizeKES d)
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 = Proxy d -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSignKeyKES (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_r :: Period
size_r = Proxy d -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
seedSizeKES (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_vk :: Period
size_vk = Proxy d -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeVerKeyKES (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_total :: Period
size_total = Proxy (CompactSumKES h d) -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSignKeyKES (Proxy (CompactSumKES h d)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (CompactSumKES 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 Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Period
size_r
      off_vk1 :: Period
off_vk1 = Period
off_vk0 Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Period
size_vk

instance
  (KESAlgorithm (CompactSumKES h d), OptimizedKESAlgorithm d, HashAlgorithm h) =>
  OptimizedKESAlgorithm (CompactSumKES h d)
  where
  verifySigKES :: forall a.
(Signable (CompactSumKES h d) a, HasCallStack) =>
ContextKES (CompactSumKES h d)
-> Period -> a -> SigKES (CompactSumKES h d) -> Either String ()
verifySigKES ContextKES (CompactSumKES h d)
ctxt Period
t a
a (SigCompactSumKES SigKES d
sigma VerKeyKES d
_) =
    ContextKES d -> Period -> a -> SigKES d -> Either String ()
forall v a.
(OptimizedKESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v -> Period -> a -> SigKES v -> Either String ()
forall a.
(Signable d a, HasCallStack) =>
ContextKES d -> Period -> a -> SigKES d -> Either String ()
verifySigKES ContextKES d
ContextKES (CompactSumKES h d)
ctxt Period
t' a
a SigKES d
sigma
    where
      _T :: Period
_T = Proxy d -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
forall (proxy :: Type -> Type). proxy d -> Period
totalPeriodsKES (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      t' :: Period
t'
        | Period
t Period -> Period -> Bool
forall a. Ord a => a -> a -> Bool
< Period
_T = Period
t
        | Bool
otherwise = Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
- Period
_T

  verKeyFromSigKES :: ContextKES (CompactSumKES h d)
-> Period
-> SigKES (CompactSumKES h d)
-> VerKeyKES (CompactSumKES h d)
verKeyFromSigKES ContextKES (CompactSumKES h d)
ctxt Period
t (SigCompactSumKES SigKES d
sigma VerKeyKES d
vk_other) =
    Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (CompactSumKES h d)
forall h d.
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (CompactSumKES h d)
VerKeyCompactSumKES (Hash h (VerKeyKES d, VerKeyKES d)
 -> VerKeyKES (CompactSumKES h d))
-> Hash h (VerKeyKES d, VerKeyKES d)
-> VerKeyKES (CompactSumKES h d)
forall a b. (a -> b) -> a -> b
$ (VerKeyKES d, VerKeyKES d) -> Hash h (VerKeyKES d, VerKeyKES d)
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)
    where
      _T :: Period
_T = Proxy d -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
forall (proxy :: Type -> Type). proxy d -> Period
totalPeriodsKES (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      t' :: Period
t'
        | Period
t Period -> Period -> Bool
forall a. Ord a => a -> a -> Bool
< Period
_T = Period
t
        | Bool
otherwise = Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
- Period
_T
      (VerKeyKES d
vk_0, VerKeyKES d
vk_1)
        | Period
t Period -> Period -> Bool
forall a. Ord a => a -> a -> Bool
< Period
_T = (ContextKES d -> Period -> SigKES d -> VerKeyKES d
forall v.
OptimizedKESAlgorithm v =>
ContextKES v -> Period -> SigKES v -> VerKeyKES v
verKeyFromSigKES ContextKES d
ContextKES (CompactSumKES h d)
ctxt Period
t' SigKES d
sigma, VerKeyKES d
vk_other)
        | Bool
otherwise = (VerKeyKES d
vk_other, ContextKES d -> Period -> SigKES d -> VerKeyKES d
forall v.
OptimizedKESAlgorithm v =>
ContextKES v -> Period -> SigKES v -> VerKeyKES v
verKeyFromSigKES ContextKES d
ContextKES (CompactSumKES h d)
ctxt Period
t' SigKES d
sigma)

--
-- VerKey instances
--

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

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

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

instance
  ( OptimizedKESAlgorithm d
  , SodiumHashAlgorithm h
  , SizeHash h ~ SeedSizeKES d
  , NoThunks (VerKeyKES (CompactSumKES h d))
  , KnownNat (SizeVerKeyKES (CompactSumKES h d))
  , KnownNat (SizeSignKeyKES (CompactSumKES h d))
  , KnownNat (SizeSigKES (CompactSumKES h d))
  ) =>
  ToCBOR (VerKeyKES (CompactSumKES h d))
  where
  toCBOR :: VerKeyKES (CompactSumKES h d) -> Encoding
toCBOR = VerKeyKES (CompactSumKES h d) -> Encoding
forall v. KESAlgorithm v => VerKeyKES v -> Encoding
encodeVerKeyKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerKeyKES (CompactSumKES h d)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (VerKeyKES (CompactSumKES h d)) -> Size
forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size
encodedVerKeyKESSizeExpr

instance
  ( OptimizedKESAlgorithm d
  , SodiumHashAlgorithm h
  , SizeHash h ~ SeedSizeKES d
  , NoThunks (VerKeyKES (CompactSumKES h d))
  , KnownNat (SizeVerKeyKES (CompactSumKES h d))
  , KnownNat (SizeSignKeyKES (CompactSumKES h d))
  , KnownNat (SizeSigKES (CompactSumKES h d))
  ) =>
  FromCBOR (VerKeyKES (CompactSumKES h d))
  where
  fromCBOR :: forall s. Decoder s (VerKeyKES (CompactSumKES h d))
fromCBOR = Decoder s (VerKeyKES (CompactSumKES h d))
forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES

--
-- SignKey instances
--

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

--
-- Sig instances
--

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

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

instance
  ( OptimizedKESAlgorithm d
  , SodiumHashAlgorithm h
  , SizeHash h ~ SeedSizeKES d
  , NoThunks (VerKeyKES (CompactSumKES h d))
  , KnownNat (SizeVerKeyKES (CompactSumKES h d))
  , KnownNat (SizeSignKeyKES (CompactSumKES h d))
  , KnownNat (SizeSigKES (CompactSumKES h d))
  ) =>
  ToCBOR (SigKES (CompactSumKES h d))
  where
  toCBOR :: SigKES (CompactSumKES h d) -> Encoding
toCBOR = SigKES (CompactSumKES h d) -> Encoding
forall v. KESAlgorithm v => SigKES v -> Encoding
encodeSigKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigKES (CompactSumKES h d)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (SigKES (CompactSumKES h d)) -> Size
forall v. KESAlgorithm v => Proxy (SigKES v) -> Size
encodedSigKESSizeExpr

instance
  ( OptimizedKESAlgorithm d
  , SodiumHashAlgorithm h
  , SizeHash h ~ SeedSizeKES d
  , NoThunks (VerKeyKES (CompactSumKES h d))
  , KnownNat (SizeVerKeyKES (CompactSumKES h d))
  , KnownNat (SizeSignKeyKES (CompactSumKES h d))
  , KnownNat (SizeSigKES (CompactSumKES h d))
  ) =>
  FromCBOR (SigKES (CompactSumKES h d))
  where
  fromCBOR :: forall s. Decoder s (SigKES (CompactSumKES h d))
fromCBOR = Decoder s (SigKES (CompactSumKES h d))
forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES

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

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

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

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

  --
  -- Key generation
  --

  unsoundPureGenKeyKES :: Seed -> UnsoundPureSignKeyKES (CompactSumKES h d)
unsoundPureGenKeyKES Seed
r =
    let r0 :: Seed
r0 = ByteString -> Seed
mkSeedFromBytes (ByteString -> Seed) -> ByteString -> Seed
forall a b. (a -> b) -> a -> b
$ Proxy h -> ByteString -> ByteString
forall h (proxy :: Type -> Type).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
forall (proxy :: Type -> Type). proxy h -> ByteString -> ByteString
digest (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h) (Word8 -> ByteString -> ByteString
BS.cons Word8
1 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Seed -> ByteString
getSeedBytes Seed
r)
        r1 :: Seed
r1 = ByteString -> Seed
mkSeedFromBytes (ByteString -> Seed) -> ByteString -> Seed
forall a b. (a -> b) -> a -> b
$ Proxy h -> ByteString -> ByteString
forall h (proxy :: Type -> Type).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
forall (proxy :: Type -> Type). proxy h -> ByteString -> ByteString
digest (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h) (Word8 -> ByteString -> ByteString
BS.cons Word8
2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Seed -> ByteString
getSeedBytes Seed
r)
        sk_0 :: UnsoundPureSignKeyKES d
sk_0 = Seed -> UnsoundPureSignKeyKES d
forall v.
UnsoundPureKESAlgorithm v =>
Seed -> UnsoundPureSignKeyKES v
unsoundPureGenKeyKES Seed
r0
        vk_0 :: VerKeyKES d
vk_0 = UnsoundPureSignKeyKES d -> VerKeyKES d
forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> VerKeyKES v
unsoundPureDeriveVerKeyKES UnsoundPureSignKeyKES d
sk_0
        sk_1 :: UnsoundPureSignKeyKES d
sk_1 = Seed -> UnsoundPureSignKeyKES d
forall v.
UnsoundPureKESAlgorithm v =>
Seed -> UnsoundPureSignKeyKES v
unsoundPureGenKeyKES Seed
r1
        vk_1 :: VerKeyKES d
vk_1 = UnsoundPureSignKeyKES d -> VerKeyKES d
forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> VerKeyKES v
unsoundPureDeriveVerKeyKES UnsoundPureSignKeyKES d
sk_1
     in UnsoundPureSignKeyKES d
-> Seed
-> VerKeyKES d
-> VerKeyKES d
-> UnsoundPureSignKeyKES (CompactSumKES h d)
forall h d.
UnsoundPureSignKeyKES d
-> Seed
-> VerKeyKES d
-> VerKeyKES d
-> UnsoundPureSignKeyKES (CompactSumKES h d)
UnsoundPureSignKeyCompactSumKES UnsoundPureSignKeyKES d
sk_0 Seed
r1 VerKeyKES d
vk_0 VerKeyKES d
vk_1

  unsoundPureDeriveVerKeyKES :: UnsoundPureSignKeyKES (CompactSumKES h d)
-> VerKeyKES (CompactSumKES h d)
unsoundPureDeriveVerKeyKES (UnsoundPureSignKeyCompactSumKES UnsoundPureSignKeyKES d
_ Seed
_ VerKeyKES d
vk_0 VerKeyKES d
vk_1) =
    Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (CompactSumKES h d)
forall h d.
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (CompactSumKES h d)
VerKeyCompactSumKES ((VerKeyKES d, VerKeyKES d) -> Hash h (VerKeyKES d, VerKeyKES d)
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 (CompactSumKES h d)
-> m (SignKeyKES (CompactSumKES h d))
unsoundPureSignKeyKESToSoundSignKeyKES (UnsoundPureSignKeyCompactSumKES UnsoundPureSignKeyKES d
sk Seed
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1) =
    SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (CompactSumKES h d)
forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (CompactSumKES h d)
SignKeyCompactSumKES
      (SignKeyKES d
 -> MLockedSeed (SeedSizeKES d)
 -> VerKeyKES d
 -> VerKeyKES d
 -> SignKeyKES (CompactSumKES h d))
-> m (SignKeyKES d)
-> m (MLockedSeed (SeedSizeKES d)
      -> VerKeyKES d -> VerKeyKES d -> SignKeyKES (CompactSumKES h d))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> UnsoundPureSignKeyKES d -> m (SignKeyKES d)
forall v (m :: Type -> Type).
(UnsoundPureKESAlgorithm v, MonadST m, MonadThrow m) =>
UnsoundPureSignKeyKES v -> m (SignKeyKES v)
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
UnsoundPureSignKeyKES d -> m (SignKeyKES d)
unsoundPureSignKeyKESToSoundSignKeyKES UnsoundPureSignKeyKES d
sk
      m (MLockedSeed (SeedSizeKES d)
   -> VerKeyKES d -> VerKeyKES d -> SignKeyKES (CompactSumKES h d))
-> m (MLockedSeed (SeedSizeKES d))
-> m (VerKeyKES d -> VerKeyKES d -> SignKeyKES (CompactSumKES h d))
forall a b. m (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ((MLockedSizedBytes (SeedSizeKES d) -> MLockedSeed (SeedSizeKES d))
-> m (MLockedSizedBytes (SeedSizeKES d))
-> m (MLockedSeed (SeedSizeKES d))
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap MLockedSizedBytes (SeedSizeKES d) -> MLockedSeed (SeedSizeKES d)
forall (n :: Nat). MLockedSizedBytes n -> MLockedSeed n
MLockedSeed (m (MLockedSizedBytes (SeedSizeKES d))
 -> m (MLockedSeed (SeedSizeKES d)))
-> (Seed -> m (MLockedSizedBytes (SeedSizeKES d)))
-> Seed
-> m (MLockedSeed (SeedSizeKES d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> m (MLockedSizedBytes (SeedSizeKES d))
forall (n :: Nat) (m :: Type -> Type).
(KnownNat n, MonadST m) =>
ByteString -> m (MLockedSizedBytes n)
mlsbFromByteString (ByteString -> m (MLockedSizedBytes (SeedSizeKES d)))
-> (Seed -> ByteString)
-> Seed
-> m (MLockedSizedBytes (SeedSizeKES d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seed -> ByteString
getSeedBytes (Seed -> m (MLockedSeed (SeedSizeKES d)))
-> Seed -> m (MLockedSeed (SeedSizeKES d))
forall a b. (a -> b) -> a -> b
$ Seed
r_1)
      m (VerKeyKES d -> VerKeyKES d -> SignKeyKES (CompactSumKES h d))
-> m (VerKeyKES d)
-> m (VerKeyKES d -> SignKeyKES (CompactSumKES h d))
forall a b. m (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> VerKeyKES d -> m (VerKeyKES d)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure VerKeyKES d
vk_0
      m (VerKeyKES d -> SignKeyKES (CompactSumKES h d))
-> m (VerKeyKES d) -> m (SignKeyKES (CompactSumKES h d))
forall a b. m (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> VerKeyKES d -> m (VerKeyKES d)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure VerKeyKES d
vk_1

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

  rawDeserialiseUnsoundPureSignKeyKES :: ByteString -> Maybe (UnsoundPureSignKeyKES (CompactSumKES h d))
rawDeserialiseUnsoundPureSignKeyKES ByteString
b = do
    Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
size_total)
    UnsoundPureSignKeyKES d
sk <- ByteString -> Maybe (UnsoundPureSignKeyKES d)
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 <- ByteString -> Maybe (VerKeyKES d)
forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
b_vk0
    VerKeyKES d
vk_1 <- ByteString -> Maybe (VerKeyKES d)
forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
b_vk1
    UnsoundPureSignKeyKES (CompactSumKES h d)
-> Maybe (UnsoundPureSignKeyKES (CompactSumKES h d))
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (UnsoundPureSignKeyKES d
-> Seed
-> VerKeyKES d
-> VerKeyKES d
-> UnsoundPureSignKeyKES (CompactSumKES h d)
forall h d.
UnsoundPureSignKeyKES d
-> Seed
-> VerKeyKES d
-> VerKeyKES d
-> UnsoundPureSignKeyKES (CompactSumKES h d)
UnsoundPureSignKeyCompactSumKES 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 = Proxy d -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSignKeyKES (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_r :: Period
size_r = Proxy d -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
seedSizeKES (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_vk :: Period
size_vk = Proxy d -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeVerKeyKES (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_total :: Period
size_total = Proxy (CompactSumKES h d) -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSignKeyKES (Proxy (CompactSumKES h d)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (CompactSumKES 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 Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Period
size_r
      off_vk1 :: Period
off_vk1 = Period
off_vk0 Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Period
size_vk

--
-- UnsoundPureSignKey instances
--

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

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

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

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

--
-- Direct ser/deser
--

instance
  ( DirectSerialise (SignKeyKES d)
  , DirectSerialise (VerKeyKES d)
  , KESAlgorithm d
  ) =>
  DirectSerialise (SignKeyKES (CompactSumKES h d))
  where
  directSerialise :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ())
-> SignKeyKES (CompactSumKES h d) -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push (SignKeyCompactSumKES SignKeyKES d
sk MLockedSeed (SeedSizeKES d)
r VerKeyKES d
vk0 VerKeyKES d
vk1) = do
    (Ptr CChar -> CSize -> m ()) -> SignKeyKES d -> m ()
forall a (m :: Type -> Type).
(DirectSerialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> a -> m ()
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> SignKeyKES d -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push SignKeyKES d
sk
    (Ptr CChar -> CSize -> m ()) -> MLockedSeed (SeedSizeKES d) -> m ()
forall a (m :: Type -> Type).
(DirectSerialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> a -> m ()
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> MLockedSeed (SeedSizeKES d) -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push MLockedSeed (SeedSizeKES d)
r
    (Ptr CChar -> CSize -> m ()) -> VerKeyKES d -> m ()
forall a (m :: Type -> Type).
(DirectSerialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> a -> m ()
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> VerKeyKES d -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push VerKeyKES d
vk0
    (Ptr CChar -> CSize -> m ()) -> VerKeyKES d -> m ()
forall a (m :: Type -> Type).
(DirectSerialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> a -> m ()
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> VerKeyKES d -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push VerKeyKES d
vk1

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

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

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

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