{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoStarIsType #-}

-- | Mock key evolving signatures.
module Cardano.Crypto.KES.Simple
  ( SimpleKES
  , SigKES (..)
  , SignKeyKES (SignKeySimpleKES, ThunkySignKeySimpleKES)
  )
where

import           Data.List (unfoldr)
import           Data.Proxy (Proxy (..))
import           Data.Typeable (Typeable)
import qualified Data.ByteString as BS
import           Data.Vector ((!?), Vector)
import qualified Data.Vector as Vec
import           GHC.Generics (Generic)
import           GHC.TypeNats (Nat, KnownNat, natVal, type (*))
import           NoThunks.Class (NoThunks)

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

import           Cardano.Crypto.DSIGN
import qualified Cardano.Crypto.DSIGN as DSIGN
import           Cardano.Crypto.KES.Class
import           Cardano.Crypto.Seed
import           Cardano.Crypto.Util


data SimpleKES d (t :: Nat)

-- | 'VerKeySimpleKES' uses a boxed 'Vector', which is lazy in its elements.
-- We don't want laziness and the potential space leak, so we use this pattern
-- synonym to force the elements of the vector to WHNF upon construction.
--
-- The alternative is to use an unboxed vector, but that would require an
-- unreasonable 'Unbox' constraint.
pattern VerKeySimpleKES :: Vector (VerKeyDSIGN d) -> VerKeyKES (SimpleKES d t)
pattern $bVerKeySimpleKES :: Vector (VerKeyDSIGN d) -> VerKeyKES (SimpleKES d t)
$mVerKeySimpleKES :: forall r d (t :: Nat).
VerKeyKES (SimpleKES d t)
-> (Vector (VerKeyDSIGN d) -> r) -> (Void# -> r) -> r
VerKeySimpleKES v <- ThunkyVerKeySimpleKES v
  where
    VerKeySimpleKES Vector (VerKeyDSIGN d)
v = Vector (VerKeyDSIGN d) -> VerKeyKES (SimpleKES d t)
forall d (t :: Nat).
Vector (VerKeyDSIGN d) -> VerKeyKES (SimpleKES d t)
ThunkyVerKeySimpleKES (Vector (VerKeyDSIGN d) -> Vector (VerKeyDSIGN d)
forall (t :: Type -> Type) a. Foldable t => t a -> t a
forceElemsToWHNF Vector (VerKeyDSIGN d)
v)

{-# COMPLETE VerKeySimpleKES #-}

-- | See 'VerKeySimpleKES'.
pattern SignKeySimpleKES :: Vector (SignKeyDSIGN d) -> SignKeyKES (SimpleKES d t)
pattern $bSignKeySimpleKES :: Vector (SignKeyDSIGN d) -> SignKeyKES (SimpleKES d t)
$mSignKeySimpleKES :: forall r d (t :: Nat).
SignKeyKES (SimpleKES d t)
-> (Vector (SignKeyDSIGN d) -> r) -> (Void# -> r) -> r
SignKeySimpleKES v <- ThunkySignKeySimpleKES v
  where
    SignKeySimpleKES Vector (SignKeyDSIGN d)
v = Vector (SignKeyDSIGN d) -> SignKeyKES (SimpleKES d t)
forall d (t :: Nat).
Vector (SignKeyDSIGN d) -> SignKeyKES (SimpleKES d t)
ThunkySignKeySimpleKES (Vector (SignKeyDSIGN d) -> Vector (SignKeyDSIGN d)
forall (t :: Type -> Type) a. Foldable t => t a -> t a
forceElemsToWHNF Vector (SignKeyDSIGN d)
v)

{-# COMPLETE SignKeySimpleKES #-}

instance (DSIGNAlgorithm d, Typeable d, KnownNat t, KnownNat (SeedSizeDSIGN d * t)) =>
         KESAlgorithm (SimpleKES d t) where

    type SeedSizeKES (SimpleKES d t) = SeedSizeDSIGN d * t

    --
    -- Key and signature types
    --

    newtype VerKeyKES (SimpleKES d t) =
              ThunkyVerKeySimpleKES (Vector (VerKeyDSIGN d))
        deriving (forall x.
 VerKeyKES (SimpleKES d t) -> Rep (VerKeyKES (SimpleKES d t)) x)
-> (forall x.
    Rep (VerKeyKES (SimpleKES d t)) x -> VerKeyKES (SimpleKES d t))
-> Generic (VerKeyKES (SimpleKES d t))
forall x.
Rep (VerKeyKES (SimpleKES d t)) x -> VerKeyKES (SimpleKES d t)
forall x.
VerKeyKES (SimpleKES d t) -> Rep (VerKeyKES (SimpleKES d t)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d (t :: Nat) x.
Rep (VerKeyKES (SimpleKES d t)) x -> VerKeyKES (SimpleKES d t)
forall d (t :: Nat) x.
VerKeyKES (SimpleKES d t) -> Rep (VerKeyKES (SimpleKES d t)) x
$cto :: forall d (t :: Nat) x.
Rep (VerKeyKES (SimpleKES d t)) x -> VerKeyKES (SimpleKES d t)
$cfrom :: forall d (t :: Nat) x.
VerKeyKES (SimpleKES d t) -> Rep (VerKeyKES (SimpleKES d t)) x
Generic

    newtype SignKeyKES (SimpleKES d t) =
              ThunkySignKeySimpleKES (Vector (SignKeyDSIGN d))
        deriving (forall x.
 SignKeyKES (SimpleKES d t) -> Rep (SignKeyKES (SimpleKES d t)) x)
-> (forall x.
    Rep (SignKeyKES (SimpleKES d t)) x -> SignKeyKES (SimpleKES d t))
-> Generic (SignKeyKES (SimpleKES d t))
forall x.
Rep (SignKeyKES (SimpleKES d t)) x -> SignKeyKES (SimpleKES d t)
forall x.
SignKeyKES (SimpleKES d t) -> Rep (SignKeyKES (SimpleKES d t)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d (t :: Nat) x.
Rep (SignKeyKES (SimpleKES d t)) x -> SignKeyKES (SimpleKES d t)
forall d (t :: Nat) x.
SignKeyKES (SimpleKES d t) -> Rep (SignKeyKES (SimpleKES d t)) x
$cto :: forall d (t :: Nat) x.
Rep (SignKeyKES (SimpleKES d t)) x -> SignKeyKES (SimpleKES d t)
$cfrom :: forall d (t :: Nat) x.
SignKeyKES (SimpleKES d t) -> Rep (SignKeyKES (SimpleKES d t)) x
Generic

    newtype SigKES (SimpleKES d t) =
              SigSimpleKES (SigDSIGN d)
        deriving (forall x.
 SigKES (SimpleKES d t) -> Rep (SigKES (SimpleKES d t)) x)
-> (forall x.
    Rep (SigKES (SimpleKES d t)) x -> SigKES (SimpleKES d t))
-> Generic (SigKES (SimpleKES d t))
forall x. Rep (SigKES (SimpleKES d t)) x -> SigKES (SimpleKES d t)
forall x. SigKES (SimpleKES d t) -> Rep (SigKES (SimpleKES d t)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d (t :: Nat) x.
Rep (SigKES (SimpleKES d t)) x -> SigKES (SimpleKES d t)
forall d (t :: Nat) x.
SigKES (SimpleKES d t) -> Rep (SigKES (SimpleKES d t)) x
$cto :: forall d (t :: Nat) x.
Rep (SigKES (SimpleKES d t)) x -> SigKES (SimpleKES d t)
$cfrom :: forall d (t :: Nat) x.
SigKES (SimpleKES d t) -> Rep (SigKES (SimpleKES d t)) x
Generic


    --
    -- Metadata and basic key operations
    --

    algorithmNameKES :: proxy (SimpleKES d t) -> String
algorithmNameKES proxy (SimpleKES d t)
proxy = String
"simple_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Period -> String
forall a. Show a => a -> String
show (proxy (SimpleKES d t) -> Period
forall v (proxy :: Type -> Type).
KESAlgorithm v =>
proxy v -> Period
totalPeriodsKES proxy (SimpleKES d t)
proxy)

    deriveVerKeyKES :: SignKeyKES (SimpleKES d t) -> VerKeyKES (SimpleKES d t)
deriveVerKeyKES (SignKeySimpleKES Vector (SignKeyDSIGN d)
sks) =
        Vector (VerKeyDSIGN d) -> VerKeyKES (SimpleKES d t)
forall d (t :: Nat).
Vector (VerKeyDSIGN d) -> VerKeyKES (SimpleKES d t)
VerKeySimpleKES ((SignKeyDSIGN d -> VerKeyDSIGN d)
-> Vector (SignKeyDSIGN d) -> Vector (VerKeyDSIGN d)
forall a b. (a -> b) -> Vector a -> Vector b
Vec.map SignKeyDSIGN d -> VerKeyDSIGN d
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN Vector (SignKeyDSIGN d)
sks)


    --
    -- Core algorithm operations
    --

    type ContextKES (SimpleKES d t) = DSIGN.ContextDSIGN d
    type Signable   (SimpleKES d t) = DSIGN.Signable     d

    signKES :: ContextKES (SimpleKES d t)
-> Period
-> a
-> SignKeyKES (SimpleKES d t)
-> SigKES (SimpleKES d t)
signKES ContextKES (SimpleKES d t)
ctxt Period
j a
a (SignKeySimpleKES Vector (SignKeyDSIGN d)
sks) =
        case Vector (SignKeyDSIGN d)
sks Vector (SignKeyDSIGN d) -> Int -> Maybe (SignKeyDSIGN d)
forall a. Vector a -> Int -> Maybe a
!? Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
j of
          Maybe (SignKeyDSIGN d)
Nothing -> String -> SigKES (SimpleKES d t)
forall a. HasCallStack => String -> a
error (String
"SimpleKES.signKES: period out of range " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Period -> String
forall a. Show a => a -> String
show Period
j)
          Just SignKeyDSIGN d
sk -> SigDSIGN d -> SigKES (SimpleKES d t)
forall d (t :: Nat). SigDSIGN d -> SigKES (SimpleKES d t)
SigSimpleKES (ContextDSIGN d -> a -> SignKeyDSIGN d -> SigDSIGN d
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN ContextKES (SimpleKES d t)
ContextDSIGN d
ctxt a
a SignKeyDSIGN d
sk)

    verifyKES :: ContextKES (SimpleKES d t)
-> VerKeyKES (SimpleKES d t)
-> Period
-> a
-> SigKES (SimpleKES d t)
-> Either String ()
verifyKES ContextKES (SimpleKES d t)
ctxt (VerKeySimpleKES Vector (VerKeyDSIGN d)
vks) Period
j a
a (SigSimpleKES sig) =
        case Vector (VerKeyDSIGN d)
vks Vector (VerKeyDSIGN d) -> Int -> Maybe (VerKeyDSIGN d)
forall a. Vector a -> Int -> Maybe a
!? Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
j of
          Maybe (VerKeyDSIGN d)
Nothing -> String -> Either String ()
forall a b. a -> Either a b
Left String
"KES verification failed: out of range"
          Just VerKeyDSIGN d
vk -> ContextDSIGN d
-> VerKeyDSIGN d -> a -> SigDSIGN d -> Either String ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
verifyDSIGN ContextKES (SimpleKES d t)
ContextDSIGN d
ctxt VerKeyDSIGN d
vk a
a SigDSIGN d
sig

    updateKES :: ContextKES (SimpleKES d t)
-> SignKeyKES (SimpleKES d t)
-> Period
-> Maybe (SignKeyKES (SimpleKES d t))
updateKES ContextKES (SimpleKES d t)
_ SignKeyKES (SimpleKES d t)
sk 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
< Natural -> Period
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy t -> Natural
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Natural
natVal (Proxy t
forall k (t :: k). Proxy t
Proxy @t)) = SignKeyKES (SimpleKES d t) -> Maybe (SignKeyKES (SimpleKES d t))
forall a. a -> Maybe a
Just SignKeyKES (SimpleKES d t)
sk
      | Bool
otherwise                               = Maybe (SignKeyKES (SimpleKES d t))
forall a. Maybe a
Nothing

    totalPeriodsKES :: proxy (SimpleKES d t) -> Period
totalPeriodsKES  proxy (SimpleKES d t)
_ = Natural -> Period
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy t -> Natural
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Natural
natVal (Proxy t
forall k (t :: k). Proxy t
Proxy @t))


    --
    -- Key generation
    --

    seedSizeKES :: proxy (SimpleKES d t) -> Period
seedSizeKES proxy (SimpleKES d t)
_ =
        let seedSize :: Period
seedSize = Proxy d -> Period
forall v (proxy :: Type -> Type).
DSIGNAlgorithm v =>
proxy v -> Period
seedSizeDSIGN (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)
            duration :: Period
duration = Natural -> Period
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy t -> Natural
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Natural
natVal (Proxy t
forall k (t :: k). Proxy t
Proxy @t))
         in Period
duration Period -> Period -> Period
forall a. Num a => a -> a -> a
* Period
seedSize

    genKeyKES :: Seed -> SignKeyKES (SimpleKES d t)
genKeyKES Seed
seed =
        let seedSize :: Period
seedSize = Proxy d -> Period
forall v (proxy :: Type -> Type).
DSIGNAlgorithm v =>
proxy v -> Period
seedSizeDSIGN (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)
            duration :: Int
duration = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy t -> Natural
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Natural
natVal (Proxy t
forall k (t :: k). Proxy t
Proxy @t))
            seeds :: [Seed]
seeds    = Int -> [Seed] -> [Seed]
forall a. Int -> [a] -> [a]
take Int
duration
                     ([Seed] -> [Seed])
-> ([ByteString] -> [Seed]) -> [ByteString] -> [Seed]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Seed) -> [ByteString] -> [Seed]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Seed
mkSeedFromBytes
                     ([ByteString] -> [Seed]) -> [ByteString] -> [Seed]
forall a b. (a -> b) -> a -> b
$ (Seed -> Maybe (ByteString, Seed)) -> Seed -> [ByteString]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (Period -> Seed -> Maybe (ByteString, Seed)
getBytesFromSeed Period
seedSize) Seed
seed
            sks :: [SignKeyDSIGN d]
sks      = (Seed -> SignKeyDSIGN d) -> [Seed] -> [SignKeyDSIGN d]
forall a b. (a -> b) -> [a] -> [b]
map Seed -> SignKeyDSIGN d
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN [Seed]
seeds
         in Vector (SignKeyDSIGN d) -> SignKeyKES (SimpleKES d t)
forall d (t :: Nat).
Vector (SignKeyDSIGN d) -> SignKeyKES (SimpleKES d t)
SignKeySimpleKES ([SignKeyDSIGN d] -> Vector (SignKeyDSIGN d)
forall a. [a] -> Vector a
Vec.fromList [SignKeyDSIGN d]
sks)


    --
    -- raw serialise/deserialise
    --

    sizeVerKeyKES :: proxy (SimpleKES d t) -> Period
sizeVerKeyKES  proxy (SimpleKES d t)
_ = Proxy d -> Period
forall v (proxy :: Type -> Type).
DSIGNAlgorithm v =>
proxy v -> Period
sizeVerKeyDSIGN  (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d) Period -> Period -> Period
forall a. Num a => a -> a -> a
* Period
duration
      where
        duration :: Period
duration = Natural -> Period
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy t -> Natural
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Natural
natVal (Proxy t
forall k (t :: k). Proxy t
Proxy @t))

    sizeSignKeyKES :: proxy (SimpleKES d t) -> Period
sizeSignKeyKES proxy (SimpleKES d t)
_ = Proxy d -> Period
forall v (proxy :: Type -> Type).
DSIGNAlgorithm v =>
proxy v -> Period
sizeSignKeyDSIGN (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d) Period -> Period -> Period
forall a. Num a => a -> a -> a
* Period
duration
      where
        duration :: Period
duration = Natural -> Period
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy t -> Natural
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Natural
natVal (Proxy t
forall k (t :: k). Proxy t
Proxy @t))

    sizeSigKES :: proxy (SimpleKES d t) -> Period
sizeSigKES     proxy (SimpleKES d t)
_ = Proxy d -> Period
forall v (proxy :: Type -> Type).
DSIGNAlgorithm v =>
proxy v -> Period
sizeSigDSIGN     (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)

    rawSerialiseVerKeyKES :: VerKeyKES (SimpleKES d t) -> ByteString
rawSerialiseVerKeyKES (VerKeySimpleKES Vector (VerKeyDSIGN d)
vks) =
        [ByteString] -> ByteString
BS.concat [ VerKeyDSIGN d -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN VerKeyDSIGN d
vk | VerKeyDSIGN d
vk <- Vector (VerKeyDSIGN d) -> [VerKeyDSIGN d]
forall a. Vector a -> [a]
Vec.toList Vector (VerKeyDSIGN d)
vks ]

    rawSerialiseSignKeyKES :: SignKeyKES (SimpleKES d t) -> ByteString
rawSerialiseSignKeyKES (SignKeySimpleKES Vector (SignKeyDSIGN d)
sks) =
        [ByteString] -> ByteString
BS.concat [ SignKeyDSIGN d -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
rawSerialiseSignKeyDSIGN SignKeyDSIGN d
sk | SignKeyDSIGN d
sk <- Vector (SignKeyDSIGN d) -> [SignKeyDSIGN d]
forall a. Vector a -> [a]
Vec.toList Vector (SignKeyDSIGN d)
sks ]

    rawSerialiseSigKES :: SigKES (SimpleKES d t) -> ByteString
rawSerialiseSigKES (SigSimpleKES sig) =
        SigDSIGN d -> ByteString
forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN SigDSIGN d
sig

    rawDeserialiseVerKeyKES :: ByteString -> Maybe (VerKeyKES (SimpleKES d t))
rawDeserialiseVerKeyKES ByteString
bs
      | let duration :: Int
duration = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy t -> Natural
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Natural
natVal (Proxy t
forall k (t :: k). Proxy t
Proxy :: Proxy t))
            sizeKey :: Int
