{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Mock key evolving signatures.
module Cardano.Crypto.KES.Mock (
  MockKES,
  VerKeyKES (..),
  SignKeyKES (..),
  UnsoundPureSignKeyKES (..),
  SigKES (..),
)
where

import qualified Data.ByteString.Internal as BS
import Data.Proxy (Proxy (..))
import Data.Word (Word64)
import Foreign.Ptr (castPtr)
import GHC.Generics (Generic)
import GHC.TypeNats (KnownNat, Nat, natVal)
import NoThunks.Class (NoThunks)

import Control.Exception (assert)

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

import Cardano.Crypto.DirectSerialise
import Cardano.Crypto.Hash
import Cardano.Crypto.KES.Class
import Cardano.Crypto.Libsodium (
  mlsbToByteString,
 )
import Cardano.Crypto.Libsodium.MLockedSeed
import Cardano.Crypto.Libsodium.Memory (
  ForeignPtr (..),
  mallocForeignPtrBytes,
  unpackByteStringCStringLen,
  withForeignPtr,
 )
import Cardano.Crypto.Seed
import Cardano.Crypto.Util

data MockKES (t :: Nat)

-- | Mock key evolving signatures.
--
-- What is the difference between Mock KES and Simple KES
-- (@Cardano.Crypto.KES.Simple@), you may ask? Simple KES satisfies the outward
-- appearance of a KES scheme through assembling a pre-generated list of keys
-- and iterating through them. Mock KES, on the other hand, pretends to be KES
-- but in fact does no key evolution whatsoever.
--
-- Simple KES is appropriate for testing, since it will for example reject old
-- keys. Mock KES is more suitable for a basic testnet, since it doesn't suffer
-- from the performance implications of shuffling a giant list of keys around
instance KnownNat t => KESAlgorithm (MockKES t) where
  type SeedSizeKES (MockKES t) = 8

  --
  -- Key and signature types
  --

  newtype VerKeyKES (MockKES t) = VerKeyMockKES Word64
    deriving stock (Int -> VerKeyKES (MockKES t) -> ShowS
[VerKeyKES (MockKES t)] -> ShowS
VerKeyKES (MockKES t) -> String
(Int -> VerKeyKES (MockKES t) -> ShowS)
-> (VerKeyKES (MockKES t) -> String)
-> ([VerKeyKES (MockKES t)] -> ShowS)
-> Show (VerKeyKES (MockKES t))
forall (t :: Nat). Int -> VerKeyKES (MockKES t) -> ShowS
forall (t :: Nat). [VerKeyKES (MockKES t)] -> ShowS
forall (t :: Nat). VerKeyKES (MockKES t) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (t :: Nat). Int -> VerKeyKES (MockKES t) -> ShowS
showsPrec :: Int -> VerKeyKES (MockKES t) -> ShowS
$cshow :: forall (t :: Nat). VerKeyKES (MockKES t) -> String
show :: VerKeyKES (MockKES t) -> String
$cshowList :: forall (t :: Nat). [VerKeyKES (MockKES t)] -> ShowS
showList :: [VerKeyKES (MockKES t)] -> ShowS
Show, VerKeyKES (MockKES t) -> VerKeyKES (MockKES t) -> Bool
(VerKeyKES (MockKES t) -> VerKeyKES (MockKES t) -> Bool)
-> (VerKeyKES (MockKES t) -> VerKeyKES (MockKES t) -> Bool)
-> Eq (VerKeyKES (MockKES t))
forall (t :: Nat).
VerKeyKES (MockKES t) -> VerKeyKES (MockKES t) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (t :: Nat).
VerKeyKES (MockKES t) -> VerKeyKES (MockKES t) -> Bool
== :: VerKeyKES (MockKES t) -> VerKeyKES (MockKES t) -> Bool
$c/= :: forall (t :: Nat).
VerKeyKES (MockKES t) -> VerKeyKES (MockKES t) -> Bool
/= :: VerKeyKES (MockKES t) -> VerKeyKES (MockKES t) -> Bool
Eq, (forall x. VerKeyKES (MockKES t) -> Rep (VerKeyKES (MockKES t)) x)
-> (forall x.
    Rep (VerKeyKES (MockKES t)) x -> VerKeyKES (MockKES t))
-> Generic (VerKeyKES (MockKES t))
forall (t :: Nat) x.
Rep (VerKeyKES (MockKES t)) x -> VerKeyKES (MockKES t)
forall (t :: Nat) x.
VerKeyKES (MockKES t) -> Rep (VerKeyKES (MockKES t)) x
forall x. Rep (VerKeyKES (MockKES t)) x -> VerKeyKES (MockKES t)
forall x. VerKeyKES (MockKES t) -> Rep (VerKeyKES (MockKES t)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (t :: Nat) x.
VerKeyKES (MockKES t) -> Rep (VerKeyKES (MockKES t)) x
from :: forall x. VerKeyKES (MockKES t) -> Rep (VerKeyKES (MockKES t)) x
$cto :: forall (t :: Nat) x.
Rep (VerKeyKES (MockKES t)) x -> VerKeyKES (MockKES t)
to :: forall x. Rep (VerKeyKES (MockKES t)) x -> VerKeyKES (MockKES t)
Generic)
    deriving newtype (Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
Proxy (VerKeyKES (MockKES t)) -> String
(Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo))
-> (Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo))
-> (Proxy (VerKeyKES (MockKES t)) -> String)
-> NoThunks (VerKeyKES (MockKES t))
forall (t :: Nat).
Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
forall (t :: Nat). Proxy (VerKeyKES (MockKES t)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall (t :: Nat).
Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
noThunks :: Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (t :: Nat).
Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (t :: Nat). Proxy (VerKeyKES (MockKES t)) -> String
showTypeOf :: Proxy (VerKeyKES (MockKES t)) -> String
NoThunks)

  data SigKES (MockKES t)
    = SigMockKES !(Hash ShortHash ()) !(SignKeyKES (MockKES t))
    deriving stock (Int -> SigKES (MockKES t) -> ShowS
[SigKES (MockKES t)] -> ShowS
SigKES (MockKES t) -> String
(Int -> SigKES (MockKES t) -> ShowS)
-> (SigKES (MockKES t) -> String)
-> ([SigKES (MockKES t)] -> ShowS)
-> Show (SigKES (MockKES t))
forall (t :: Nat). Int -> SigKES (MockKES t) -> ShowS
forall (t :: Nat). [SigKES (MockKES t)] -> ShowS
forall (t :: Nat). SigKES (MockKES t) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (t :: Nat). Int -> SigKES (MockKES t) -> ShowS
showsPrec :: Int -> SigKES (MockKES t) -> ShowS
$cshow :: forall (t :: Nat). SigKES (MockKES t) -> String
show :: SigKES (MockKES t) -> String
$cshowList :: forall (t :: Nat). [SigKES (MockKES t)] -> ShowS
showList :: [SigKES (MockKES t)] -> ShowS
Show, SigKES (MockKES t) -> SigKES (MockKES t) -> Bool
(SigKES (MockKES t) -> SigKES (MockKES t) -> Bool)
-> (SigKES (MockKES t) -> SigKES (MockKES t) -> Bool)
-> Eq (SigKES (MockKES t))
forall (t :: Nat). SigKES (MockKES t) -> SigKES (MockKES t) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (t :: Nat). SigKES (MockKES t) -> SigKES (MockKES t) -> Bool
== :: SigKES (MockKES t) -> SigKES (MockKES t) -> Bool
$c/= :: forall (t :: Nat). SigKES (MockKES t) -> SigKES (MockKES t) -> Bool
/= :: SigKES (MockKES t) -> SigKES (MockKES t) -> Bool
Eq, (forall x. SigKES (MockKES t) -> Rep (SigKES (MockKES t)) x)
-> (forall x. Rep (SigKES (MockKES t)) x -> SigKES (MockKES t))
-> Generic (SigKES (MockKES t))
forall (t :: Nat) x.
Rep (SigKES (MockKES t)) x -> SigKES (MockKES t)
forall (t :: Nat) x.
SigKES (MockKES t) -> Rep (SigKES (MockKES t)) x
forall x. Rep (SigKES (MockKES t)) x -> SigKES (MockKES t)
forall x. SigKES (MockKES t) -> Rep (SigKES (MockKES t)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (t :: Nat) x.
SigKES (MockKES t) -> Rep (SigKES (MockKES t)) x
from :: forall x. SigKES (MockKES t) -> Rep (SigKES (MockKES t)) x
$cto :: forall (t :: Nat) x.
Rep (SigKES (MockKES t)) x -> SigKES (MockKES t)
to :: forall x. Rep (SigKES (MockKES t)) x -> SigKES (MockKES t)
Generic)
    deriving anyclass (Context -> SigKES (MockKES t) -> IO (Maybe ThunkInfo)
Proxy (SigKES (MockKES t)) -> String
(Context -> SigKES (MockKES t) -> IO (Maybe ThunkInfo))
-> (Context -> SigKES (MockKES t) -> IO (Maybe ThunkInfo))
-> (Proxy (SigKES (MockKES t)) -> String)
-> NoThunks (SigKES (MockKES t))
forall (t :: Nat).
Context -> SigKES (MockKES t) -> IO (Maybe ThunkInfo)
forall (t :: Nat). Proxy (SigKES (MockKES t)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall (t :: Nat).
Context -> SigKES (MockKES t) -> IO (Maybe ThunkInfo)
noThunks :: Context -> SigKES (MockKES t) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (t :: Nat).
Context -> SigKES (MockKES t) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SigKES (MockKES t) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (t :: Nat). Proxy (SigKES (MockKES t)) -> String
showTypeOf :: Proxy (SigKES (MockKES t)) -> String
NoThunks)

  data SignKeyKES (MockKES t)
    = SignKeyMockKES !(VerKeyKES (MockKES t)) !Period
    deriving stock (Int -> SignKeyKES (MockKES t) -> ShowS
[SignKeyKES (MockKES t)] -> ShowS
SignKeyKES (MockKES t) -> String
(Int -> SignKeyKES (MockKES t) -> ShowS)
-> (SignKeyKES (MockKES t) -> String)
-> ([SignKeyKES (MockKES t)] -> ShowS)
-> Show (SignKeyKES (MockKES t))
forall (t :: Nat). Int -> SignKeyKES (MockKES t) -> ShowS
forall (t :: Nat). [SignKeyKES (MockKES t)] -> ShowS
forall (t :: Nat). SignKeyKES (MockKES t) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (t :: Nat). Int -> SignKeyKES (MockKES t) -> ShowS
showsPrec :: Int -> SignKeyKES (MockKES t) -> ShowS
$cshow :: forall (t :: Nat). SignKeyKES (MockKES t) -> String
show :: SignKeyKES (MockKES t) -> String
$cshowList :: forall (t :: Nat). [SignKeyKES (MockKES t)] -> ShowS
showList :: [SignKeyKES (MockKES t)] -> ShowS
Show, SignKeyKES (MockKES t) -> SignKeyKES (MockKES t) -> Bool
(SignKeyKES (MockKES t) -> SignKeyKES (MockKES t) -> Bool)
-> (SignKeyKES (MockKES t) -> SignKeyKES (MockKES t) -> Bool)
-> Eq (SignKeyKES (MockKES t))
forall (t :: Nat).
SignKeyKES (MockKES t) -> SignKeyKES (MockKES t) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (t :: Nat).
SignKeyKES (MockKES t) -> SignKeyKES (MockKES t) -> Bool
== :: SignKeyKES (MockKES t) -> SignKeyKES (MockKES t) -> Bool
$c/= :: forall (t :: Nat).
SignKeyKES (MockKES t) -> SignKeyKES (MockKES t) -> Bool
/= :: SignKeyKES (MockKES t) -> SignKeyKES (MockKES t) -> Bool
Eq, (forall x.
 SignKeyKES (MockKES t) -> Rep (SignKeyKES (MockKES t)) x)
-> (forall x.
    Rep (SignKeyKES (MockKES t)) x -> SignKeyKES (MockKES t))
-> Generic (SignKeyKES (MockKES t))
forall (t :: Nat) x.
Rep (SignKeyKES (MockKES t)) x -> SignKeyKES (MockKES t)
forall (t :: Nat) x.
SignKeyKES (MockKES t) -> Rep (SignKeyKES (MockKES t)) x
forall x. Rep (SignKeyKES (MockKES t)) x -> SignKeyKES (MockKES t)
forall x. SignKeyKES (MockKES t) -> Rep (SignKeyKES (MockKES t)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (t :: Nat) x.
SignKeyKES (MockKES t) -> Rep (SignKeyKES (MockKES t)) x
from :: forall x. SignKeyKES (MockKES t) -> Rep (SignKeyKES (MockKES t)) x
$cto :: forall (t :: Nat) x.
Rep (SignKeyKES (MockKES t)) x -> SignKeyKES (MockKES t)
to :: forall x. Rep (SignKeyKES (MockKES t)) x -> SignKeyKES (MockKES t)
Generic)
    deriving anyclass (Context -> SignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
Proxy (SignKeyKES (MockKES t)) -> String
(Context -> SignKeyKES (MockKES t) -> IO (Maybe ThunkInfo))
-> (Context -> SignKeyKES (MockKES t) -> IO (Maybe ThunkInfo))
-> (Proxy (SignKeyKES (MockKES t)) -> String)
-> NoThunks (SignKeyKES (MockKES t))
forall (t :: Nat).
Context -> SignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
forall (t :: Nat). Proxy (SignKeyKES (MockKES t)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall (t :: Nat).
Context -> SignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
noThunks :: Context -> SignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (t :: Nat).
Context -> SignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (t :: Nat). Proxy (SignKeyKES (MockKES t)) -> String
showTypeOf :: Proxy (SignKeyKES (MockKES t)) -> String
NoThunks)

  --
  -- Metadata and basic key operations
  --

  algorithmNameKES :: forall (proxy :: * -> *). proxy (MockKES t) -> String
algorithmNameKES proxy (MockKES t)
proxy = String
"mock_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Period -> String
forall a. Show a => a -> String
show (proxy (MockKES t) -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
forall (proxy :: * -> *). proxy (MockKES t) -> Period
totalPeriodsKES proxy (MockKES t)
proxy)

  type SizeVerKeyKES (MockKES t) = 8
  type SizeSignKeyKES (MockKES t) = 16
  type SizeSigKES (MockKES t) = 24

  --
  -- Core algorithm operations
  --

  type Signable (MockKES t) = SignableRepresentation

  verifyKES :: forall a.
(Signable (MockKES t) a, HasCallStack) =>
ContextKES (MockKES t)
-> VerKeyKES (MockKES t)
-> Period
-> a
-> SigKES (MockKES t)
-> Either String ()
verifyKES () VerKeyKES (MockKES t)
vk Period
t a
a (SigMockKES Hash ShortHash ()
h (SignKeyMockKES VerKeyKES (MockKES t)
vk' Period
t'))
    | VerKeyKES (MockKES t)
vk VerKeyKES (MockKES t) -> VerKeyKES (MockKES t) -> Bool
forall a. Eq a => a -> a -> Bool
/= VerKeyKES (MockKES t)
vk' =
        String -> Either String ()
forall a b. a -> Either a b
Left String
"KES verification failed"
    | Period
t' Period -> Period -> Bool
forall a. Eq a => a -> a -> Bool
== Period
t
    , Hash ShortHash a -> Hash ShortHash ()
forall h a b. Hash h a -> Hash h b
castHash ((a -> ByteString) -> a -> Hash ShortHash a
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith a -> ByteString
forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a) Hash ShortHash () -> Hash ShortHash () -> Bool
forall a. Eq a => a -> a -> Bool
== Hash ShortHash ()
h =
        () -> Either String ()
forall a b. b -> Either a b
Right ()
    | Bool
otherwise =
        String -> Either String ()
forall a b. a -> Either a b
Left String
"KES verification failed"

  totalPeriodsKES :: forall (proxy :: * -> *). proxy (MockKES t) -> Period
totalPeriodsKES proxy (MockKES t)
_ = Nat -> Period
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy t -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @t))

  --
  -- raw serialise/deserialise
  --

  rawSerialiseVerKeyKES :: VerKeyKES (MockKES t) -> ByteString
rawSerialiseVerKeyKES (VerKeyMockKES Word64
vk) =
    Word64 -> ByteString
writeBinaryWord64 Word64
vk

  rawSerialiseSigKES :: SigKES (MockKES t) -> ByteString
rawSerialiseSigKES (SigMockKES Hash ShortHash ()
h SignKeyKES (MockKES t)
sk) =
    Hash ShortHash () -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash ShortHash ()
h
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SignKeyKES (MockKES t) -> ByteString
forall (t :: Nat).
KnownNat t =>
SignKeyKES (MockKES t) -> ByteString
rawSerialiseSignKeyMockKES SignKeyKES (MockKES t)
sk

  rawDeserialiseVerKeyKES :: ByteString -> Maybe (VerKeyKES (MockKES t))
rawDeserialiseVerKeyKES ByteString
bs
    | [ByteString
vkb] <- [Int] -> ByteString -> [ByteString]
splitsAt [Int
8] ByteString
bs
    , let vk :: Word64
vk = ByteString -> Word64
readBinaryWord64 ByteString
vkb =
        VerKeyKES (MockKES t) -> Maybe (VerKeyKES (MockKES t))
forall a. a -> Maybe a
Just (VerKeyKES (MockKES t) -> Maybe (VerKeyKES (MockKES t)))
-> VerKeyKES (MockKES t) -> Maybe (VerKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$! Word64 -> VerKeyKES (MockKES t)
forall (t :: Nat). Word64 -> VerKeyKES (MockKES t)
VerKeyMockKES Word64
vk
    | Bool
otherwise =
        Maybe (VerKeyKES (MockKES t))
forall a. Maybe a
Nothing

  rawDeserialiseSigKES :: ByteString -> Maybe (SigKES (MockKES t))
rawDeserialiseSigKES ByteString
bs
    | [ByteString
hb, ByteString
skb] <- [Int] -> ByteString -> [ByteString]
splitsAt [Int
8, Int
16] ByteString
bs
    , Just Hash ShortHash ()
h <- ByteString -> Maybe (Hash ShortHash ())
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
hb
    , Just SignKeyKES (MockKES t)
sk <- ByteString -> Maybe (SignKeyKES (MockKES t))
forall (t :: Nat).
KnownNat t =>
ByteString -> Maybe (SignKeyKES (MockKES t))
rawDeserialiseSignKeyMockKES ByteString
skb =
        SigKES (MockKES t) -> Maybe (SigKES (MockKES t))
forall a. a -> Maybe a
Just (SigKES (MockKES t) -> Maybe (SigKES (MockKES t)))
-> SigKES (MockKES t) -> Maybe (SigKES (MockKES t))
forall a b. (a -> b) -> a -> b
$! Hash ShortHash () -> SignKeyKES (MockKES t) -> SigKES (MockKES t)
forall (t :: Nat).
Hash ShortHash () -> SignKeyKES (MockKES t) -> SigKES (MockKES t)
SigMockKES Hash ShortHash ()
h SignKeyKES (MockKES t)
sk
    | Bool
otherwise =
        Maybe (SigKES (MockKES t))
forall a. Maybe a
Nothing

  deriveVerKeyKES :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
SignKeyKES (MockKES t) -> m (VerKeyKES (MockKES t))
deriveVerKeyKES (SignKeyMockKES VerKeyKES (MockKES t)
vk Period
_) = VerKeyKES (MockKES t) -> m (VerKeyKES (MockKES t))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerKeyKES (MockKES t) -> m (VerKeyKES (MockKES t)))
-> VerKeyKES (MockKES t) -> m (VerKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$! VerKeyKES (MockKES t)
vk

  updateKESWith :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ContextKES (MockKES t)
-> SignKeyKES (MockKES t)
-> Period
-> m (Maybe (SignKeyKES (MockKES t)))
updateKESWith MLockedAllocator m
_allocator () (SignKeyMockKES VerKeyKES (MockKES t)
vk Period
t') Period
t =
    Bool
-> m (Maybe (SignKeyKES (MockKES t)))
-> m (Maybe (SignKeyKES (MockKES t)))
forall a. HasCallStack => Bool -> a -> a
assert (Period
t Period -> Period -> Bool
forall a. Eq a => a -> a -> Bool
== Period
t') (m (Maybe (SignKeyKES (MockKES t)))
 -> m (Maybe (SignKeyKES (MockKES t))))
-> m (Maybe (SignKeyKES (MockKES t)))
-> m (Maybe (SignKeyKES (MockKES t)))
forall a b. (a -> b) -> a -> b
$!
      if Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Period
1 Period -> Period -> Bool
forall a. Ord a => a -> a -> Bool
< Proxy (MockKES t) -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
forall (proxy :: * -> *). proxy (MockKES t) -> Period
totalPeriodsKES (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(MockKES t))
        then Maybe (SignKeyKES (MockKES t))
-> m (Maybe (SignKeyKES (MockKES t)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SignKeyKES (MockKES t))
 -> m (Maybe (SignKeyKES (MockKES t))))
-> Maybe (SignKeyKES (MockKES t))
-> m (Maybe (SignKeyKES (MockKES t)))
forall a b. (a -> b) -> a -> b
$! SignKeyKES (MockKES t) -> Maybe (SignKeyKES (MockKES t))
forall a. a -> Maybe a
Just (SignKeyKES (MockKES t) -> Maybe (SignKeyKES (MockKES t)))
-> SignKeyKES (MockKES t) -> Maybe (SignKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$! VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
forall (t :: Nat).
VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
SignKeyMockKES VerKeyKES (MockKES t)
vk (Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Period
1)
        else Maybe (SignKeyKES (MockKES t))
-> m (Maybe (SignKeyKES (MockKES t)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SignKeyKES (MockKES t))
forall a. Maybe a
Nothing

  -- \| Produce valid signature only with correct key, i.e., same iteration and
  -- allowed KES period.
  signKES :: forall a (m :: * -> *).
(Signable (MockKES t) a, MonadST m, MonadThrow m) =>
ContextKES (MockKES t)
-> Period -> a -> SignKeyKES (MockKES t) -> m (SigKES (MockKES t))
signKES () Period
t a
a (SignKeyMockKES VerKeyKES (MockKES t)
vk Period
t') =
    Bool -> m (SigKES (MockKES t)) -> m (SigKES (MockKES t))
forall a. HasCallStack => Bool -> a -> a
assert (Period
t Period -> Period -> Bool
forall a. Eq a => a -> a -> Bool
== Period
t') (m (SigKES (MockKES t)) -> m (SigKES (MockKES t)))
-> m (SigKES (MockKES t)) -> m (SigKES (MockKES t))
forall a b. (a -> b) -> a -> b
$!
      SigKES (MockKES t) -> m (SigKES (MockKES t))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SigKES (MockKES t) -> m (SigKES (MockKES t)))
-> SigKES (MockKES t) -> m (SigKES (MockKES t))
forall a b. (a -> b) -> a -> b
$!
        Hash ShortHash () -> SignKeyKES (MockKES t) -> SigKES (MockKES t)
forall (t :: Nat).
Hash ShortHash () -> SignKeyKES (MockKES t) -> SigKES (MockKES t)
SigMockKES
          (Hash ShortHash a -> Hash ShortHash ()
forall h a b. Hash h a -> Hash h b
castHash ((a -> ByteString) -> a -> Hash ShortHash a
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith a -> ByteString
forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a))
          (VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
forall (t :: Nat).
VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
SignKeyMockKES VerKeyKES (MockKES t)
vk Period
t)

  --
  -- Key generation
  --

  genKeyKESWith :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES (MockKES t))
-> m (SignKeyKES (MockKES t))
genKeyKESWith MLockedAllocator m
_allocator MLockedSeed (SeedSizeKES (MockKES t))
seed = do
    ByteString
seedBS <- MLockedSizedBytes 8 -> m ByteString
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString (MLockedSizedBytes 8 -> m ByteString)
-> MLockedSizedBytes 8 -> m ByteString
forall a b. (a -> b) -> a -> b
$ MLockedSeed 8 -> MLockedSizedBytes 8
forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB MLockedSeed 8
MLockedSeed (SeedSizeKES (MockKES t))
seed
    let vk :: VerKeyKES (MockKES t)
vk = Word64 -> VerKeyKES (MockKES t)
forall (t :: Nat). Word64 -> VerKeyKES (MockKES t)
VerKeyMockKES (Seed -> (forall (m :: * -> *). MonadRandom m => m Word64) -> Word64
forall a. Seed -> (forall (m :: * -> *). MonadRandom m => m a) -> a
runMonadRandomWithSeed (ByteString -> Seed
mkSeedFromBytes ByteString
seedBS) m Word64
forall (m :: * -> *). MonadRandom m => m Word64
getRandomWord64)
    SignKeyKES (MockKES t) -> m (SignKeyKES (MockKES t))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SignKeyKES (MockKES t) -> m (SignKeyKES (MockKES t)))
-> SignKeyKES (MockKES t) -> m (SignKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$! VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
forall (t :: Nat).
VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
SignKeyMockKES VerKeyKES (MockKES t)
vk Period
0

  forgetSignKeyKESWith :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyKES (MockKES t) -> m ()
forgetSignKeyKESWith MLockedAllocator m
_ = m () -> SignKeyKES (MockKES t) -> m ()
forall a b. a -> b -> a
const (m () -> SignKeyKES (MockKES t) -> m ())
-> m () -> SignKeyKES (MockKES t) -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance KnownNat t => UnsoundPureKESAlgorithm (MockKES t) where
  --
  -- Key and signature types
  --

  data UnsoundPureSignKeyKES (MockKES t)
    = UnsoundPureSignKeyMockKES !(VerKeyKES (MockKES t)) !Period
    deriving stock (Int -> UnsoundPureSignKeyKES (MockKES t) -> ShowS
[UnsoundPureSignKeyKES (MockKES t)] -> ShowS
UnsoundPureSignKeyKES (MockKES t) -> String
(Int -> UnsoundPureSignKeyKES (MockKES t) -> ShowS)
-> (UnsoundPureSignKeyKES (MockKES t) -> String)
-> ([UnsoundPureSignKeyKES (MockKES t)] -> ShowS)
-> Show (UnsoundPureSignKeyKES (MockKES t))
forall (t :: Nat).
Int -> UnsoundPureSignKeyKES (MockKES t) -> ShowS
forall (t :: Nat). [UnsoundPureSignKeyKES (MockKES t)] -> ShowS
forall (t :: Nat). UnsoundPureSignKeyKES (MockKES t) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (t :: Nat).
Int -> UnsoundPureSignKeyKES (MockKES t) -> ShowS
showsPrec :: Int -> UnsoundPureSignKeyKES (MockKES t) -> ShowS
$cshow :: forall (t :: Nat). UnsoundPureSignKeyKES (MockKES t) -> String
show :: UnsoundPureSignKeyKES (MockKES t) -> String
$cshowList :: forall (t :: Nat). [UnsoundPureSignKeyKES (MockKES t)] -> ShowS
showList :: [UnsoundPureSignKeyKES (MockKES t)] -> ShowS
Show, UnsoundPureSignKeyKES (MockKES t)
-> UnsoundPureSignKeyKES (MockKES t) -> Bool
(UnsoundPureSignKeyKES (MockKES t)
 -> UnsoundPureSignKeyKES (MockKES t) -> Bool)
-> (UnsoundPureSignKeyKES (MockKES t)
    -> UnsoundPureSignKeyKES (MockKES t) -> Bool)
-> Eq (UnsoundPureSignKeyKES (MockKES t))
forall (t :: Nat).
UnsoundPureSignKeyKES (MockKES t)
-> UnsoundPureSignKeyKES (MockKES t) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (t :: Nat).
UnsoundPureSignKeyKES (MockKES t)
-> UnsoundPureSignKeyKES (MockKES t) -> Bool
== :: UnsoundPureSignKeyKES (MockKES t)
-> UnsoundPureSignKeyKES (MockKES t) -> Bool
$c/= :: forall (t :: Nat).
UnsoundPureSignKeyKES (MockKES t)
-> UnsoundPureSignKeyKES (MockKES t) -> Bool
/= :: UnsoundPureSignKeyKES (MockKES t)
-> UnsoundPureSignKeyKES (MockKES t) -> Bool
Eq, (forall x.
 UnsoundPureSignKeyKES (MockKES t)
 -> Rep (UnsoundPureSignKeyKES (MockKES t)) x)
-> (forall x.
    Rep (UnsoundPureSignKeyKES (MockKES t)) x
    -> UnsoundPureSignKeyKES (MockKES t))
-> Generic (UnsoundPureSignKeyKES (MockKES t))
forall (t :: Nat) x.
Rep (UnsoundPureSignKeyKES (MockKES t)) x
-> UnsoundPureSignKeyKES (MockKES t)
forall (t :: Nat) x.
UnsoundPureSignKeyKES (MockKES t)
-> Rep (UnsoundPureSignKeyKES (MockKES t)) x
forall x.
Rep (UnsoundPureSignKeyKES (MockKES t)) x
-> UnsoundPureSignKeyKES (MockKES t)
forall x.
UnsoundPureSignKeyKES (MockKES t)
-> Rep (UnsoundPureSignKeyKES (MockKES t)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (t :: Nat) x.
UnsoundPureSignKeyKES (MockKES t)
-> Rep (UnsoundPureSignKeyKES (MockKES t)) x
from :: forall x.
UnsoundPureSignKeyKES (MockKES t)
-> Rep (UnsoundPureSignKeyKES (MockKES t)) x
$cto :: forall (t :: Nat) x.
Rep (UnsoundPureSignKeyKES (MockKES t)) x
-> UnsoundPureSignKeyKES (MockKES t)
to :: forall x.
Rep (UnsoundPureSignKeyKES (MockKES t)) x
-> UnsoundPureSignKeyKES (MockKES t)
Generic)
    deriving anyclass (Context
-> UnsoundPureSignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
Proxy (UnsoundPureSignKeyKES (MockKES t)) -> String
(Context
 -> UnsoundPureSignKeyKES (MockKES t) -> IO (Maybe ThunkInfo))
-> (Context
    -> UnsoundPureSignKeyKES (MockKES t) -> IO (Maybe ThunkInfo))
-> (Proxy (UnsoundPureSignKeyKES (MockKES t)) -> String)
-> NoThunks (UnsoundPureSignKeyKES (MockKES t))
forall (t :: Nat).
Context
-> UnsoundPureSignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
forall (t :: Nat).
Proxy (UnsoundPureSignKeyKES (MockKES t)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall (t :: Nat).
Context
-> UnsoundPureSignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> UnsoundPureSignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (t :: Nat).
Context
-> UnsoundPureSignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> UnsoundPureSignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (t :: Nat).
Proxy (UnsoundPureSignKeyKES (MockKES t)) -> String
showTypeOf :: Proxy (UnsoundPureSignKeyKES (MockKES t)) -> String
NoThunks)

  unsoundPureDeriveVerKeyKES :: UnsoundPureSignKeyKES (MockKES t) -> VerKeyKES (MockKES t)
unsoundPureDeriveVerKeyKES (UnsoundPureSignKeyMockKES VerKeyKES (MockKES t)
vk Period
_) = VerKeyKES (MockKES t)
vk

  unsoundPureUpdateKES :: ContextKES (MockKES t)
-> UnsoundPureSignKeyKES (MockKES t)
-> Period
-> Maybe (UnsoundPureSignKeyKES (MockKES t))
unsoundPureUpdateKES () (UnsoundPureSignKeyMockKES VerKeyKES (MockKES t)
vk Period
t') Period
t =
    Bool
-> Maybe (UnsoundPureSignKeyKES (MockKES t))
-> Maybe (UnsoundPureSignKeyKES (MockKES t))
forall a. HasCallStack => Bool -> a -> a
assert (Period
t Period -> Period -> Bool
forall a. Eq a => a -> a -> Bool
== Period
t') (Maybe (UnsoundPureSignKeyKES (MockKES t))
 -> Maybe (UnsoundPureSignKeyKES (MockKES t)))
-> Maybe (UnsoundPureSignKeyKES (MockKES t))
-> Maybe (UnsoundPureSignKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$!
      if Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Period
1 Period -> Period -> Bool
forall a. Ord a => a -> a -> Bool
< Proxy (MockKES t) -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
forall (proxy :: * -> *). proxy (MockKES t) -> Period
totalPeriodsKES (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(MockKES t))
        then UnsoundPureSignKeyKES (MockKES t)
-> Maybe (UnsoundPureSignKeyKES (MockKES t))
forall a. a -> Maybe a
Just (UnsoundPureSignKeyKES (MockKES t)
 -> Maybe (UnsoundPureSignKeyKES (MockKES t)))
-> UnsoundPureSignKeyKES (MockKES t)
-> Maybe (UnsoundPureSignKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$! VerKeyKES (MockKES t)
-> Period -> UnsoundPureSignKeyKES (MockKES t)
forall (t :: Nat).
VerKeyKES (MockKES t)
-> Period -> UnsoundPureSignKeyKES (MockKES t)
UnsoundPureSignKeyMockKES VerKeyKES (MockKES t)
vk (Period
t Period -> Period -> Period
forall a. Num a => a -> a -> a
+ Period
1)
        else Maybe (UnsoundPureSignKeyKES (MockKES t))
forall a. Maybe a
Nothing

  -- \| Produce valid signature only with correct key, i.e., same iteration and
  -- allowed KES period.
  unsoundPureSignKES :: forall a.
Signable (MockKES t) a =>
ContextKES (MockKES t)
-> Period
-> a
-> UnsoundPureSignKeyKES (MockKES t)
-> SigKES (MockKES t)
unsoundPureSignKES () Period
t a
a (UnsoundPureSignKeyMockKES VerKeyKES (MockKES t)
vk Period
t') =
    Bool -> SigKES (MockKES t) -> SigKES (MockKES t)
forall a. HasCallStack => Bool -> a -> a
assert (Period
t Period -> Period -> Bool
forall a. Eq a => a -> a -> Bool
== Period
t') (SigKES (MockKES t) -> SigKES (MockKES t))
-> SigKES (MockKES t) -> SigKES (MockKES t)
forall a b. (a -> b) -> a -> b
$!
      Hash ShortHash () -> SignKeyKES (MockKES t) -> SigKES (MockKES t)
forall (t :: Nat).
Hash ShortHash () -> SignKeyKES (MockKES t) -> SigKES (MockKES t)
SigMockKES
        (Hash ShortHash a -> Hash ShortHash ()
forall h a b. Hash h a -> Hash h b
castHash ((a -> ByteString) -> a -> Hash ShortHash a
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith a -> ByteString
forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a))
        (VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
forall (t :: Nat).
VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
SignKeyMockKES VerKeyKES (MockKES t)
vk Period
t)

  --
  -- Key generation
  --

  unsoundPureGenKeyKES :: Seed -> UnsoundPureSignKeyKES (MockKES t)
unsoundPureGenKeyKES Seed
seed =
    let vk :: VerKeyKES (MockKES t)
vk = Word64 -> VerKeyKES (MockKES t)
forall (t :: Nat). Word64 -> VerKeyKES (MockKES t)
VerKeyMockKES (Seed -> (forall (m :: * -> *). MonadRandom m => m Word64) -> Word64
forall a. Seed -> (forall (m :: * -> *). MonadRandom m => m a) -> a
runMonadRandomWithSeed Seed
seed m Word64
forall (m :: * -> *). MonadRandom m => m Word64
getRandomWord64)
     in VerKeyKES (MockKES t)
-> Period -> UnsoundPureSignKeyKES (MockKES t)
forall (t :: Nat).
VerKeyKES (MockKES t)
-> Period -> UnsoundPureSignKeyKES (MockKES t)
UnsoundPureSignKeyMockKES VerKeyKES (MockKES t)
vk Period
0

  unsoundPureSignKeyKESToSoundSignKeyKES :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
UnsoundPureSignKeyKES (MockKES t) -> m (SignKeyKES (MockKES t))
unsoundPureSignKeyKESToSoundSignKeyKES (UnsoundPureSignKeyMockKES VerKeyKES (MockKES t)
vk Period
t) =
    SignKeyKES (MockKES t) -> m (SignKeyKES (MockKES t))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SignKeyKES (MockKES t) -> m (SignKeyKES (MockKES t)))
-> SignKeyKES (MockKES t) -> m (SignKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$ VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
forall (t :: Nat).
VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
SignKeyMockKES VerKeyKES (MockKES t)
vk Period
t

  rawSerialiseUnsoundPureSignKeyKES :: UnsoundPureSignKeyKES (MockKES t) -> ByteString
rawSerialiseUnsoundPureSignKeyKES (UnsoundPureSignKeyMockKES VerKeyKES (MockKES t)
vk Period
t) =
    SignKeyKES (MockKES t) -> ByteString
forall (t :: Nat).
KnownNat t =>
SignKeyKES (MockKES t) -> ByteString
rawSerialiseSignKeyMockKES (VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
forall (t :: Nat).
VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
SignKeyMockKES VerKeyKES (MockKES t)
vk Period
t)

  rawDeserialiseUnsoundPureSignKeyKES :: ByteString -> Maybe (UnsoundPureSignKeyKES (MockKES t))
rawDeserialiseUnsoundPureSignKeyKES ByteString
bs = do
    SignKeyMockKES VerKeyKES (MockKES t)
vt Period
t <- ByteString -> Maybe (SignKeyKES (MockKES t))
forall (t :: Nat).
KnownNat t =>
ByteString -> Maybe (SignKeyKES (MockKES t))
rawDeserialiseSignKeyMockKES ByteString
bs
    UnsoundPureSignKeyKES (MockKES t)
-> Maybe (UnsoundPureSignKeyKES (MockKES t))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnsoundPureSignKeyKES (MockKES t)
 -> Maybe (UnsoundPureSignKeyKES (MockKES t)))
-> UnsoundPureSignKeyKES (MockKES t)
-> Maybe (UnsoundPureSignKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$ VerKeyKES (MockKES t)
-> Period -> UnsoundPureSignKeyKES (MockKES t)
forall (t :: Nat).
VerKeyKES (MockKES t)
-> Period -> UnsoundPureSignKeyKES (MockKES t)
UnsoundPureSignKeyMockKES VerKeyKES (MockKES t)
vt Period
t

instance KnownNat t => UnsoundKESAlgorithm (MockKES t) where
  rawSerialiseSignKeyKES :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
SignKeyKES (MockKES t) -> m ByteString
rawSerialiseSignKeyKES SignKeyKES (MockKES t)
sk =
    ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ SignKeyKES (MockKES t) -> ByteString
forall (t :: Nat).
KnownNat t =>
SignKeyKES (MockKES t) -> ByteString
rawSerialiseSignKeyMockKES SignKeyKES (MockKES t)
sk

  rawDeserialiseSignKeyKESWith :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ByteString -> m (Maybe (SignKeyKES (MockKES t)))
rawDeserialiseSignKeyKESWith MLockedAllocator m
_alloc ByteString
bs =
    Maybe (SignKeyKES (MockKES t))
-> m (Maybe (SignKeyKES (MockKES t)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SignKeyKES (MockKES t))
 -> m (Maybe (SignKeyKES (MockKES t))))
-> Maybe (SignKeyKES (MockKES t))
-> m (Maybe (SignKeyKES (MockKES t)))
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (SignKeyKES (MockKES t))
forall (t :: Nat).
KnownNat t =>
ByteString -> Maybe (SignKeyKES (MockKES t))
rawDeserialiseSignKeyMockKES ByteString
bs

rawDeserialiseSignKeyMockKES ::
  KnownNat t =>
  ByteString ->
  Maybe (SignKeyKES (MockKES t))
rawDeserialiseSignKeyMockKES :: forall (t :: Nat).
KnownNat t =>
ByteString -> Maybe (SignKeyKES (MockKES t))
rawDeserialiseSignKeyMockKES ByteString
bs
  | [ByteString
vkb, ByteString
tb] <- [Int] -> ByteString -> [ByteString]
splitsAt [Int
8, Int
8] ByteString
bs
  , Just VerKeyKES (MockKES t)
vk <- ByteString -> Maybe (VerKeyKES (MockKES t))
forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
vkb
  , let t :: Period
t = Word64 -> Period
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word64
readBinaryWord64 ByteString
tb) =
      SignKeyKES (MockKES t) -> Maybe (SignKeyKES (MockKES t))
forall a. a -> Maybe a
Just (SignKeyKES (MockKES t) -> Maybe (SignKeyKES (MockKES t)))
-> SignKeyKES (MockKES t) -> Maybe (SignKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$! VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
forall (t :: Nat).
VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
SignKeyMockKES VerKeyKES (MockKES t)
vk Period
t
  | Bool
otherwise =
      Maybe (SignKeyKES (MockKES t))
forall a. Maybe a
Nothing

rawSerialiseSignKeyMockKES ::
  KnownNat t =>
  SignKeyKES (MockKES t) ->
  ByteString
rawSerialiseSignKeyMockKES :: forall (t :: Nat).
KnownNat t =>
SignKeyKES (MockKES t) -> ByteString
rawSerialiseSignKeyMockKES (SignKeyMockKES VerKeyKES (MockKES t)
vk Period
t) =
  VerKeyKES (MockKES t) -> ByteString
forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES (MockKES t)
vk
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word64 -> ByteString
writeBinaryWord64 (Period -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
t)

instance KnownNat t => ToCBOR (VerKeyKES (MockKES t)) where
  toCBOR :: VerKeyKES (MockKES t) -> Encoding
toCBOR = VerKeyKES (MockKES t) -> Encoding
forall v. KESAlgorithm v => VerKeyKES v -> Encoding
encodeVerKeyKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerKeyKES (MockKES t)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (VerKeyKES (MockKES t)) -> Size
forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size
encodedVerKeyKESSizeExpr

instance KnownNat t => FromCBOR (VerKeyKES (MockKES t)) where
  fromCBOR :: forall s. Decoder s (VerKeyKES (MockKES t))
fromCBOR = Decoder s (VerKeyKES (MockKES t))
forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES

instance KnownNat t => ToCBOR (SigKES (MockKES t)) where
  toCBOR :: SigKES (MockKES t) -> Encoding
toCBOR = SigKES (MockKES t) -> Encoding
forall v. KESAlgorithm v => SigKES v -> Encoding
encodeSigKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigKES (MockKES t)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (SigKES (MockKES t)) -> Size
forall v. KESAlgorithm v => Proxy (SigKES v) -> Size
encodedSigKESSizeExpr

instance KnownNat t => FromCBOR (SigKES (MockKES t)) where
  fromCBOR :: forall s. Decoder s (SigKES (MockKES t))
fromCBOR = Decoder s (SigKES (MockKES t))
forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES

instance KnownNat t => ToCBOR (UnsoundPureSignKeyKES (MockKES t)) where
  toCBOR :: UnsoundPureSignKeyKES (MockKES t) -> Encoding
toCBOR = UnsoundPureSignKeyKES (MockKES t) -> Encoding
forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> Encoding
encodeUnsoundPureSignKeyKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (UnsoundPureSignKeyKES (MockKES t)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size Proxy (UnsoundPureSignKeyKES (MockKES t))
_skProxy = Proxy (SignKeyKES (MockKES t)) -> Size
forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr (Proxy (SignKeyKES (MockKES t))
forall {k} (t :: k). Proxy t
Proxy :: Proxy (SignKeyKES (MockKES t)))

instance KnownNat t => FromCBOR (UnsoundPureSignKeyKES (MockKES t)) where
  fromCBOR :: forall s. Decoder s (UnsoundPureSignKeyKES (MockKES t))
fromCBOR = Decoder s (UnsoundPureSignKeyKES (MockKES t))
forall v s.
UnsoundPureKESAlgorithm v =>
Decoder s (UnsoundPureSignKeyKES v)
decodeUnsoundPureSignKeyKES

instance KnownNat t => DirectSerialise (SignKeyKES (MockKES t)) where
  directSerialise :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> SignKeyKES (MockKES t) -> m ()
directSerialise Ptr CChar -> CSize -> m ()
put SignKeyKES (MockKES t)
sk = do
    let bs :: ByteString
bs = SignKeyKES (MockKES t) -> ByteString
forall (t :: Nat).
KnownNat t =>
SignKeyKES (MockKES t) -> ByteString
rawSerialiseSignKeyMockKES SignKeyKES (MockKES t)
sk
    ByteString -> (CStringLen -> m ()) -> m ()
forall (m :: * -> *) a.
(MonadThrow m, MonadST m) =>
ByteString -> (CStringLen -> m a) -> m a
unpackByteStringCStringLen ByteString
bs ((CStringLen -> m ()) -> m ()) -> (CStringLen -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
len) -> Ptr CChar -> CSize -> m ()
put Ptr CChar
cstr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

instance KnownNat t => DirectDeserialise (SignKeyKES (MockKES t)) where
  directDeserialise :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m (SignKeyKES (MockKES t))
directDeserialise Ptr CChar -> CSize -> m ()
pull = do
    let len :: Int
len = Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Period -> Int) -> Period -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (MockKES t) -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
sizeSignKeyKES (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(MockKES t))
    ForeignPtr m Word8
fptr <- Int -> m (ForeignPtr m Word8)
forall (m :: * -> *) a. MonadST m => Int -> m (ForeignPtr m a)
mallocForeignPtrBytes Int
len
    ForeignPtr m Word8 -> (Ptr Word8 -> m ()) -> m ()
forall (m :: * -> *) 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 ->
      Ptr CChar -> CSize -> m ()
pull (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (ForeignPtr m Word8 -> ForeignPtr Word8
forall (m :: * -> *) a. ForeignPtr m a -> ForeignPtr a
unsafeRawForeignPtr ForeignPtr m Word8
fptr) Int
0 Int
len
    m (SignKeyKES (MockKES t))
-> (SignKeyKES (MockKES t) -> m (SignKeyKES (MockKES t)))
-> Maybe (SignKeyKES (MockKES t))
-> m (SignKeyKES (MockKES t))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m (SignKeyKES (MockKES t))
forall a. HasCallStack => String -> a
error String
"directDeserialise @(SignKeyKES (MockKES t))") SignKeyKES (MockKES t) -> m (SignKeyKES (MockKES t))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SignKeyKES (MockKES t)) -> m (SignKeyKES (MockKES t)))
-> Maybe (SignKeyKES (MockKES t)) -> m (SignKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$
      ByteString -> Maybe (SignKeyKES (MockKES t))
forall (t :: Nat).
KnownNat t =>
ByteString -> Maybe (SignKeyKES (MockKES t))
rawDeserialiseSignKeyMockKES ByteString
bs

instance KnownNat t => DirectSerialise (VerKeyKES (MockKES t)) where
  directSerialise :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> VerKeyKES (MockKES t) -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push VerKeyKES (MockKES t)
sk = do
    let bs :: ByteString
bs = VerKeyKES (MockKES t) -> ByteString
forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES (MockKES t)
sk
    ByteString -> (CStringLen -> m ()) -> m ()
forall (m :: * -> *) a.
(MonadThrow m, MonadST m) =>
ByteString -> (CStringLen -> m a) -> m a
unpackByteStringCStringLen ByteString
bs ((CStringLen -> m ()) -> m ()) -> (CStringLen -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
len) -> Ptr CChar -> CSize -> m ()
push Ptr CChar
cstr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

instance KnownNat t => DirectDeserialise (VerKeyKES (MockKES t)) where
  directDeserialise :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m (VerKeyKES (MockKES t))
directDeserialise Ptr CChar -> CSize -> m ()
pull = do
    let len :: Int
len = Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Period -> Int) -> Period -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (MockKES t) -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
sizeVerKeyKES (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(MockKES t))
    ForeignPtr m Word8
fptr <- Int -> m (ForeignPtr m Word8)
forall (m :: * -> *) a. MonadST m => Int -> m (ForeignPtr m a)
mallocForeignPtrBytes Int
len
    ForeignPtr m Word8 -> (Ptr Word8 -> m ()) -> m ()
forall (m :: * -> *) 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 ->
      Ptr CChar -> CSize -> m ()
pull (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (ForeignPtr m Word8 -> ForeignPtr Word8
forall (m :: * -> *) a. ForeignPtr m a -> ForeignPtr a
unsafeRawForeignPtr ForeignPtr m Word8
fptr) Int
0 Int
len
    m (VerKeyKES (MockKES t))
-> (VerKeyKES (MockKES t) -> m (VerKeyKES (MockKES t)))
-> Maybe (VerKeyKES (MockKES t))
-> m (VerKeyKES (MockKES t))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m (VerKeyKES (MockKES t))
forall a. HasCallStack => String -> a
error String
"directDeserialise @(VerKeyKES (MockKES t))") VerKeyKES (MockKES t) -> m (VerKeyKES (MockKES t))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (VerKeyKES (MockKES t)) -> m (VerKeyKES (MockKES t)))
-> Maybe (VerKeyKES (MockKES t)) -> m (VerKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$
      ByteString -> Maybe (VerKeyKES (MockKES t))
forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
bs