{-# 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 #-}
module Cardano.Crypto.KES.Sum (
SumKES,
VerKeyKES (..),
SignKeyKES (..),
SigKES (..),
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 (+))
type Sum0KES d = SingleKES d
type Sum1KES d h = SumKES h (Sum0KES d)
type Sum2KES d h = SumKES h (Sum1KES d h)
type Sum3KES d h = SumKES h (Sum2KES d h)
type Sum4KES d h = SumKES h (Sum3KES d h)
type Sum5KES d h = SumKES h (Sum4KES d h)
type Sum6KES d h = SumKES h (Sum5KES d h)
type Sum7KES d h = SumKES h (Sum6KES d h)
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) =
(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
( KESAlgorithm d
, SodiumHashAlgorithm h
, SizeHash h ~ SeedSizeKES d
, KnownNat ((SizeSignKeyKES d + SeedSizeKES d) + (2 * SizeVerKeyKES d))
, KnownNat (SizeSigKES d + (SizeVerKeyKES d * 2))
) =>
KESAlgorithm (SumKES h d)
where
data SignKeyKES (SumKES h d)
= SignKeySumKES
!(SignKeyKES d)
!(MLockedSeed (SeedSizeKES d))
!(VerKeyKES d)
!(VerKeyKES d)
type SeedSizeKES (SumKES h d) = SeedSizeKES d
newtype VerKeyKES (SumKES h d)
= VerKeySumKES (Hash h (VerKeyKES d, VerKeyKES d))
deriving ((forall x.
VerKeyKES (SumKES h d) -> Rep (VerKeyKES (SumKES h d)) x)
-> (forall x.
Rep (VerKeyKES (SumKES h d)) x -> VerKeyKES (SumKES h d))
-> Generic (VerKeyKES (SumKES h d))
forall x. Rep (VerKeyKES (SumKES h d)) x -> VerKeyKES (SumKES h d)
forall x. VerKeyKES (SumKES h d) -> Rep (VerKeyKES (SumKES 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 (SumKES h d)) x -> VerKeyKES (SumKES h d)
forall h d x.
VerKeyKES (SumKES h d) -> Rep (VerKeyKES (SumKES h d)) x
$cfrom :: forall h d x.
VerKeyKES (SumKES h d) -> Rep (VerKeyKES (SumKES h d)) x
from :: forall 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)
to :: forall x. Rep (VerKeyKES (SumKES h d)) x -> VerKeyKES (SumKES h d)
Generic)
deriving newtype (VerKeyKES (SumKES h d) -> ()
(VerKeyKES (SumKES h d) -> ()) -> NFData (VerKeyKES (SumKES h d))
forall a. (a -> ()) -> NFData a
forall h d. VerKeyKES (SumKES h d) -> ()
$crnf :: forall h d. VerKeyKES (SumKES h d) -> ()
rnf :: VerKeyKES (SumKES h d) -> ()
NFData)
data SigKES (SumKES h d)
= SigSumKES
!(SigKES d)
!(VerKeyKES d)
!(VerKeyKES d)
deriving ((forall x. SigKES (SumKES h d) -> Rep (SigKES (SumKES h d)) x)
-> (forall x. Rep (SigKES (SumKES h d)) x -> SigKES (SumKES h d))
-> Generic (SigKES (SumKES h d))
forall x. Rep (SigKES (SumKES h d)) x -> SigKES (SumKES h d)
forall x. SigKES (SumKES h d) -> Rep (SigKES (SumKES 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 (SumKES h d)) x -> SigKES (SumKES h d)
forall h d x. SigKES (SumKES h d) -> Rep (SigKES (SumKES h d)) x
$cfrom :: forall h d x. SigKES (SumKES h d) -> Rep (SigKES (SumKES h d)) x
from :: forall 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)
to :: forall x. Rep (SigKES (SumKES h d)) x -> SigKES (SumKES h d)
Generic)
algorithmNameKES :: forall (proxy :: Type -> Type). proxy (SumKES h d) -> String
algorithmNameKES proxy (SumKES 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))
hashVerKeyKES :: forall h.
HashAlgorithm h =>
VerKeyKES (SumKES h d) -> Hash h (VerKeyKES (SumKES h d))
hashVerKeyKES (VerKeySumKES Hash h (VerKeyKES d, VerKeyKES d)
vk) = Hash h (Hash h (VerKeyKES d, VerKeyKES d))
-> Hash h (VerKeyKES (SumKES 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)
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)
| (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) Hash h (VerKeyKES d, VerKeyKES d)
-> Hash h (VerKeyKES d, VerKeyKES d) -> Bool
forall a. Eq a => a -> a -> Bool
/= Hash h (VerKeyKES d, VerKeyKES d)
vk =
String -> Either String ()
forall a b. a -> Either a b
Left String
"Reject"
| Period
t Period -> Period -> Bool
forall a. Ord a => a -> a -> Bool
< Period
_T = ContextKES d
-> VerKeyKES d -> Period -> a -> SigKES d -> Either String ()
forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v
-> VerKeyKES v -> Period -> a -> SigKES v -> Either String ()
forall a.
(Signable d a, HasCallStack) =>
ContextKES d
-> VerKeyKES d -> Period -> a -> SigKES d -> Either String ()
verifyKES ContextKES d
ContextKES (SumKES h d)
ctxt VerKeyKES d
vk_0 Period
t a
a SigKES d
sigma
| Bool
otherwise = ContextKES d
-> VerKeyKES d -> Period -> a -> SigKES d -> Either String ()
forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v
-> VerKeyKES v -> Period -> a -> SigKES v -> Either String ()
forall a.
(Signable d a, HasCallStack) =>
ContextKES d
-> VerKeyKES d -> Period -> a -> SigKES d -> Either String ()
verifyKES ContextKES d
ContextKES (SumKES h d)
ctxt VerKeyKES d
vk_1 (Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
- 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)
totalPeriodsKES :: forall (proxy :: Type -> Type). proxy (SumKES h d) -> Period
totalPeriodsKES proxy (SumKES 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)
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) = Hash h (VerKeyKES d, VerKeyKES d) -> ByteString
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) =
[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_0
, VerKeyKES d -> ByteString
forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES d
vk_1
]
rawDeserialiseVerKeyKES :: ByteString -> Maybe (VerKeyKES (SumKES h d))
rawDeserialiseVerKeyKES = (Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d))
-> Maybe (Hash h (VerKeyKES d, VerKeyKES d))
-> Maybe (VerKeyKES (SumKES 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 (SumKES h d)
forall h d.
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d)
VerKeySumKES (Maybe (Hash h (VerKeyKES d, VerKeyKES d))
-> Maybe (VerKeyKES (SumKES h d)))
-> (ByteString -> Maybe (Hash h (VerKeyKES d, VerKeyKES d)))
-> ByteString
-> Maybe (VerKeyKES (SumKES 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
{-# INLINE rawDeserialiseVerKeyKES #-}
rawDeserialiseSigKES :: ByteString -> Maybe (SigKES (SumKES 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_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
SigKES (SumKES h d) -> Maybe (SigKES (SumKES h d))
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SigKES d -> VerKeyKES d -> VerKeyKES d -> SigKES (SumKES h d)
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 = 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 (SumKES h d) -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSigKES (Proxy (SumKES h d)
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 Period -> Period -> Period
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) =
VerKeyKES (SumKES h d) -> m (VerKeyKES (SumKES h d))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (VerKeyKES (SumKES h d) -> m (VerKeyKES (SumKES h d)))
-> VerKeyKES (SumKES h d) -> m (VerKeyKES (SumKES h d))
forall a b. (a -> b) -> a -> b
$! Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d)
forall h d.
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d)
VerKeySumKES ((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))
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
SigKES (SumKES h d) -> m (SigKES (SumKES h d))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SigKES (SumKES h d) -> m (SigKES (SumKES h d)))
-> SigKES (SumKES h d) -> m (SigKES (SumKES h d))
forall a b. (a -> b) -> a -> b
$! SigKES d -> VerKeyKES d -> VerKeyKES d -> SigKES (SumKES h d)
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 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 (SumKES h d)
ctxt Period
t a
a SignKeyKES d
sk
| 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 (SumKES h d)
ctxt (Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
- Period
_T) a
a SignKeyKES d
sk
_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 (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 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 (SumKES h d))
-> m (Maybe (SignKeyKES (SumKES h d)))
forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m (SignKeyKES (SumKES h d))
-> m (Maybe (SignKeyKES (SumKES h d))))
-> MaybeT m (SignKeyKES (SumKES h d))
-> m (Maybe (SignKeyKES (SumKES 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 (SumKES h d)
ctx SignKeyKES d
sk Period
t
MLockedSeed (SeedSizeKES d)
r_1' <- m (Maybe (MLockedSeed (SeedSizeKES d)))
-> MaybeT m (MLockedSeed (SeedSizeKES d))
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (MLockedSeed (SeedSizeKES d)))
-> MaybeT m (MLockedSeed (SeedSizeKES d)))
-> m (Maybe (MLockedSeed (SeedSizeKES d)))
-> MaybeT m (MLockedSeed (SeedSizeKES d))
forall a b. (a -> b) -> a -> b
$! MLockedSeed (SeedSizeKES d) -> Maybe (MLockedSeed (SeedSizeKES d))
forall a. a -> Maybe a
Just (MLockedSeed (SeedSizeKES d)
-> Maybe (MLockedSeed (SeedSizeKES d)))
-> m (MLockedSeed (SeedSizeKES d))
-> m (Maybe (MLockedSeed (SeedSizeKES d)))
forall (m :: Type -> Type) a b. Monad m => (a -> b) -> m a -> m b
<$!> MLockedSeed (SeedSizeKES d) -> m (MLockedSeed (SeedSizeKES d))
forall (n :: Nat) (m :: Type -> Type).
(KnownNat n, MonadST m) =>
MLockedSeed n -> m (MLockedSeed n)
mlockedSeedCopy MLockedSeed (SeedSizeKES d)
r_1
SignKeyKES (SumKES h d) -> MaybeT m (SignKeyKES (SumKES h d))
forall a. a -> MaybeT m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SignKeyKES (SumKES h d) -> MaybeT m (SignKeyKES (SumKES h d)))
-> SignKeyKES (SumKES h d) -> MaybeT m (SignKeyKES (SumKES h d))
forall a b. (a -> b) -> a -> b
$! SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
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 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)
r_1' <- 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 (SumKES h d))
-> m (Maybe (SignKeyKES (SumKES h d)))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (SignKeyKES (SumKES h d))
-> m (Maybe (SignKeyKES (SumKES h d))))
-> Maybe (SignKeyKES (SumKES h d))
-> m (Maybe (SignKeyKES (SumKES h d)))
forall a b. (a -> b) -> a -> b
$! SignKeyKES (SumKES h d) -> Maybe (SignKeyKES (SumKES h d))
forall a. a -> Maybe a
Just (SignKeyKES (SumKES h d) -> Maybe (SignKeyKES (SumKES h d)))
-> SignKeyKES (SumKES h d) -> Maybe (SignKeyKES (SumKES h d))
forall a b. (a -> b) -> a -> b
$! SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
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 = MaybeT m (SignKeyKES (SumKES h d))
-> m (Maybe (SignKeyKES (SumKES h d)))
forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m (SignKeyKES (SumKES h d))
-> m (Maybe (SignKeyKES (SumKES h d))))
-> MaybeT m (SignKeyKES (SumKES h d))
-> m (Maybe (SignKeyKES (SumKES 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 (SumKES 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 (Maybe (MLockedSeed (SeedSizeKES d)))
-> MaybeT m (MLockedSeed (SeedSizeKES d))
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (MLockedSeed (SeedSizeKES d)))
-> MaybeT m (MLockedSeed (SeedSizeKES d)))
-> m (Maybe (MLockedSeed (SeedSizeKES d)))
-> MaybeT m (MLockedSeed (SeedSizeKES d))
forall a b. (a -> b) -> a -> b
$! MLockedSeed (SeedSizeKES d) -> Maybe (MLockedSeed (SeedSizeKES d))
forall a. a -> Maybe a
Just (MLockedSeed (SeedSizeKES d)
-> Maybe (MLockedSeed (SeedSizeKES d)))
-> m (MLockedSeed (SeedSizeKES d))
-> m (Maybe (MLockedSeed (SeedSizeKES d)))
forall (m :: Type -> Type) a b. Monad m => (a -> b) -> m a -> m 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 (SumKES h d) -> MaybeT m (SignKeyKES (SumKES h d))
forall a. a -> MaybeT m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SignKeyKES (SumKES h d) -> MaybeT m (SignKeyKES (SumKES h d)))
-> SignKeyKES (SumKES h d) -> MaybeT m (SignKeyKES (SumKES h d))
forall a b. (a -> b) -> a -> b
$! SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
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 = 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 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) <- 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 (SumKES 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 (SumKES h d) -> m (SignKeyKES (SumKES h d))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SignKeyKES (SumKES h d) -> m (SignKeyKES (SumKES h d)))
-> SignKeyKES (SumKES h d) -> m (SignKeyKES (SumKES h d))
forall a b. (a -> b) -> a -> b
$! SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
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
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
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 (SumKES h d)
, UnsoundKESAlgorithm d
) =>
UnsoundKESAlgorithm (SumKES h d)
where
{-# 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 <- 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 (SumKES h d)))
rawDeserialiseSignKeyKESWith MLockedAllocator m
allocator ByteString
b = MaybeT m (SignKeyKES (SumKES h d))
-> m (Maybe (SignKeyKES (SumKES h d)))
forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m (SignKeyKES (SumKES h d))
-> m (Maybe (SignKeyKES (SumKES h d))))
-> MaybeT m (SignKeyKES (SumKES h d))
-> m (Maybe (SignKeyKES (SumKES 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 (SumKES h d) -> MaybeT m (SignKeyKES (SumKES 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 (SumKES h d)
forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES 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 (SumKES h d) -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSignKeyKES (Proxy (SumKES h d)
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 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
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 = VerKeyKES (SumKES h d) -> Encoding
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 = Proxy (VerKeyKES (SumKES h d)) -> 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 = Decoder s (VerKeyKES (SumKES h d))
forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES
{-# INLINE fromCBOR #-}
instance KESAlgorithm d => NoThunks (VerKeyKES (SumKES h d))
deriving via
OnlyCheckWhnfNamed "SignKeyKES (SumKES h d)" (SignKeyKES (SumKES h d))
instance
NoThunks (SignKeyKES (SumKES h d))
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 = SigKES (SumKES h d) -> Encoding
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 = Proxy (SigKES (SumKES h d)) -> 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 = Decoder s (SigKES (SumKES h d))
forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES
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 x.
UnsoundPureSignKeyKES (SumKES h d)
-> Rep (UnsoundPureSignKeyKES (SumKES h d)) x)
-> (forall x.
Rep (UnsoundPureSignKeyKES (SumKES h d)) x
-> UnsoundPureSignKeyKES (SumKES h d))
-> Generic (UnsoundPureSignKeyKES (SumKES h d))
forall x.
Rep (UnsoundPureSignKeyKES (SumKES h d)) x
-> UnsoundPureSignKeyKES (SumKES h d)
forall x.
UnsoundPureSignKeyKES (SumKES h d)
-> Rep (UnsoundPureSignKeyKES (SumKES 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 (SumKES h d)) x
-> UnsoundPureSignKeyKES (SumKES h d)
forall h d x.
UnsoundPureSignKeyKES (SumKES h d)
-> Rep (UnsoundPureSignKeyKES (SumKES h d)) x
$cfrom :: forall h d x.
UnsoundPureSignKeyKES (SumKES h d)
-> Rep (UnsoundPureSignKeyKES (SumKES h d)) x
from :: forall 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)
to :: forall x.
Rep (UnsoundPureSignKeyKES (SumKES h d)) x
-> UnsoundPureSignKeyKES (SumKES h d)
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) =
SigKES d -> VerKeyKES d -> VerKeyKES d -> SigKES (SumKES h d)
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 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 (SumKES h d)
ctxt Period
t a
a UnsoundPureSignKeyKES d
sk
| 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 (SumKES h d)
ctxt (Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
- Period
_T) a
a UnsoundPureSignKeyKES d
sk
_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 (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 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 (SumKES h d)
ctx UnsoundPureSignKeyKES d
sk Period
t
UnsoundPureSignKeyKES (SumKES h d)
-> Maybe (UnsoundPureSignKeyKES (SumKES h d))
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (UnsoundPureSignKeyKES (SumKES h d)
-> Maybe (UnsoundPureSignKeyKES (SumKES h d)))
-> UnsoundPureSignKeyKES (SumKES h d)
-> Maybe (UnsoundPureSignKeyKES (SumKES h d))
forall a b. (a -> b) -> a -> b
$! UnsoundPureSignKeyKES d
-> Seed
-> VerKeyKES d
-> VerKeyKES d
-> UnsoundPureSignKeyKES (SumKES h d)
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 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 (SumKES h d)
-> Maybe (UnsoundPureSignKeyKES (SumKES h d))
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (UnsoundPureSignKeyKES (SumKES h d)
-> Maybe (UnsoundPureSignKeyKES (SumKES h d)))
-> UnsoundPureSignKeyKES (SumKES h d)
-> Maybe (UnsoundPureSignKeyKES (SumKES h d))
forall a b. (a -> b) -> a -> b
$! UnsoundPureSignKeyKES d
-> Seed
-> VerKeyKES d
-> VerKeyKES d
-> UnsoundPureSignKeyKES (SumKES h d)
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' <- ContextKES d
-> UnsoundPureSignKeyKES d
-> Period
-> Maybe (UnsoundPureSignKeyKES d)
forall v.
UnsoundPureKESAlgorithm v =>
ContextKES v
-> UnsoundPureSignKeyKES v
-> Period
-> Maybe (UnsoundPureSignKeyKES v)
unsoundPureUpdateKES ContextKES d
ContextKES (SumKES h d)
ctx UnsoundPureSignKeyKES d
sk (Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
- Period
_T)
UnsoundPureSignKeyKES (SumKES h d)
-> Maybe (UnsoundPureSignKeyKES (SumKES h d))
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (UnsoundPureSignKeyKES (SumKES h d)
-> Maybe (UnsoundPureSignKeyKES (SumKES h d)))
-> UnsoundPureSignKeyKES (SumKES h d)
-> Maybe (UnsoundPureSignKeyKES (SumKES h d))
forall a b. (a -> b) -> a -> b
$! UnsoundPureSignKeyKES d
-> Seed
-> VerKeyKES d
-> VerKeyKES d
-> UnsoundPureSignKeyKES (SumKES h d)
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 = 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)
unsoundPureGenKeyKES :: Seed -> UnsoundPureSignKeyKES (SumKES h d)
unsoundPureGenKeyKES Seed
r =
let (Seed
r0, Seed
r1) = Proxy h -> Seed -> (Seed, Seed)
forall h (proxy :: Type -> Type).
HashAlgorithm h =>
proxy h -> Seed -> (Seed, Seed)
expandSeed (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h) 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 (SumKES h d)
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) =
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d)
forall h d.
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d)
VerKeySumKES ((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 (SumKES h d) -> m (SignKeyKES (SumKES h d))
unsoundPureSignKeyKESToSoundSignKeyKES (UnsoundPureSignKeySumKES UnsoundPureSignKeyKES d
sk Seed
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1) =
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
forall h d.
SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES
(SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d))
-> m (SignKeyKES d)
-> m (MLockedSeed (SeedSizeKES d)
-> VerKeyKES d -> VerKeyKES d -> SignKeyKES (SumKES 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 (SumKES h d))
-> m (MLockedSeed (SeedSizeKES d))
-> m (VerKeyKES d -> VerKeyKES d -> SignKeyKES (SumKES 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 (SumKES h d))
-> m (VerKeyKES d) -> m (VerKeyKES d -> SignKeyKES (SumKES 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 (SumKES h d))
-> m (VerKeyKES d) -> m (SignKeyKES (SumKES 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 (SumKES h d) -> ByteString
rawSerialiseUnsoundPureSignKeyKES (UnsoundPureSignKeySumKES 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 (SumKES 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 (SumKES h d)
-> Maybe (UnsoundPureSignKeyKES (SumKES 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 (SumKES h d)
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 = 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 (SumKES h d) -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
sizeSignKeyKES (Proxy (SumKES h d)
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 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
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 = UnsoundPureSignKeyKES (SumKES h d) -> Encoding
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 = Proxy (SignKeyKES (SumKES h d)) -> Size
forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr (Proxy (SignKeyKES (SumKES h d))
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 = Decoder s (UnsoundPureSignKeyKES (SumKES h d))
forall v s.
UnsoundPureKESAlgorithm v =>
Decoder s (UnsoundPureSignKeyKES v)
decodeUnsoundPureSignKeyKES
instance
(NoThunks (UnsoundPureSignKeyKES d), KESAlgorithm d) =>
NoThunks (UnsoundPureSignKeyKES (SumKES h d))
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
(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
MLockedSeed (SeedSizeKES d) -> (Ptr Word8 -> m ()) -> m ()
forall (m :: Type -> Type) (n :: Nat) b.
MonadST m =>
MLockedSeed n -> (Ptr Word8 -> m b) -> m b
mlockedSeedUseAsCPtr MLockedSeed (SeedSizeKES d)
r ((Ptr Word8 -> m ()) -> m ()) -> (Ptr Word8 -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
Ptr CChar -> CSize -> m ()
push (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) (Period -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Period -> CSize) -> Period -> CSize
forall a b. (a -> b) -> a -> b
$ 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))
(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 (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 <- (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 <- m (MLockedSeed (SeedSizeKES d))
forall (n :: Nat) (m :: Type -> Type).
(KnownNat n, MonadST m) =>
m (MLockedSeed n)
mlockedSeedNew
MLockedSeed (SeedSizeKES d) -> (Ptr Word8 -> m ()) -> m ()
forall (m :: Type -> Type) (n :: Nat) b.
MonadST m =>
MLockedSeed n -> (Ptr Word8 -> m b) -> m b
mlockedSeedUseAsCPtr MLockedSeed (SeedSizeKES d)
r ((Ptr Word8 -> m ()) -> m ()) -> (Ptr Word8 -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
Ptr CChar -> CSize -> m ()
pull (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) (Period -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Period -> CSize) -> Period -> CSize
forall a b. (a -> b) -> a -> b
$ 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))
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 (SumKES h d) -> m (SignKeyKES (SumKES h d))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SignKeyKES (SumKES h d) -> m (SignKeyKES (SumKES h d)))
-> SignKeyKES (SumKES h d) -> m (SignKeyKES (SumKES h d))
forall a b. (a -> b) -> a -> b
$! SignKeyKES d
-> MLockedSeed (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
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) =
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 (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 = 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 (SumKES h d))
-> (VerKeyKES (SumKES h d) -> m (VerKeyKES (SumKES h d)))
-> Maybe (VerKeyKES (SumKES h d))
-> m (VerKeyKES (SumKES h d))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m (VerKeyKES (SumKES h d))
forall a. HasCallStack => String -> a
error String
"Invalid hash") VerKeyKES (SumKES h d) -> m (VerKeyKES (SumKES h d))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (VerKeyKES (SumKES h d)) -> m (VerKeyKES (SumKES h d)))
-> Maybe (VerKeyKES (SumKES h d)) -> m (VerKeyKES (SumKES h d))
forall a b. (a -> b) -> a -> b
$! Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d)
forall h d.
Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d)
VerKeySumKES (Hash h (VerKeyKES d, VerKeyKES d) -> VerKeyKES (SumKES h d))
-> Maybe (Hash h (VerKeyKES d, VerKeyKES d))
-> Maybe (VerKeyKES (SumKES 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