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

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

import Cardano.Binary.FixedSizeCodec (
  FixedSizeCodec (..),
  decodeFixedSized,
  encodeFixedSized,
  guardFixedSized,
 )
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)
import NoThunks.Class (NoThunks)

import Control.DeepSeq (NFData)
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
import qualified Data.ByteString as BS
import Foreign.C.Types (CSize)

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 (VerKeyKES (MockKES t) -> ()
(VerKeyKES (MockKES t) -> ()) -> NFData (VerKeyKES (MockKES t))
forall (t :: Nat). VerKeyKES (MockKES t) -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall (t :: Nat). VerKeyKES (MockKES t) -> ()
rnf :: VerKeyKES (MockKES t) -> ()
NFData, 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)

  --
  -- 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"

  type TotalPeriodsKES (MockKES t) = t

  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

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 a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized 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 a (m :: * -> *).
(FixedSizeCodec a, MonadFail m) =>
ByteString -> m a
forall (m :: * -> *).
MonadFail m =>
ByteString -> m (SignKeyKES (MockKES t))
rawDecodeFixedSized ByteString
bs

instance KnownNat t => FixedSizeCodec (SignKeyKES (MockKES t)) where
  type FixedSize (SignKeyKES (MockKES t)) = 16
  rawEncodeFixedSized :: SignKeyKES (MockKES t) -> ByteString
rawEncodeFixedSized (SignKeyMockKES VerKeyKES (MockKES t)
vk Period
t) =
    VerKeyKES (MockKES t) -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized VerKeyKES (MockKES t)
vk
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word64 -> ByteString
writeBinaryWord64 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Period @Word64 Period
t)
  rawDecodeFixedSized :: forall (m :: * -> *).