sizeKey  = Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy d -> Period
forall v (proxy :: Type -> Type).
DSIGNAlgorithm v =>
proxy v -> Period
sizeVerKeyDSIGN (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d))
      , [ByteString]
vkbs     <- [Int] -> ByteString -> [ByteString]
splitsAt (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
duration Int
sizeKey) ByteString
bs
      , [ByteString] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [ByteString]
vkbs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
duration
      , Just [VerKeyDSIGN d]
vks <- (ByteString -> Maybe (VerKeyDSIGN d))
-> [ByteString] -> Maybe [VerKeyDSIGN d]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> Maybe (VerKeyDSIGN d)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN [ByteString]
vkbs
      = VerKeyKES (SimpleKES d t) -> Maybe (VerKeyKES (SimpleKES d t))
forall a. a -> Maybe a
Just (VerKeyKES (SimpleKES d t) -> Maybe (VerKeyKES (SimpleKES d t)))
-> VerKeyKES (SimpleKES d t) -> Maybe (VerKeyKES (SimpleKES d t))
forall a b. (a -> b) -> a -> b
$! Vector (VerKeyDSIGN d) -> VerKeyKES (SimpleKES d t)
forall d (t :: Nat).
Vector (VerKeyDSIGN d) -> VerKeyKES (SimpleKES d t)
VerKeySimpleKES ([VerKeyDSIGN d] -> Vector (VerKeyDSIGN d)
forall a. [a] -> Vector a
Vec.fromList [VerKeyDSIGN d]
vks)

      | Bool
otherwise
      = Maybe (VerKeyKES (SimpleKES d t))
forall a. Maybe a
Nothing

    rawDeserialiseSignKeyKES :: ByteString -> Maybe (SignKeyKES (SimpleKES d t))
rawDeserialiseSignKeyKES ByteString
bs
      | let duration :: Int
duration = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy t -> Natural
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Natural
natVal (Proxy t
forall k (t :: k). Proxy t
Proxy :: Proxy t))
            sizeKey :: Int
sizeKey  = Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy d -> Period
forall v (proxy :: Type -> Type).
DSIGNAlgorithm v =>
proxy v -> Period
sizeSignKeyDSIGN (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d))
      , [ByteString]
skbs     <- [Int] -> ByteString -> [ByteString]
splitsAt (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
duration Int
sizeKey) ByteString
bs
      , [ByteString] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [ByteString]
skbs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
duration
      , Just [SignKeyDSIGN d]
sks <- (ByteString -> Maybe (SignKeyDSIGN d))
-> [ByteString] -> Maybe [SignKeyDSIGN d]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> Maybe (SignKeyDSIGN d)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN [ByteString]
skbs
      = SignKeyKES (SimpleKES d t) -> Maybe (SignKeyKES (SimpleKES d t))
forall a. a -> Maybe a
Just (SignKeyKES (SimpleKES d t) -> Maybe (SignKeyKES (SimpleKES d t)))
-> SignKeyKES (SimpleKES d t) -> Maybe (SignKeyKES (SimpleKES d t))
forall a b. (a -> b) -> a -> b
$! Vector (SignKeyDSIGN d) -> SignKeyKES (SimpleKES d t)
forall d (t :: Nat).
Vector (SignKeyDSIGN d) -> SignKeyKES (SimpleKES d t)
SignKeySimpleKES ([SignKeyDSIGN d] -> Vector (SignKeyDSIGN d)
forall a. [a] -> Vector a
Vec.fromList [SignKeyDSIGN d]
sks)

      | Bool
otherwise
      = Maybe (SignKeyKES (SimpleKES d t))
forall a. Maybe a
Nothing

    rawDeserialiseSigKES :: ByteString -> Maybe (SigKES (SimpleKES d t))
rawDeserialiseSigKES = (SigDSIGN d -> SigKES (SimpleKES d t))
-> Maybe (SigDSIGN d) -> Maybe (SigKES (SimpleKES d t))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap SigDSIGN d -> SigKES (SimpleKES d t)
forall d (t :: Nat). SigDSIGN d -> SigKES (SimpleKES d t)
SigSimpleKES (Maybe (SigDSIGN d) -> Maybe (SigKES (SimpleKES d t)))
-> (ByteString -> Maybe (SigDSIGN d))
-> ByteString
-> Maybe (SigKES (SimpleKES d t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (SigDSIGN d)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN


deriving instance DSIGNAlgorithm d => Show (VerKeyKES (SimpleKES d t))
deriving instance DSIGNAlgorithm d => Show (SignKeyKES (SimpleKES d t))
deriving instance DSIGNAlgorithm d => Show (SigKES (SimpleKES d t))

deriving instance DSIGNAlgorithm d => Eq   (VerKeyKES (SimpleKES d t))
deriving instance DSIGNAlgorithm d => Eq   (SigKES (SimpleKES d t))

instance DSIGNAlgorithm d => NoThunks (SigKES     (SimpleKES d t))
instance DSIGNAlgorithm d => NoThunks (SignKeyKES (SimpleKES d t))
instance DSIGNAlgorithm d => NoThunks (VerKeyKES  (SimpleKES d t))

instance (DSIGNAlgorithm d, Typeable d, KnownNat t, KnownNat (SeedSizeDSIGN d * t))
      => ToCBOR (VerKeyKES (SimpleKES d t)) where
  toCBOR :: VerKeyKES (SimpleKES d t) -> Encoding
toCBOR = VerKeyKES (SimpleKES d t) -> Encoding
forall v. KESAlgorithm v => VerKeyKES v -> Encoding
encodeVerKeyKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerKeyKES (SimpleKES d t)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (VerKeyKES (SimpleKES d t)) -> Size
forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size
encodedVerKeyKESSizeExpr

instance (DSIGNAlgorithm d, Typeable d, KnownNat t, KnownNat (SeedSizeDSIGN d * t))
      => FromCBOR (VerKeyKES (SimpleKES d t)) where
  fromCBOR :: Decoder s (VerKeyKES (SimpleKES d t))
fromCBOR = Decoder s (VerKeyKES (SimpleKES d t))
forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES


instance (DSIGNAlgorithm d, Typeable d, KnownNat t, KnownNat (SeedSizeDSIGN d * t))
      => ToCBOR (SignKeyKES (SimpleKES d t)) where
  toCBOR :: SignKeyKES (SimpleKES d t) -> Encoding
toCBOR = SignKeyKES (SimpleKES d t) -> Encoding
forall v. KESAlgorithm v => SignKeyKES v -> Encoding
encodeSignKeyKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SignKeyKES (SimpleKES d t)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (SignKeyKES (SimpleKES d t)) -> Size
forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr

instance (DSIGNAlgorithm d, Typeable d, KnownNat t, KnownNat (SeedSizeDSIGN d * t))
      => FromCBOR (SignKeyKES (SimpleKES d t)) where
  fromCBOR :: Decoder s (SignKeyKES (SimpleKES d t))
fromCBOR = Decoder s (SignKeyKES (SimpleKES d t))
forall v s. KESAlgorithm v => Decoder s (SignKeyKES v)
decodeSignKeyKES

instance (DSIGNAlgorithm d, Typeable d, KnownNat t, KnownNat (SeedSizeDSIGN d * t))
      => ToCBOR (SigKES (SimpleKES d t)) where
  toCBOR :: SigKES (SimpleKES d t) -> Encoding
toCBOR = SigKES (SimpleKES d t) -> Encoding
forall v. KESAlgorithm v => SigKES v -> Encoding
encodeSigKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigKES (SimpleKES d t)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (SigKES (SimpleKES d t)) -> Size
forall v. KESAlgorithm v => Proxy (SigKES v) -> Size
encodedSigKESSizeExpr

instance (DSIGNAlgorithm d, Typeable d, KnownNat t, KnownNat (SeedSizeDSIGN d * t))
      => FromCBOR (SigKES (SimpleKES d t)) where
  fromCBOR :: Decoder s (SigKES (SimpleKES d t))
fromCBOR = Decoder s (SigKES (SimpleKES d t))
forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES