{-# 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
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
showList :: [VerKeyKES (MockKES t)] -> ShowS
$cshowList :: forall (t :: Nat). [VerKeyKES (MockKES t)] -> ShowS
show :: VerKeyKES (MockKES t) -> String
$cshow :: forall (t :: Nat). VerKeyKES (MockKES t) -> String
showsPrec :: Int -> VerKeyKES (MockKES t) -> ShowS
$cshowsPrec :: forall (t :: Nat). Int -> VerKeyKES (MockKES t) -> ShowS
Show, VerKeyKES (MockKES t) -> VerKeyKES (MockKES t) -> Bool
forall (t :: Nat).
VerKeyKES (MockKES t) -> VerKeyKES (MockKES t) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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
$c== :: forall (t :: Nat).
VerKeyKES (MockKES t) -> VerKeyKES (MockKES t) -> Bool
Eq, 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 a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (t :: Nat) x.
Rep (VerKeyKES (MockKES t)) x -> VerKeyKES (MockKES t)
$cfrom :: forall (t :: Nat) x.
VerKeyKES (MockKES t) -> Rep (VerKeyKES (MockKES t)) x
Generic)
    deriving newtype (Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
Proxy (VerKeyKES (MockKES t)) -> String
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
showTypeOf :: Proxy (VerKeyKES (MockKES t)) -> String
$cshowTypeOf :: forall (t :: Nat). Proxy (VerKeyKES (MockKES t)) -> String
wNoThunks :: Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (t :: Nat).
Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
noThunks :: Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (t :: Nat).
Context -> VerKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
NoThunks)

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

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

  --
  -- Metadata and basic key operations
  --

  algorithmNameKES :: forall (proxy :: * -> *). proxy (MockKES t) -> String
algorithmNameKES proxy (MockKES t)
proxy = String
"mock_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> 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 forall a. Eq a => a -> a -> Bool
/= VerKeyKES (MockKES t)
vk' =
        forall a b. a -> Either a b
Left String
"KES verification failed"
    | Period
t' forall a. Eq a => a -> a -> Bool
== Period
t
    , forall h a b. Hash h a -> Hash h b
castHash (forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a) forall a. Eq a => a -> a -> Bool
== Hash ShortHash ()
h =
        forall a b. b -> Either a b
Right ()
    | Bool
otherwise =
        forall a b. a -> Either a b
Left String
"KES verification failed"

  totalPeriodsKES :: forall (proxy :: * -> *). proxy (MockKES t) -> Period
totalPeriodsKES proxy (MockKES t)
_ = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (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) =
    forall h a. Hash h a -> ByteString
hashToBytes Hash ShortHash ()
h
      forall a. Semigroup a => a -> a -> a
<> 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 =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall (t :: Nat). Word64 -> VerKeyKES (MockKES t)
VerKeyMockKES Word64
vk
    | Bool
otherwise =
        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 <- forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
hb
    , Just SignKeyKES (MockKES t)
sk <- forall (t :: Nat).
KnownNat t =>
ByteString -> Maybe (SignKeyKES (MockKES t))
rawDeserialiseSignKeyMockKES ByteString
skb =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall (t :: Nat).
Hash ShortHash () -> SignKeyKES (MockKES t) -> SigKES (MockKES t)
SigMockKES Hash ShortHash ()
h SignKeyKES (MockKES t)
sk
    | Bool
otherwise =
        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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return 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 =
    forall a. HasCallStack => Bool -> a -> a
assert (Period
t forall a. Eq a => a -> a -> Bool
== Period
t') forall a b. (a -> b) -> a -> b
$!
      if Period
t forall a. Num a => a -> a -> a
+ Period
1 forall a. Ord a => a -> a -> Bool
< forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
totalPeriodsKES (forall {k} (t :: k). Proxy t
Proxy @(MockKES t))
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall (t :: Nat).
VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
SignKeyMockKES VerKeyKES (MockKES t)
vk (Period
t forall a. Num a => a -> a -> a
+ Period
1)
        else forall (m :: * -> *) a. Monad m => a -> m a
return 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') =
    forall a. HasCallStack => Bool -> a -> a
assert (Period
t forall a. Eq a => a -> a -> Bool
== Period
t') forall a b. (a -> b) -> a -> b
$!
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$!
        forall (t :: Nat).
Hash ShortHash () -> SignKeyKES (MockKES t) -> SigKES (MockKES t)
SigMockKES
          (forall h a b. Hash h a -> Hash h b
castHash (forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a))
          (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 <- forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString forall a b. (a -> b) -> a -> b
$ forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB MLockedSeed (SeedSizeKES (MockKES t))
seed
    let vk :: VerKeyKES (MockKES t)
vk = forall (t :: Nat). Word64 -> VerKeyKES (MockKES t)
VerKeyMockKES (forall a. Seed -> (forall (m :: * -> *). MonadRandom m => m a) -> a
runMonadRandomWithSeed (ByteString -> Seed
mkSeedFromBytes ByteString
seedBS) forall (m :: * -> *). MonadRandom m => m Word64
getRandomWord64)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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
_ = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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
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
showList :: [UnsoundPureSignKeyKES (MockKES t)] -> ShowS
$cshowList :: forall (t :: Nat). [UnsoundPureSignKeyKES (MockKES t)] -> ShowS
show :: UnsoundPureSignKeyKES (MockKES t) -> String
$cshow :: forall (t :: Nat). UnsoundPureSignKeyKES (MockKES t) -> String
showsPrec :: Int -> UnsoundPureSignKeyKES (MockKES t) -> ShowS
$cshowsPrec :: forall (t :: Nat).
Int -> UnsoundPureSignKeyKES (MockKES t) -> ShowS
Show, UnsoundPureSignKeyKES (MockKES t)
-> UnsoundPureSignKeyKES (MockKES t) -> Bool
forall (t :: Nat).
UnsoundPureSignKeyKES (MockKES t)
-> UnsoundPureSignKeyKES (MockKES t) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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
$c== :: forall (t :: Nat).
UnsoundPureSignKeyKES (MockKES t)
-> UnsoundPureSignKeyKES (MockKES t) -> Bool
Eq, 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 a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (t :: Nat) x.
Rep (UnsoundPureSignKeyKES (MockKES t)) x
-> UnsoundPureSignKeyKES (MockKES t)
$cfrom :: forall (t :: Nat) x.
UnsoundPureSignKeyKES (MockKES t)
-> Rep (UnsoundPureSignKeyKES (MockKES t)) x
Generic)
    deriving anyclass (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
showTypeOf :: Proxy (UnsoundPureSignKeyKES (MockKES t)) -> String
$cshowTypeOf :: forall (t :: Nat).
Proxy (UnsoundPureSignKeyKES (MockKES t)) -> String
wNoThunks :: Context
-> UnsoundPureSignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (t :: Nat).
Context
-> UnsoundPureSignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> UnsoundPureSignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (t :: Nat).
Context
-> UnsoundPureSignKeyKES (MockKES t) -> IO (Maybe ThunkInfo)
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 =
    forall a. HasCallStack => Bool -> a -> a
assert (Period
t forall a. Eq a => a -> a -> Bool
== Period
t') forall a b. (a -> b) -> a -> b
$!
      if Period
t forall a. Num a => a -> a -> a
+ Period
1 forall a. Ord a => a -> a -> Bool
< forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
totalPeriodsKES (forall {k} (t :: k). Proxy t
Proxy @(MockKES t))
        then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall (t :: Nat).
VerKeyKES (MockKES t)
-> Period -> UnsoundPureSignKeyKES (MockKES t)
UnsoundPureSignKeyMockKES VerKeyKES (MockKES t)
vk (Period
t forall a. Num a => a -> a -> a
+ Period
1)
        else 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') =
    forall a. HasCallStack => Bool -> a -> a
assert (Period
t forall a. Eq a => a -> a -> Bool
== Period
t') forall a b. (a -> b) -> a -> b
$!
      forall (t :: Nat).
Hash ShortHash () -> SignKeyKES (MockKES t) -> SigKES (MockKES t)
SigMockKES
        (forall h a b. Hash h a -> Hash h b
castHash (forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a))
        (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 = forall (t :: Nat). Word64 -> VerKeyKES (MockKES t)
VerKeyMockKES (forall a. Seed -> (forall (m :: * -> *). MonadRandom m => m a) -> a
runMonadRandomWithSeed Seed
seed forall (m :: * -> *). MonadRandom m => m Word64
getRandomWord64)
     in 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) =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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) =
    forall (t :: Nat).
KnownNat t =>
SignKeyKES (MockKES t) -> ByteString
rawSerialiseSignKeyMockKES (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 <- forall (t :: Nat).
KnownNat t =>
ByteString -> Maybe (SignKeyKES (MockKES t))
rawDeserialiseSignKeyMockKES ByteString
bs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
vkb
  , let t :: Period
t = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word64
readBinaryWord64 ByteString
tb) =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall (t :: Nat).
VerKeyKES (MockKES t) -> Period -> SignKeyKES (MockKES t)
SignKeyMockKES VerKeyKES (MockKES t)
vk Period
t
  | Bool
otherwise =
      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) =
  forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES (MockKES t)
vk
    forall a. Semigroup a => a -> a -> a
<> Word64 -> ByteString
writeBinaryWord64 (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 = 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 = 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 = forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES

instance KnownNat t => ToCBOR (SigKES (MockKES t)) where
  toCBOR :: SigKES (MockKES t) -> Encoding
toCBOR = 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 = 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 = forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES

instance KnownNat t => ToCBOR (UnsoundPureSignKeyKES (MockKES t)) where
  toCBOR :: UnsoundPureSignKeyKES (MockKES t) -> Encoding
toCBOR = 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 = forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr (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 = 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 = forall (t :: Nat).
KnownNat t =>
SignKeyKES (MockKES t) -> ByteString
rawSerialiseSignKeyMockKES SignKeyKES (MockKES t)
sk
    forall (m :: * -> *) a.
(MonadThrow m, MonadST m) =>
ByteString -> (CStringLen -> m a) -> m a
unpackByteStringCStringLen ByteString
bs 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
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 forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
sizeSignKeyKES (forall {k} (t :: k). Proxy t
Proxy @(MockKES t))
    ForeignPtr m Word8
fptr <- forall (m :: * -> *) a. MonadST m => Int -> m (ForeignPtr m a)
mallocForeignPtrBytes Int
len
    forall (m :: * -> *) a b.
MonadST m =>
ForeignPtr m a -> (Ptr a -> m b) -> m b
withForeignPtr ForeignPtr m Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
      Ptr CChar -> CSize -> m ()
pull (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (forall (m :: * -> *) a. ForeignPtr m a -> ForeignPtr a
unsafeRawForeignPtr ForeignPtr m Word8
fptr) Int
0 Int
len
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error String
"directDeserialise @(SignKeyKES (MockKES t))") forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      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 = forall v. KESAlgorithm v => VerKeyKES v -> ByteString
rawSerialiseVerKeyKES VerKeyKES (MockKES t)
sk
    forall (m :: * -> *) a.
(MonadThrow m, MonadST m) =>
ByteString -> (CStringLen -> m a) -> m a
unpackByteStringCStringLen ByteString
bs 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
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 forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
sizeVerKeyKES (forall {k} (t :: k). Proxy t
Proxy @(MockKES t))
    ForeignPtr m Word8
fptr <- forall (m :: * -> *) a. MonadST m => Int -> m (ForeignPtr m a)
mallocForeignPtrBytes Int
len
    forall (m :: * -> *) a b.
MonadST m =>
ForeignPtr m a -> (Ptr a -> m b) -> m b
withForeignPtr ForeignPtr m Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
      Ptr CChar -> CSize -> m ()
pull (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (forall (m :: * -> *) a. ForeignPtr m a -> ForeignPtr a
unsafeRawForeignPtr ForeignPtr m Word8
fptr) Int
0 Int
len
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error String
"directDeserialise @(VerKeyKES (MockKES t))") forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      forall v. KESAlgorithm v => ByteString -> Maybe (VerKeyKES v)
rawDeserialiseVerKeyKES ByteString
bs