MonadFail m =>
ByteString -> m (SignKeyKES (MockKES t))
rawDecodeFixedSized ByteString
bs = ByteString
-> m (SignKeyKES (MockKES t)) -> m (SignKeyKES (MockKES t))
forall a (m :: * -> *).
(FixedSizeCodec a, MonadFail m, Typeable a) =>
ByteString -> m a -> m a
guardFixedSized ByteString
bs (m (SignKeyKES (MockKES t)) -> m (SignKeyKES (MockKES t)))
-> m (SignKeyKES (MockKES t)) -> m (SignKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$ do
    let (ByteString
vkb, ByteString
tb) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
8 ByteString
bs
    VerKeyKES (MockKES t)
vk <- case ByteString -> Maybe (VerKeyKES (MockKES t))
forall a (m :: * -> *).
(FixedSizeCodec a, MonadFail m) =>
ByteString -> m a
forall (m :: * -> *).
MonadFail m =>
ByteString -> m (VerKeyKES (MockKES t))
rawDecodeFixedSized ByteString
vkb of
      Just VerKeyKES (MockKES t)
x -> VerKeyKES (MockKES t) -> m (VerKeyKES (MockKES t))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerKeyKES (MockKES t)
x
      Maybe (VerKeyKES (MockKES t))
Nothing -> String -> m (VerKeyKES (MockKES t))
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"rawDeserialiseSignKeyMockKES: Failed to deserialise VerKeyKES"
    let t :: Period
t = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Period (ByteString -> Word64
readBinaryWord64 ByteString
tb)
    SignKeyKES (MockKES t) -> m (SignKeyKES (MockKES t))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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

instance KnownNat t => FixedSizeCodec (VerKeyKES (MockKES t)) where
  type FixedSize (VerKeyKES (MockKES t)) = 8
  rawEncodeFixedSized :: VerKeyKES (MockKES t) -> ByteString
rawEncodeFixedSized (VerKeyMockKES Word64
vk) =
    Word64 -> ByteString
writeBinaryWord64 Word64
vk
  rawDecodeFixedSized :: forall (m :: * -> *).
MonadFail m =>
ByteString -> m (VerKeyKES (MockKES t))
rawDecodeFixedSized ByteString
bs = ByteString
-> m (VerKeyKES (MockKES t)) -> m (VerKeyKES (MockKES t))
forall a (m :: * -> *).
(FixedSizeCodec a, MonadFail m, Typeable a) =>
ByteString -> m a -> m a
guardFixedSized ByteString
bs (m (VerKeyKES (MockKES t)) -> m (VerKeyKES (MockKES t)))
-> m (VerKeyKES (MockKES t)) -> m (VerKeyKES (MockKES t))
forall a b. (a -> b) -> a -> b
$ do
    let vk :: Word64
vk = ByteString -> Word64
readBinaryWord64 ByteString
bs
    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
$! Word64 -> VerKeyKES (MockKES t)
forall (t :: Nat). Word64 -> VerKeyKES (MockKES t)
VerKeyMockKES Word64
vk
  {-# INLINE rawDecodeFixedSized #-}

instance KnownNat t => FixedSizeCodec (SigKES (MockKES t)) where
  type FixedSize (SigKES (MockKES t)) = 24
  rawEncodeFixedSized :: SigKES (MockKES t) -> ByteString
rawEncodeFixedSized (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 a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized SignKeyKES (MockKES t)
sk
  rawDecodeFixedSized :: forall (m :: * -> *).
MonadFail m =>
ByteString -> m (SigKES (MockKES t))
rawDecodeFixedSized ByteString
bs = ByteString -> m (SigKES (MockKES t)) -> m (SigKES (MockKES t))
forall a (m :: * -> *).
(FixedSizeCodec a, MonadFail m, Typeable a) =>
ByteString -> m a -> m a
guardFixedSized ByteString
bs (m (SigKES (MockKES t)) -> m (SigKES (MockKES t)))
-> m (SigKES (MockKES t)) -> m (SigKES (MockKES t))
forall a b. (a -> b) -> a -> b
$ do
    let (ByteString
hb, ByteString
skb) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
8 ByteString
bs
    Hash ShortHash ()
h <- case ByteString -> Maybe (Hash ShortHash ())
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
hb of
      Just Hash ShortHash ()
x -> Hash ShortHash () -> m (Hash ShortHash ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Hash ShortHash ()
x
      Maybe (Hash ShortHash ())
Nothing -> String -> m (Hash ShortHash ())
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"SigKES (MockKES t): Failed to decode hash"
    SignKeyKES (MockKES t)
sk <- ByteString -> m (SignKeyKES (MockKES t))
forall a (m :: * -> *).
(FixedSizeCodec a, MonadFail m) =>
ByteString -> m a
forall (m :: * -> *).
MonadFail m =>
ByteString -> m (SignKeyKES (MockKES t))
rawDecodeFixedSized ByteString
skb
    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 ()
h SignKeyKES (MockKES t)
sk
  {-# INLINE rawDecodeFixedSized #-}

instance KnownNat t => FixedSizeCodec (UnsoundPureSignKeyKES (MockKES t)) where
  type FixedSize (UnsoundPureSignKeyKES (MockKES t)) = FixedSize (SignKeyKES (MockKES t))
  rawEncodeFixedSized :: UnsoundPureSignKeyKES (MockKES t) -> ByteString
rawEncodeFixedSized (UnsoundPureSignKeyMockKES VerKeyKES (MockKES t)
vk Period
t) =
    SignKeyKES (MockKES t) -> ByteString
forall a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized (VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
forall (t :: Nat).
VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
SignKeyMockKES VerKeyKES (MockKES t)
vk Period
t)
  rawDecodeFixedSized :: forall (m :: * -> *).
MonadFail m =>
ByteString -> m (UnsoundPureSignKeyKES (MockKES t))
rawDecodeFixedSized ByteString
bs = do
    SignKeyMockKES VerKeyKES (MockKES t)
vt Period
t <- ByteString -> m (SignKeyKES (MockKES t))
forall a (m :: * -> *).
(FixedSizeCodec a, MonadFail m) =>
ByteString -> m a
forall (m :: * -> *).
MonadFail m =>
ByteString -> m (SignKeyKES (MockKES t))
rawDecodeFixedSized ByteString
bs
    UnsoundPureSignKeyKES (MockKES t)
-> m (UnsoundPureSignKeyKES (MockKES t))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnsoundPureSignKeyKES (MockKES t)
 -> m (UnsoundPureSignKeyKES (MockKES t)))
-> UnsoundPureSignKeyKES (MockKES t)
-> m (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
  {-# INLINE rawDecodeFixedSized #-}

instance KnownNat t => ToCBOR (VerKeyKES (MockKES t)) where
  toCBOR :: VerKeyKES (MockKES t) -> Encoding
toCBOR = VerKeyKES (MockKES t) -> Encoding
forall a. FixedSizeCodec a => a -> Encoding
encodeFixedSized
  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 a s. FixedSizeCodec a => Decoder s a
decodeFixedSized

instance KnownNat t => ToCBOR (SigKES (MockKES t)) where
  toCBOR :: SigKES (MockKES t) -> Encoding
toCBOR = SigKES (MockKES t) -> Encoding
forall a. FixedSizeCodec a => a -> Encoding
encodeFixedSized
  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 a s. FixedSizeCodec a => Decoder s a
decodeFixedSized

instance KnownNat t => ToCBOR (UnsoundPureSignKeyKES (MockKES t)) where
  toCBOR :: UnsoundPureSignKeyKES (MockKES t) -> Encoding
toCBOR = UnsoundPureSignKeyKES (MockKES t) -> Encoding
forall a. FixedSizeCodec a => a -> Encoding
encodeFixedSized
  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 a s. FixedSizeCodec a => Decoder s a
decodeFixedSized

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 a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Int (Period -> Int) -> Period -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (MockKES t) -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
signKeySizeKES (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) (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize 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 a (m :: * -> *).
(FixedSizeCodec a, MonadFail m) =>
ByteString -> m a
forall (m :: * -> *).
MonadFail m =>
ByteString -> m (SignKeyKES (MockKES t))
rawDecodeFixedSized 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 a. FixedSizeCodec a => a -> ByteString
rawEncodeFixedSized 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word @Int (Period -> Int) -> Period -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (VerKeyKES (MockKES t)) -> Period
forall a (proxy :: * -> *). FixedSizeCodec a => proxy a -> Period
fixedSize (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(VerKeyKES (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) (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize 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 a (m :: * -> *).
(FixedSizeCodec a, MonadFail m) =>
ByteString -> m a
forall (m :: * -> *).
MonadFail m =>
ByteString -> m (VerKeyKES (MockKES t))
rawDecodeFixedSized ByteString
bs