{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoStarIsType #-}

-- | A standard signature scheme is a forward-secure signature scheme with a
-- single time period.
--
-- This is the base case in the naive recursive implementation of the sum
-- composition from section 3 of the \"MMM\" paper:
--
-- /Composition and Efficiency Tradeoffs for Forward-Secure Digital Signatures/
-- By Tal Malkin, Daniele Micciancio and Sara Miner
-- <https://eprint.iacr.org/2001/034>
--
-- Specfically it states:
--
-- > In order to unify the presentation, we regard standard signature schemes
-- > as forward-seure signature schemes with one time period, namely T = 1.
--
-- So this module simply provides a wrapper 'CompactSingleKES' that turns any
-- 'DSIGNMAlgorithm' into an instance of 'KESAlgorithm' with a single period.
--
-- See "Cardano.Crypto.KES.CompactSum" for the composition case.
--
-- Compared to the implementation in 'Cardano.Crypto.KES.Single', this flavor
-- stores the VerKey used for signing along with the signature. The purpose of
-- this is so that we can avoid storing a pair of VerKeys at every branch node,
-- like 'Cardano.Crypto.KES.Sum' does. See 'Cardano.Crypto.KES.CompactSum' for
-- more details.
module Cardano.Crypto.KES.CompactSingle (
  CompactSingleKES,
  VerKeyKES (..),
  SignKeyKES (..),
  SigKES (..),
) where

import Control.Monad (guard, (<$!>))
import qualified Data.ByteString as BS
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import GHC.TypeLits (KnownNat, type (+))
import NoThunks.Class (NoThunks)

import Control.DeepSeq (NFData)
import Control.Exception (assert)

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

import Cardano.Crypto.DSIGN.Class as DSIGN
import Cardano.Crypto.DirectSerialise
import Cardano.Crypto.Hash.Class
import Cardano.Crypto.KES.Class

-- | A standard signature scheme is a forward-secure signature scheme with a
-- single time period.
data CompactSingleKES d

deriving newtype instance NFData (VerKeyDSIGN d) => NFData (VerKeyKES (CompactSingleKES d))
deriving newtype instance NFData (SignKeyDSIGNM d) => NFData (SignKeyKES (CompactSingleKES d))

deriving instance
  (NFData (SigDSIGN d), NFData (VerKeyDSIGN d)) => NFData (SigKES (CompactSingleKES d))

instance
  ( DSIGNMAlgorithm d
  , KnownNat (SizeSigDSIGN d + SizeVerKeyDSIGN d)
  ) =>
  KESAlgorithm (CompactSingleKES d)
  where
  type SeedSizeKES (CompactSingleKES d) = SeedSizeDSIGN d

  --
  -- Key and signature types
  --

  newtype VerKeyKES (CompactSingleKES d) = VerKeyCompactSingleKES (VerKeyDSIGN d)
    deriving ((forall x.
 VerKeyKES (CompactSingleKES d)
 -> Rep (VerKeyKES (CompactSingleKES d)) x)
-> (forall x.
    Rep (VerKeyKES (CompactSingleKES d)) x
    -> VerKeyKES (CompactSingleKES d))
-> Generic (VerKeyKES (CompactSingleKES d))
forall x.
Rep (VerKeyKES (CompactSingleKES d)) x
-> VerKeyKES (CompactSingleKES d)
forall x.
VerKeyKES (CompactSingleKES d)
-> Rep (VerKeyKES (CompactSingleKES d)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x.
Rep (VerKeyKES (CompactSingleKES d)) x
-> VerKeyKES (CompactSingleKES d)
forall d x.
VerKeyKES (CompactSingleKES d)
-> Rep (VerKeyKES (CompactSingleKES d)) x
$cfrom :: forall d x.
VerKeyKES (CompactSingleKES d)
-> Rep (VerKeyKES (CompactSingleKES d)) x
from :: forall x.
VerKeyKES (CompactSingleKES d)
-> Rep (VerKeyKES (CompactSingleKES d)) x
$cto :: forall d x.
Rep (VerKeyKES (CompactSingleKES d)) x
-> VerKeyKES (CompactSingleKES d)
to :: forall x.
Rep (VerKeyKES (CompactSingleKES d)) x
-> VerKeyKES (CompactSingleKES d)
Generic)

  data SigKES (CompactSingleKES d) = SigCompactSingleKES !(SigDSIGN d) !(VerKeyDSIGN d)
    deriving ((forall x.
 SigKES (CompactSingleKES d) -> Rep (SigKES (CompactSingleKES d)) x)
-> (forall x.
    Rep (SigKES (CompactSingleKES d)) x -> SigKES (CompactSingleKES d))
-> Generic (SigKES (CompactSingleKES d))
forall x.
Rep (SigKES (CompactSingleKES d)) x -> SigKES (CompactSingleKES d)
forall x.
SigKES (CompactSingleKES d) -> Rep (SigKES (CompactSingleKES d)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x.
Rep (SigKES (CompactSingleKES d)) x -> SigKES (CompactSingleKES d)
forall d x.
SigKES (CompactSingleKES d) -> Rep (SigKES (CompactSingleKES d)) x
$cfrom :: forall d x.
SigKES (CompactSingleKES d) -> Rep (SigKES (CompactSingleKES d)) x
from :: forall x.
SigKES (CompactSingleKES d) -> Rep (SigKES (CompactSingleKES d)) x
$cto :: forall d x.
Rep (SigKES (CompactSingleKES d)) x -> SigKES (CompactSingleKES d)
to :: forall x.
Rep (SigKES (CompactSingleKES d)) x -> SigKES (CompactSingleKES d)
Generic)

  newtype SignKeyKES (CompactSingleKES d) = SignKeyCompactSingleKES (SignKeyDSIGNM d)

  type ContextKES (CompactSingleKES d) = ContextDSIGN d
  type Signable (CompactSingleKES d) = DSIGN.Signable d

  --
  -- Metadata and basic key operations
  --

  algorithmNameKES :: forall (proxy :: Type -> Type).
proxy (CompactSingleKES d) -> String
algorithmNameKES proxy (CompactSingleKES d)
_ = Proxy d -> String
forall v (proxy :: Type -> Type).
DSIGNAlgorithm v =>
proxy v -> String
forall (proxy :: Type -> Type). proxy d -> String
algorithmNameDSIGN (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_kes_2^0"

  totalPeriodsKES :: forall (proxy :: Type -> Type). proxy (CompactSingleKES d) -> Word
totalPeriodsKES proxy (CompactSingleKES d)
_ = Word
1

  --
  -- Core algorithm operations
  --

  verifyKES :: forall a.
(Signable (CompactSingleKES d) a, HasCallStack) =>
ContextKES (CompactSingleKES d)
-> VerKeyKES (CompactSingleKES d)
-> Word
-> a
-> SigKES (CompactSingleKES d)
-> Either String ()
verifyKES = ContextKES (CompactSingleKES d)
-> VerKeyKES (CompactSingleKES d)
-> Word
-> a
-> SigKES (CompactSingleKES d)
-> Either String ()
forall v a.
(OptimizedKESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v
-> VerKeyKES v -> Word -> a -> SigKES v -> Either String ()
verifyOptimizedKES

  --
  -- raw serialise/deserialise
  --

  type SizeVerKeyKES (CompactSingleKES d) = SizeVerKeyDSIGN d
  type SizeSignKeyKES (CompactSingleKES d) = SizeSignKeyDSIGN d
  type SizeSigKES (CompactSingleKES d) = SizeSigDSIGN d + SizeVerKeyDSIGN d

  hashVerKeyKES :: forall h.
HashAlgorithm h =>
VerKeyKES (CompactSingleKES d)
-> Hash h (VerKeyKES (CompactSingleKES d))
hashVerKeyKES (VerKeyCompactSingleKES VerKeyDSIGN d
vk) =
    Hash h (VerKeyDSIGN d) -> Hash h (VerKeyKES (CompactSingleKES d))
forall h a b. Hash h a -> Hash h b
castHash (VerKeyDSIGN d -> Hash h (VerKeyDSIGN d)
forall h.
HashAlgorithm h =>
VerKeyDSIGN d -> Hash h (VerKeyDSIGN d)
forall v h.
(DSIGNAlgorithm v, HashAlgorithm h) =>
VerKeyDSIGN v -> Hash h (VerKeyDSIGN v)
hashVerKeyDSIGN VerKeyDSIGN d
vk)

  rawSerialiseVerKeyKES :: VerKeyKES (CompactSingleKES d) -> ByteString
rawSerialiseVerKeyKES (VerKeyCompactSingleKES VerKeyDSIGN d
vk) = VerKeyDSIGN d -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN VerKeyDSIGN d
vk
  rawSerialiseSigKES :: SigKES (CompactSingleKES d) -> ByteString
rawSerialiseSigKES (SigCompactSingleKES SigDSIGN d
sig VerKeyDSIGN d
vk) =
    SigDSIGN d -> ByteString
forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN SigDSIGN d
sig ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> VerKeyDSIGN d -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN VerKeyDSIGN d
vk

  rawDeserialiseVerKeyKES :: ByteString -> Maybe (VerKeyKES (CompactSingleKES d))
rawDeserialiseVerKeyKES = (VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d))
-> Maybe (VerKeyDSIGN d) -> Maybe (VerKeyKES (CompactSingleKES d))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
forall d. VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
VerKeyCompactSingleKES (Maybe (VerKeyDSIGN d) -> Maybe (VerKeyKES (CompactSingleKES d)))
-> (ByteString -> Maybe (VerKeyDSIGN d))
-> ByteString
-> Maybe (VerKeyKES (CompactSingleKES d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (VerKeyDSIGN d)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN
  rawDeserialiseSigKES :: ByteString -> Maybe (SigKES (CompactSingleKES d))
rawDeserialiseSigKES ByteString
b = do
    Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
size_total)
    SigDSIGN d
sigma <- ByteString -> Maybe (SigDSIGN d)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN ByteString
b_sig
    VerKeyDSIGN d
vk <- ByteString -> Maybe (VerKeyDSIGN d)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN ByteString
b_vk
    SigKES (CompactSingleKES d) -> Maybe (SigKES (CompactSingleKES d))
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SigDSIGN d -> VerKeyDSIGN d -> SigKES (CompactSingleKES d)
forall d.
SigDSIGN d -> VerKeyDSIGN d -> SigKES (CompactSingleKES d)
SigCompactSingleKES SigDSIGN d
sigma VerKeyDSIGN d
vk)
    where
      b_sig :: ByteString
b_sig = Word -> Word -> ByteString -> ByteString
slice Word
off_sig Word
size_sig ByteString
b
      b_vk :: ByteString
b_vk = Word -> Word -> ByteString -> ByteString
slice Word
off_vk Word
size_vk ByteString
b

      size_sig :: Word
size_sig = Proxy d -> Word
forall v (proxy :: Type -> Type).
DSIGNAlgorithm v =>
proxy v -> Word
sizeSigDSIGN (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_vk :: Word
size_vk = Proxy d -> Word
forall v (proxy :: Type -> Type).
DSIGNAlgorithm v =>
proxy v -> Word
sizeVerKeyDSIGN (Proxy d
forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
      size_total :: Word
size_total = Proxy (CompactSingleKES d) -> Word
forall v (proxy :: Type -> Type). KESAlgorithm v => proxy v -> Word
sizeSigKES (Proxy (CompactSingleKES d)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (CompactSingleKES d))

      off_sig :: Word
off_sig = Word
0 :: Word
      off_vk :: Word
off_vk = Word
size_sig

  deriveVerKeyKES :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
SignKeyKES (CompactSingleKES d)
-> m (VerKeyKES (CompactSingleKES d))
deriveVerKeyKES (SignKeyCompactSingleKES SignKeyDSIGNM d
v) =
    VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
forall d. VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
VerKeyCompactSingleKES (VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d))
-> m (VerKeyDSIGN d) -> m (VerKeyKES (CompactSingleKES d))
forall (m :: Type -> Type) a b. Monad m => (a -> b) -> m a -> m b
<$!> SignKeyDSIGNM d -> m (VerKeyDSIGN d)
forall v (m :: Type -> Type).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
forall (m :: Type -> Type).
(MonadThrow m, MonadST m) =>
SignKeyDSIGNM d -> m (VerKeyDSIGN d)
deriveVerKeyDSIGNM SignKeyDSIGNM d
v

  --
  -- Core algorithm operations
  --
  signKES :: forall a (m :: Type -> Type).
(Signable (CompactSingleKES d) a, MonadST m, MonadThrow m) =>
ContextKES (CompactSingleKES d)
-> Word
-> a
-> SignKeyKES (CompactSingleKES d)
-> m (SigKES (CompactSingleKES d))
signKES ContextKES (CompactSingleKES d)
ctxt Word
t a
a (SignKeyCompactSingleKES SignKeyDSIGNM d
sk) =
    Bool
-> m (SigKES (CompactSingleKES d))
-> m (SigKES (CompactSingleKES d))
forall a. HasCallStack => Bool -> a -> a
assert (Word
t Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) (m (SigKES (CompactSingleKES d))
 -> m (SigKES (CompactSingleKES d)))
-> m (SigKES (CompactSingleKES d))
-> m (SigKES (CompactSingleKES d))
forall a b. (a -> b) -> a -> b
$
      SigDSIGN d -> VerKeyDSIGN d -> SigKES (CompactSingleKES d)
forall d.
SigDSIGN d -> VerKeyDSIGN d -> SigKES (CompactSingleKES d)
SigCompactSingleKES (SigDSIGN d -> VerKeyDSIGN d -> SigKES (CompactSingleKES d))
-> m (SigDSIGN d)
-> m (VerKeyDSIGN d -> SigKES (CompactSingleKES d))
forall (m :: Type -> Type) a b. Monad m => (a -> b) -> m a -> m b
<$!> ContextDSIGN d -> a -> SignKeyDSIGNM d -> m (SigDSIGN d)
forall v a (m :: Type -> Type).
(DSIGNMAlgorithm v, Signable v a, MonadST m, MonadThrow m) =>
ContextDSIGN v -> a -> SignKeyDSIGNM v -> m (SigDSIGN v)
forall a (m :: Type -> Type).
(Signable d a, MonadST m, MonadThrow m) =>
ContextDSIGN d -> a -> SignKeyDSIGNM d -> m (SigDSIGN d)
signDSIGNM ContextDSIGN d
ContextKES (CompactSingleKES d)
ctxt a
a SignKeyDSIGNM d
sk m (VerKeyDSIGN d -> SigKES (CompactSingleKES d))
-> m (VerKeyDSIGN d) -> m (SigKES (CompactSingleKES d))
forall a b. m (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> SignKeyDSIGNM d -> m (VerKeyDSIGN d)
forall v (m :: Type -> Type).
(DSIGNMAlgorithm v, MonadThrow m, MonadST m) =>
SignKeyDSIGNM v -> m (VerKeyDSIGN v)
forall (m :: Type -> Type).
(MonadThrow m, MonadST m) =>
SignKeyDSIGNM d -> m (VerKeyDSIGN d)
deriveVerKeyDSIGNM SignKeyDSIGNM d
sk

  updateKESWith :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ContextKES (CompactSingleKES d)
-> SignKeyKES (CompactSingleKES d)
-> Word
-> m (Maybe (SignKeyKES (CompactSingleKES d)))
updateKESWith MLockedAllocator m
_allocator ContextKES (CompactSingleKES d)
_ctx (SignKeyCompactSingleKES SignKeyDSIGNM d
_sk) Word
_to = Maybe (SignKeyKES (CompactSingleKES d))
-> m (Maybe (SignKeyKES (CompactSingleKES d)))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (SignKeyKES (CompactSingleKES d))
forall a. Maybe a
Nothing

  --
  -- Key generation
  --

  genKeyKESWith :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeKES (CompactSingleKES d))
-> m (SignKeyKES (CompactSingleKES d))
genKeyKESWith MLockedAllocator m
allocator MLockedSeed (SeedSizeKES (CompactSingleKES d))
seed = SignKeyDSIGNM d -> SignKeyKES (CompactSingleKES d)
forall d. SignKeyDSIGNM d -> SignKeyKES (CompactSingleKES d)
SignKeyCompactSingleKES (SignKeyDSIGNM d -> SignKeyKES (CompactSingleKES d))
-> m (SignKeyDSIGNM d) -> m (SignKeyKES (CompactSingleKES d))
forall (m :: Type -> Type) a b. Monad m => (a -> b) -> m a -> m b
<$!> MLockedAllocator m
-> MLockedSeed (SeedSizeDSIGN d) -> m (SignKeyDSIGNM d)
forall v (m :: Type -> Type).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeDSIGN d) -> m (SignKeyDSIGNM d)
genKeyDSIGNMWith MLockedAllocator m
allocator MLockedSeed (SeedSizeDSIGN d)
MLockedSeed (SeedSizeKES (CompactSingleKES d))
seed

  --
  -- forgetting
  --
  forgetSignKeyKESWith :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyKES (CompactSingleKES d) -> m ()
forgetSignKeyKESWith MLockedAllocator m
allocator (SignKeyCompactSingleKES SignKeyDSIGNM d
v) =
    MLockedAllocator m -> SignKeyDSIGNM d -> m ()
forall v (m :: Type -> Type).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyDSIGNM v -> m ()
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyDSIGNM d -> m ()
forgetSignKeyDSIGNMWith MLockedAllocator m
allocator SignKeyDSIGNM d
v

instance
  ( KESAlgorithm (CompactSingleKES d)
  , UnsoundDSIGNMAlgorithm d
  ) =>
  UnsoundPureKESAlgorithm (CompactSingleKES d)
  where
  data UnsoundPureSignKeyKES (CompactSingleKES d)
    = UnsoundPureSignKeyCompactSingleKES (SignKeyDSIGN d)
    deriving ((forall x.
 UnsoundPureSignKeyKES (CompactSingleKES d)
 -> Rep (UnsoundPureSignKeyKES (CompactSingleKES d)) x)
-> (forall x.
    Rep (UnsoundPureSignKeyKES (CompactSingleKES d)) x
    -> UnsoundPureSignKeyKES (CompactSingleKES d))
-> Generic (UnsoundPureSignKeyKES (CompactSingleKES d))
forall x.
Rep (UnsoundPureSignKeyKES (CompactSingleKES d)) x
-> UnsoundPureSignKeyKES (CompactSingleKES d)
forall x.
UnsoundPureSignKeyKES (CompactSingleKES d)
-> Rep (UnsoundPureSignKeyKES (CompactSingleKES d)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x.
Rep (UnsoundPureSignKeyKES (CompactSingleKES d)) x
-> UnsoundPureSignKeyKES (CompactSingleKES d)
forall d x.
UnsoundPureSignKeyKES (CompactSingleKES d)
-> Rep (UnsoundPureSignKeyKES (CompactSingleKES d)) x
$cfrom :: forall d x.
UnsoundPureSignKeyKES (CompactSingleKES d)
-> Rep (UnsoundPureSignKeyKES (CompactSingleKES d)) x
from :: forall x.
UnsoundPureSignKeyKES (CompactSingleKES d)
-> Rep (UnsoundPureSignKeyKES (CompactSingleKES d)) x
$cto :: forall d x.
Rep (UnsoundPureSignKeyKES (CompactSingleKES d)) x
-> UnsoundPureSignKeyKES (CompactSingleKES d)
to :: forall x.
Rep (UnsoundPureSignKeyKES (CompactSingleKES d)) x
-> UnsoundPureSignKeyKES (CompactSingleKES d)
Generic)

  unsoundPureSignKES :: forall a.
Signable (CompactSingleKES d) a =>
ContextKES (CompactSingleKES d)
-> Word
-> a
-> UnsoundPureSignKeyKES (CompactSingleKES d)
-> SigKES (CompactSingleKES d)
unsoundPureSignKES ContextKES (CompactSingleKES d)
ctxt Word
t a
a (UnsoundPureSignKeyCompactSingleKES SignKeyDSIGN d
sk) =
    Bool -> SigKES (CompactSingleKES d) -> SigKES (CompactSingleKES d)
forall a. HasCallStack => Bool -> a -> a
assert (Word
t Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) (SigKES (CompactSingleKES d) -> SigKES (CompactSingleKES d))
-> SigKES (CompactSingleKES d) -> SigKES (CompactSingleKES d)
forall a b. (a -> b) -> a -> b
$!
      SigDSIGN d -> VerKeyDSIGN d -> SigKES (CompactSingleKES d)
forall d.
SigDSIGN d -> VerKeyDSIGN d -> SigKES (CompactSingleKES d)
SigCompactSingleKES (ContextDSIGN d -> a -> SignKeyDSIGN d -> SigDSIGN d
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall a.
(Signable d a, HasCallStack) =>
ContextDSIGN d -> a -> SignKeyDSIGN d -> SigDSIGN d
signDSIGN ContextDSIGN d
ContextKES (CompactSingleKES d)
ctxt a
a SignKeyDSIGN d
sk) (SignKeyDSIGN d -> VerKeyDSIGN d
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN d
sk)

  unsoundPureUpdateKES :: ContextKES (CompactSingleKES d)
-> UnsoundPureSignKeyKES (CompactSingleKES d)
-> Word
-> Maybe (UnsoundPureSignKeyKES (CompactSingleKES d))
unsoundPureUpdateKES ContextKES (CompactSingleKES d)
_ctx UnsoundPureSignKeyKES (CompactSingleKES d)
_sk Word
_to = Maybe (UnsoundPureSignKeyKES (CompactSingleKES d))
forall a. Maybe a
Nothing

  --
  -- Key generation
  --

  unsoundPureGenKeyKES :: Seed -> UnsoundPureSignKeyKES (CompactSingleKES d)
unsoundPureGenKeyKES Seed
seed =
    SignKeyDSIGN d -> UnsoundPureSignKeyKES (CompactSingleKES d)
forall d.
SignKeyDSIGN d -> UnsoundPureSignKeyKES (CompactSingleKES d)
UnsoundPureSignKeyCompactSingleKES (SignKeyDSIGN d -> UnsoundPureSignKeyKES (CompactSingleKES d))
-> SignKeyDSIGN d -> UnsoundPureSignKeyKES (CompactSingleKES d)
forall a b. (a -> b) -> a -> b
$! Seed -> SignKeyDSIGN d
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN Seed
seed

  unsoundPureDeriveVerKeyKES :: UnsoundPureSignKeyKES (CompactSingleKES d)
-> VerKeyKES (CompactSingleKES d)
unsoundPureDeriveVerKeyKES (UnsoundPureSignKeyCompactSingleKES SignKeyDSIGN d
v) =
    VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
forall d. VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
VerKeyCompactSingleKES (VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d))
-> VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
forall a b. (a -> b) -> a -> b
$! SignKeyDSIGN d -> VerKeyDSIGN d
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN d
v

  unsoundPureSignKeyKESToSoundSignKeyKES :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
UnsoundPureSignKeyKES (CompactSingleKES d)
-> m (SignKeyKES (CompactSingleKES d))
unsoundPureSignKeyKESToSoundSignKeyKES =
    UnsoundPureSignKeyKES (CompactSingleKES d)
-> m (SignKeyKES (CompactSingleKES d))
forall (m :: Type -> Type) k.
(MonadST m, MonadThrow m, UnsoundKESAlgorithm k,
 UnsoundPureKESAlgorithm k) =>
UnsoundPureSignKeyKES k -> m (SignKeyKES k)
unsoundPureSignKeyKESToSoundSignKeyKESViaSer

  rawSerialiseUnsoundPureSignKeyKES :: UnsoundPureSignKeyKES (CompactSingleKES d) -> ByteString
rawSerialiseUnsoundPureSignKeyKES (UnsoundPureSignKeyCompactSingleKES SignKeyDSIGN d
sk) =
    SignKeyDSIGN d -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
rawSerialiseSignKeyDSIGN SignKeyDSIGN d
sk
  rawDeserialiseUnsoundPureSignKeyKES :: ByteString -> Maybe (UnsoundPureSignKeyKES (CompactSingleKES d))
rawDeserialiseUnsoundPureSignKeyKES ByteString
b =
    SignKeyDSIGN d -> UnsoundPureSignKeyKES (CompactSingleKES d)
forall d.
SignKeyDSIGN d -> UnsoundPureSignKeyKES (CompactSingleKES d)
UnsoundPureSignKeyCompactSingleKES (SignKeyDSIGN d -> UnsoundPureSignKeyKES (CompactSingleKES d))
-> Maybe (SignKeyDSIGN d)
-> Maybe (UnsoundPureSignKeyKES (CompactSingleKES d))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (SignKeyDSIGN d)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN ByteString
b

instance
  ( KESAlgorithm (CompactSingleKES d)
  , DSIGNMAlgorithm d
  ) =>
  OptimizedKESAlgorithm (CompactSingleKES d)
  where
  verifySigKES :: forall a.
(Signable (CompactSingleKES d) a, HasCallStack) =>
ContextKES (CompactSingleKES d)
-> Word -> a -> SigKES (CompactSingleKES d) -> Either String ()
verifySigKES ContextKES (CompactSingleKES d)
ctxt Word
t a
a (SigCompactSingleKES SigDSIGN d
sig VerKeyDSIGN d
vk) =
    Bool -> Either String () -> Either String ()
forall a. HasCallStack => Bool -> a -> a
assert (Word
t Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
      ContextDSIGN d
-> VerKeyDSIGN d -> a -> SigDSIGN d -> Either String ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
forall a.
(Signable d a, HasCallStack) =>
ContextDSIGN d
-> VerKeyDSIGN d -> a -> SigDSIGN d -> Either String ()
verifyDSIGN ContextDSIGN d
ContextKES (CompactSingleKES d)
ctxt VerKeyDSIGN d
vk a
a SigDSIGN d
sig

  verKeyFromSigKES :: ContextKES (CompactSingleKES d)
-> Word
-> SigKES (CompactSingleKES d)
-> VerKeyKES (CompactSingleKES d)
verKeyFromSigKES ContextKES (CompactSingleKES d)
_ctxt Word
t (SigCompactSingleKES SigDSIGN d
_ VerKeyDSIGN d
vk) =
    Bool
-> VerKeyKES (CompactSingleKES d) -> VerKeyKES (CompactSingleKES d)
forall a. HasCallStack => Bool -> a -> a
assert (Word
t Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) (VerKeyKES (CompactSingleKES d) -> VerKeyKES (CompactSingleKES d))
-> VerKeyKES (CompactSingleKES d) -> VerKeyKES (CompactSingleKES d)
forall a b. (a -> b) -> a -> b
$
      VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
forall d. VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
VerKeyCompactSingleKES VerKeyDSIGN d
vk

instance
  (KESAlgorithm (CompactSingleKES d), UnsoundDSIGNMAlgorithm d) =>
  UnsoundKESAlgorithm (CompactSingleKES d)
  where
  rawSerialiseSignKeyKES :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
SignKeyKES (CompactSingleKES d) -> m ByteString
rawSerialiseSignKeyKES (SignKeyCompactSingleKES SignKeyDSIGNM d
sk) = SignKeyDSIGNM d -> m ByteString
forall v (m :: Type -> Type).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ByteString
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
SignKeyDSIGNM d -> m ByteString
rawSerialiseSignKeyDSIGNM SignKeyDSIGNM d
sk
  rawDeserialiseSignKeyKESWith :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ByteString -> m (Maybe (SignKeyKES (CompactSingleKES d)))
rawDeserialiseSignKeyKESWith MLockedAllocator m
allocator ByteString
bs = (SignKeyDSIGNM d -> SignKeyKES (CompactSingleKES d))
-> Maybe (SignKeyDSIGNM d)
-> Maybe (SignKeyKES (CompactSingleKES d))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap SignKeyDSIGNM d -> SignKeyKES (CompactSingleKES d)
forall d. SignKeyDSIGNM d -> SignKeyKES (CompactSingleKES d)
SignKeyCompactSingleKES (Maybe (SignKeyDSIGNM d)
 -> Maybe (SignKeyKES (CompactSingleKES d)))
-> m (Maybe (SignKeyDSIGNM d))
-> m (Maybe (SignKeyKES (CompactSingleKES d)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> MLockedAllocator m -> ByteString -> m (Maybe (SignKeyDSIGNM d))
forall v (m :: Type -> Type).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m -> ByteString -> m (Maybe (SignKeyDSIGNM v))
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
MLockedAllocator m -> ByteString -> m (Maybe (SignKeyDSIGNM d))
rawDeserialiseSignKeyDSIGNMWith MLockedAllocator m
allocator ByteString
bs

--
-- VerKey instances
--

deriving instance DSIGNMAlgorithm d => Show (VerKeyKES (CompactSingleKES d))
deriving instance DSIGNMAlgorithm d => Eq (VerKeyKES (CompactSingleKES d))

instance
  (DSIGNMAlgorithm d, KnownNat (SizeSigDSIGN d + SizeVerKeyDSIGN d)) =>
  ToCBOR (VerKeyKES (CompactSingleKES d))
  where
  toCBOR :: VerKeyKES (CompactSingleKES d) -> Encoding
toCBOR = VerKeyKES (CompactSingleKES d) -> Encoding
forall v. KESAlgorithm v => VerKeyKES v -> Encoding
encodeVerKeyKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerKeyKES (CompactSingleKES d)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (VerKeyKES (CompactSingleKES d)) -> Size
forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size
encodedVerKeyKESSizeExpr

instance
  (DSIGNMAlgorithm d, KnownNat (SizeSigDSIGN d + SizeVerKeyDSIGN d)) =>
  FromCBOR (VerKeyKES (CompactSingleKES d))
  where
  fromCBOR :: forall s. Decoder s (VerKeyKES (CompactSingleKES d))
fromCBOR = Decoder s (VerKeyKES (CompactSingleKES d))
forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES

instance DSIGNMAlgorithm d => NoThunks (VerKeyKES (CompactSingleKES d))

--
-- SignKey instances
--

deriving via
  (SignKeyDSIGNM d)
  instance
    DSIGNMAlgorithm d => NoThunks (SignKeyKES (CompactSingleKES d))

--
-- Sig instances
--

deriving instance DSIGNMAlgorithm d => Show (SigKES (CompactSingleKES d))
deriving instance DSIGNMAlgorithm d => Eq (SigKES (CompactSingleKES d))

instance DSIGNMAlgorithm d => NoThunks (SigKES (CompactSingleKES d))

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

instance
  (DSIGNMAlgorithm d, KnownNat (SizeSigKES (CompactSingleKES d))) =>
  FromCBOR (SigKES (CompactSingleKES d))
  where
  fromCBOR :: forall s. Decoder s (SigKES (CompactSingleKES d))
fromCBOR = Decoder s (SigKES (CompactSingleKES d))
forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES

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

--
-- UnsoundPureSignKey instances
--

deriving instance DSIGNAlgorithm d => Show (UnsoundPureSignKeyKES (CompactSingleKES d))
deriving instance
  (DSIGNAlgorithm d, Eq (SignKeyDSIGN d)) => Eq (UnsoundPureSignKeyKES (CompactSingleKES d))

instance
  (UnsoundDSIGNMAlgorithm d, KnownNat (SizeSigDSIGN d + SizeVerKeyDSIGN d)) =>
  ToCBOR (UnsoundPureSignKeyKES (CompactSingleKES d))
  where
  toCBOR :: UnsoundPureSignKeyKES (CompactSingleKES d) -> Encoding
toCBOR = UnsoundPureSignKeyKES (CompactSingleKES d) -> Encoding
forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> Encoding
encodeUnsoundPureSignKeyKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (UnsoundPureSignKeyKES (CompactSingleKES d)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size Proxy (UnsoundPureSignKeyKES (CompactSingleKES d))
_skProxy = Proxy (SignKeyKES (CompactSingleKES d)) -> Size
forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr (Proxy (SignKeyKES (CompactSingleKES d))
forall {k} (t :: k). Proxy t
Proxy :: Proxy (SignKeyKES (CompactSingleKES d)))

instance
  (UnsoundDSIGNMAlgorithm d, KnownNat (SizeSigDSIGN d + SizeVerKeyDSIGN d)) =>
  FromCBOR (UnsoundPureSignKeyKES (CompactSingleKES d))
  where
  fromCBOR :: forall s. Decoder s (UnsoundPureSignKeyKES (CompactSingleKES d))
fromCBOR = Decoder s (UnsoundPureSignKeyKES (CompactSingleKES d))
forall v s.
UnsoundPureKESAlgorithm v =>
Decoder s (UnsoundPureSignKeyKES v)
decodeUnsoundPureSignKeyKES

instance DSIGNAlgorithm d => NoThunks (UnsoundPureSignKeyKES (CompactSingleKES d))

--
-- Direct ser/deser
--

instance DirectSerialise (SignKeyDSIGNM d) => DirectSerialise (SignKeyKES (CompactSingleKES d)) where
  directSerialise :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ())
-> SignKeyKES (CompactSingleKES d) -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push (SignKeyCompactSingleKES SignKeyDSIGNM d
sk) = (Ptr CChar -> CSize -> m ()) -> SignKeyDSIGNM d -> m ()
forall a (m :: Type -> Type).
(DirectSerialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> a -> m ()
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> SignKeyDSIGNM d -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push SignKeyDSIGNM d
sk

instance DirectDeserialise (SignKeyDSIGNM d) => DirectDeserialise (SignKeyKES (CompactSingleKES d)) where
  directDeserialise :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m (SignKeyKES (CompactSingleKES d))
directDeserialise Ptr CChar -> CSize -> m ()
pull = SignKeyDSIGNM d -> SignKeyKES (CompactSingleKES d)
forall d. SignKeyDSIGNM d -> SignKeyKES (CompactSingleKES d)
SignKeyCompactSingleKES (SignKeyDSIGNM d -> SignKeyKES (CompactSingleKES d))
-> m (SignKeyDSIGNM d) -> m (SignKeyKES (CompactSingleKES d))
forall (m :: Type -> Type) a b. Monad m => (a -> b) -> m a -> m b
<$!> (Ptr CChar -> CSize -> m ()) -> m (SignKeyDSIGNM d)
forall a (m :: Type -> Type).
(DirectDeserialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m a
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m (SignKeyDSIGNM d)
directDeserialise Ptr CChar -> CSize -> m ()
pull

instance DirectSerialise (VerKeyDSIGN d) => DirectSerialise (VerKeyKES (CompactSingleKES d)) where
  directSerialise :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ())
-> VerKeyKES (CompactSingleKES d) -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push (VerKeyCompactSingleKES VerKeyDSIGN d
sk) = (Ptr CChar -> CSize -> m ()) -> VerKeyDSIGN d -> m ()
forall a (m :: Type -> Type).
(DirectSerialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> a -> m ()
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> VerKeyDSIGN d -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push VerKeyDSIGN d
sk

instance DirectDeserialise (VerKeyDSIGN d) => DirectDeserialise (VerKeyKES (CompactSingleKES d)) where
  directDeserialise :: forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m (VerKeyKES (CompactSingleKES d))
directDeserialise Ptr CChar -> CSize -> m ()
pull = VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
forall d. VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
VerKeyCompactSingleKES (VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d))
-> m (VerKeyDSIGN d) -> m (VerKeyKES (CompactSingleKES d))
forall (m :: Type -> Type) a b. Monad m => (a -> b) -> m a -> m b
<$!> (Ptr CChar -> CSize -> m ()) -> m (VerKeyDSIGN d)
forall a (m :: Type -> Type).
(DirectDeserialise a, MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m a
forall (m :: Type -> Type).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m (VerKeyDSIGN d)
directDeserialise Ptr CChar -> CSize -> m ()
pull