{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- | A key evolving signatures implementation.
--
-- It is a naive recursive implementation of the sum composition from
-- section 3.1 of the \"MMM\" paper:
--
-- /Composition and Efficiency Tradeoffs for Forward-Secure Digital Signatures/
-- By Tal Malkin, Daniele Micciancio and Sara Miner
-- <https://eprint.iacr.org/2001/034>
--
-- Specfically we do the binary sum composition directly as in the paper, and
-- then use that in a nested\/recursive fashion to construct a 7-level deep
-- binary tree version.
--
-- This relies on "Cardano.Crypto.KES.Single" for the base case.
--
module Cardano.Crypto.KES.Sum (
    SumKES
  , VerKeyKES (..)
  , SignKeyKES (..)
  , SigKES (..)

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

import           Data.Proxy (Proxy(..))
import           Data.Typeable (Typeable)
import           GHC.Generics (Generic)
import qualified Data.ByteString as BS
import           Control.Monad (guard)
import           GHC.TypeLits (KnownNat)
import           NoThunks.Class (NoThunks)

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

import           Cardano.Crypto.Hash.Class
import           Cardano.Crypto.KES.Class
import           Cardano.Crypto.KES.Single (SingleKES)

import qualified Cardano.Crypto.Libsodium as NaCl


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

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

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

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

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

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

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

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


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

instance ( KESAlgorithm d
         , NaCl.SodiumHashAlgorithm h -- needed for secure forgetting
         , Typeable d
         , SizeHash h ~ SeedSizeKES d -- can be relaxed
         )
      => KESAlgorithm (SumKES h d) where

    type SeedSizeKES (SumKES h d) = SeedSizeKES d

    --
    -- Key and signature types
    --

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

    -- | From Figure 3: @(sk_0, r_1, vk_0, vk_1)@
    --
    data SignKeyKES (SumKES h d) =
           SignKeySumKES !(SignKeyKES d)
                         !(NaCl.MLockedSizedBytes (SeedSizeKES d))
                         !(VerKeyKES d)
                         !(VerKeyKES d)
        deriving (forall x.
 SignKeyKES (SumKES h d) -> Rep (SignKeyKES (SumKES h d)) x)
-> (forall x.
    Rep (SignKeyKES (SumKES h d)) x -> SignKeyKES (SumKES h d))
-> Generic (SignKeyKES (SumKES h d))
forall x.
Rep (SignKeyKES (SumKES h d)) x -> SignKeyKES (SumKES h d)
forall x.
SignKeyKES (SumKES h d) -> Rep (SignKeyKES (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 (SignKeyKES (SumKES h d)) x -> SignKeyKES (SumKES h d)
forall h d x.
SignKeyKES (SumKES h d) -> Rep (SignKeyKES (SumKES h d)) x
$cto :: forall h d x.
Rep (SignKeyKES (SumKES h d)) x -> SignKeyKES (SumKES h d)
$cfrom :: forall h d x.
SignKeyKES (SumKES h d) -> Rep (SignKeyKES (SumKES h d)) x
Generic

    -- | From Figure 3: @(sigma, vk_0, vk_1)@
    --
    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
$cto :: forall h d x. Rep (SigKES (SumKES h d)) x -> SigKES (SumKES h d)
$cfrom :: forall h d x. SigKES (SumKES h d) -> Rep (SigKES (SumKES h d)) x
Generic


    --
    -- Metadata and basic key operations
    --

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

    deriveVerKeyKES :: SignKeyKES (SumKES h d) -> VerKeyKES (SumKES h d)
deriveVerKeyKES (SignKeySumKES _ _ vk_0 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))

    -- 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 :: VerKeyKES (SumKES h d) -> Hash h (VerKeyKES (SumKES h d))
hashVerKeyKES (VerKeySumKES 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)


    --
    -- Core algorithm operations
    --

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

    signKES :: ContextKES (SumKES h d)
-> Period -> a -> SignKeyKES (SumKES h d) -> SigKES (SumKES h d)
signKES ContextKES (SumKES h d)
ctxt Period
t a
a (SignKeySumKES sk _r_1 vk_0 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 -> SignKeyKES d -> SigKES d
forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v -> Period -> a -> SignKeyKES v -> SigKES v
signKES ContextKES d
ContextKES (SumKES h d)
ctxt  Period
t       a
a SignKeyKES d
sk
              | Bool
otherwise = ContextKES d -> Period -> a -> SignKeyKES d -> SigKES d
forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v -> Period -> a -> SignKeyKES v -> SigKES v
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 :: * -> *). KESAlgorithm v => proxy v -> Period
totalPeriodsKES (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)

    verifyKES :: ContextKES (SumKES h d)
-> VerKeyKES (SumKES h d)
-> Period
-> a
-> SigKES (SumKES h d)
-> Either String ()
verifyKES ContextKES (SumKES h d)
ctxt (VerKeySumKES vk) Period
t a
a (SigSumKES sigma vk_0 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 ()
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 ()
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 :: * -> *). KESAlgorithm v => proxy v -> Period
totalPeriodsKES (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)

    updateKES :: ContextKES (SumKES h d)
-> SignKeyKES (SumKES h d)
-> Period
-> Maybe (SignKeyKES (SumKES h d))
updateKES ContextKES (SumKES h d)
ctx (SignKeySumKES sk r_1 vk_0 vk_1) Period
t
      | Period
tPeriod -> Period -> Period
forall a. Num a => a -> a -> a
+Period
1 Period -> Period -> Bool
forall a. Ord a => a -> a -> Bool
<  Period
_T = do SignKeyKES d
sk' <- ContextKES d -> SignKeyKES d -> Period -> Maybe (SignKeyKES d)
forall v.
(KESAlgorithm v, HasCallStack) =>
ContextKES v -> SignKeyKES v -> Period -> Maybe (SignKeyKES v)
updateKES ContextKES d
ContextKES (SumKES h d)
ctx SignKeyKES d
sk Period
t
                       SignKeyKES (SumKES h d) -> Maybe (SignKeyKES (SumKES h d))
forall (m :: * -> *) a. Monad m => a -> m a
return (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
-> MLockedSizedBytes (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
forall h d.
SignKeyKES d
-> MLockedSizedBytes (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES SignKeyKES d
sk' MLockedSizedBytes (SeedSizeKES d)
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1
      | Period
tPeriod -> 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' :: SignKeyKES d
sk' = MLockedSizedBytes (SeedSizeKES d) -> SignKeyKES d
forall v.
KESAlgorithm v =>
MLockedSizedBytes (SeedSizeKES v) -> SignKeyKES v
genKeyKES MLockedSizedBytes (SeedSizeKES d)
r_1
                       SignKeyKES (SumKES h d) -> Maybe (SignKeyKES (SumKES h d))
forall (m :: * -> *) a. Monad m => a -> m a
return (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
-> MLockedSizedBytes (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
forall h d.
SignKeyKES d
-> MLockedSizedBytes (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES SignKeyKES d
sk' MLockedSizedBytes (SeedSizeKES d)
forall (n :: Nat). KnownNat n => MLockedSizedBytes n
NaCl.mlsbZero VerKeyKES d
vk_0 VerKeyKES d
vk_1
      | Bool
otherwise = do SignKeyKES d
sk' <- ContextKES d -> SignKeyKES d -> Period -> Maybe (SignKeyKES d)
forall v.
(KESAlgorithm v, HasCallStack) =>
ContextKES v -> SignKeyKES v -> Period -> Maybe (SignKeyKES v)
updateKES ContextKES d
ContextKES (SumKES h d)
ctx SignKeyKES d
sk (Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
- Period
_T)
                       SignKeyKES (SumKES h d) -> Maybe (SignKeyKES (SumKES h d))
forall (m :: * -> *) a. Monad m => a -> m a
return (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
-> MLockedSizedBytes (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
forall h d.
SignKeyKES d
-> MLockedSizedBytes (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES SignKeyKES d
sk' MLockedSizedBytes (SeedSizeKES d)
r_1 VerKeyKES d
vk_0 VerKeyKES d
vk_1
      where
        _T :: Period
_T = Proxy d -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
totalPeriodsKES (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)

    totalPeriodsKES :: 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 :: * -> *). KESAlgorithm v => proxy v -> Period
totalPeriodsKES (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)


    --
    -- Key generation
    --

    genKeyKES :: MLockedSizedBytes (SeedSizeKES (SumKES h d))
-> SignKeyKES (SumKES h d)
genKeyKES MLockedSizedBytes (SeedSizeKES (SumKES h d))
r = SignKeyKES d
-> MLockedSizedBytes (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
forall h d.
SignKeyKES d
-> MLockedSizedBytes (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES SignKeyKES d
sk_0 MLockedSizedBytes (SeedSizeKES d)
r1 VerKeyKES d
vk_0 VerKeyKES d
vk_1
      where
        (MLockedSizedBytes (SeedSizeKES d)
r0, MLockedSizedBytes (SeedSizeKES d)
r1) = Proxy h
-> MLockedSizedBytes (SizeHash h)
-> (MLockedSizedBytes (SizeHash h), MLockedSizedBytes (SizeHash h))
forall h (proxy :: * -> *).
SodiumHashAlgorithm h =>
proxy h
-> MLockedSizedBytes (SizeHash h)
-> (MLockedSizedBytes (SizeHash h), MLockedSizedBytes (SizeHash h))
NaCl.expandHash (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h) MLockedSizedBytes (SizeHash h)
MLockedSizedBytes (SeedSizeKES (SumKES h d))
r

        sk_0 :: SignKeyKES d
sk_0 = MLockedSizedBytes (SeedSizeKES d) -> SignKeyKES d
forall v.
KESAlgorithm v =>
MLockedSizedBytes (SeedSizeKES v) -> SignKeyKES v
genKeyKES MLockedSizedBytes (SeedSizeKES d)
r0
        vk_0 :: VerKeyKES d
vk_0 = SignKeyKES d -> VerKeyKES d
forall v. KESAlgorithm v => SignKeyKES v -> VerKeyKES v
deriveVerKeyKES SignKeyKES d
sk_0

        sk_1 :: SignKeyKES d
sk_1 = MLockedSizedBytes (SeedSizeKES d) -> SignKeyKES d
forall v.
KESAlgorithm v =>
MLockedSizedBytes (SeedSizeKES v) -> SignKeyKES v
genKeyKES MLockedSizedBytes (SeedSizeKES d)
r1
        vk_1 :: VerKeyKES d
vk_1 = SignKeyKES d -> VerKeyKES d
forall v. KESAlgorithm v => SignKeyKES v -> VerKeyKES v
deriveVerKeyKES SignKeyKES d
sk_1

    --
    -- forgetting
    --
    forgetSignKeyKES :: SignKeyKES (SumKES h d) -> IO ()
forgetSignKeyKES (SignKeySumKES sk_0 r1 _ _) = do
        SignKeyKES d -> IO ()
forall v. KESAlgorithm v => SignKeyKES v -> IO ()
forgetSignKeyKES SignKeyKES d
sk_0
        MLockedSizedBytes (SeedSizeKES d) -> IO ()
forall (n :: Nat). MLockedSizedBytes n -> IO ()
NaCl.mlsbFinalize MLockedSizedBytes (SeedSizeKES d)
r1

    --
    -- raw serialise/deserialise
    --

    sizeVerKeyKES :: proxy (SumKES h d) -> Period
sizeVerKeyKES  proxy (SumKES h d)
_ = Proxy h -> Period
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Period
sizeHash       (Proxy h
forall k (t :: k). Proxy t
Proxy :: Proxy h)
    sizeSignKeyKES :: proxy (SumKES h d) -> Period
sizeSignKeyKES proxy (SumKES h d)
_ = Proxy d -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
sizeSignKeyKES (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)
                     Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Proxy d -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
seedSizeKES    (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)
                     Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Proxy d -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
sizeVerKeyKES  (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d) Period -> Period -> Period
forall a. Num a => a -> a -> a
* Period
2
    sizeSigKES :: proxy (SumKES h d) -> Period
sizeSigKES     proxy (SumKES h d)
_ = Proxy d -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
sizeSigKES     (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)
                     Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Proxy d -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
sizeVerKeyKES  (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d) Period -> Period -> Period
forall a. Num a => a -> a -> a
* Period
2

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

    rawSerialiseSignKeyKES :: SignKeyKES (SumKES h d) -> ByteString
rawSerialiseSignKeyKES (SignKeySumKES sk r_1 vk_0 vk_1) =
      [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
        [ SignKeyKES d -> ByteString
forall v. KESAlgorithm v => SignKeyKES v -> ByteString
rawSerialiseSignKeyKES SignKeyKES d
sk
        , MLockedSizedBytes (SeedSizeKES d) -> ByteString
forall (n :: Nat). KnownNat n => MLockedSizedBytes n -> ByteString
NaCl.mlsbToByteString MLockedSizedBytes (SeedSizeKES d)
r_1
        , 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
        ]

    rawSerialiseSigKES :: SigKES (SumKES h d) -> ByteString
rawSerialiseSigKES (SigSumKES sigma vk_0 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 (f :: * -> *) 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

    rawDeserialiseSignKeyKES :: ByteString -> Maybe (SignKeyKES (SumKES h d))
rawDeserialiseSignKeyKES ByteString
b = do
        Bool -> Maybe ()
forall (f :: * -> *). 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   <- ByteString -> Maybe (SignKeyKES d)
forall v. KESAlgorithm v => ByteString -> Maybe (SignKeyKES v)
rawDeserialiseSignKeyKES ByteString
b_sk
        let r :: MLockedSizedBytes (SeedSizeKES d)
r = ByteString -> MLockedSizedBytes (SeedSizeKES d)
forall (n :: Nat). KnownNat n => ByteString -> MLockedSizedBytes n
NaCl.mlsbFromByteString  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
        SignKeyKES (SumKES h d) -> Maybe (SignKeyKES (SumKES h d))
forall (m :: * -> *) a. Monad m => a -> m a
return (SignKeyKES d
-> MLockedSizedBytes (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
forall h d.
SignKeyKES d
-> MLockedSizedBytes (SeedSizeKES d)
-> VerKeyKES d
-> VerKeyKES d
-> SignKeyKES (SumKES h d)
SignKeySumKES SignKeyKES d
sk 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 :: * -> *). 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 :: * -> *). 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 :: * -> *). 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 :: * -> *). 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

    rawDeserialiseSigKES :: ByteString -> Maybe (SigKES (SumKES h d))
rawDeserialiseSigKES ByteString
b = do
        Bool -> Maybe ()
forall (f :: * -> *). 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 (m :: * -> *) 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 :: * -> *). 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 :: * -> *). 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 :: * -> *). 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

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

slice :: Word -> Word -> ByteString -> ByteString
slice :: Period -> Period -> ByteString -> ByteString
slice Period
offset Period
size = Int -> ByteString -> ByteString
BS.take (Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
size)
                  (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop (Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
offset)

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

  | Bool
otherwise
  = String
basename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_2^1"


--
-- VerKey instances
--

deriving instance Show (VerKeyKES (SumKES h d))
deriving instance Eq   (VerKeyKES (SumKES h d))

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

instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, 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 d, NaCl.SodiumHashAlgorithm h, Typeable d, SizeHash h ~ SeedSizeKES d)
      => FromCBOR (VerKeyKES (SumKES h d)) where
  fromCBOR :: Decoder s (VerKeyKES (SumKES h d))
fromCBOR = Decoder s (VerKeyKES (SumKES h d))
forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES


--
-- SignKey instances
--

deriving instance (KnownNat (SizeHash h), KESAlgorithm d) => Show (SignKeyKES (SumKES h d))

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

instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, SizeHash h ~ SeedSizeKES d)
      => ToCBOR (SignKeyKES (SumKES h d)) where
  toCBOR :: SignKeyKES (SumKES h d) -> Encoding
toCBOR = SignKeyKES (SumKES h d) -> Encoding
forall v. KESAlgorithm v => SignKeyKES v -> Encoding
encodeSignKeyKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SignKeyKES (SumKES h d)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (SignKeyKES (SumKES h d)) -> Size
forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr

instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, SizeHash h ~ SeedSizeKES d)
      => FromCBOR (SignKeyKES (SumKES h d)) where
  fromCBOR :: Decoder s (SignKeyKES (SumKES h d))
fromCBOR = Decoder s (SignKeyKES (SumKES h d))
forall v s. KESAlgorithm v => Decoder s (SignKeyKES v)
decodeSignKeyKES


--
-- Sig instances
--

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

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

instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, 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 d, NaCl.SodiumHashAlgorithm h, Typeable d, SizeHash h ~ SeedSizeKES d)
      => FromCBOR (SigKES (SumKES h d)) where
  fromCBOR :: Decoder s (SigKES (SumKES h d))
fromCBOR = Decoder s (SigKES (SumKES h d))
forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES