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

-- | 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
-- 'DSIGNAlgorithm' 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 Data.Proxy (Proxy(..))
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import qualified Data.ByteString as BS
import           Control.Monad (guard)

import Control.Exception (assert)

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

import Cardano.Crypto.Hash.Class
import Cardano.Crypto.DSIGN.Class
import qualified Cardano.Crypto.DSIGN as DSIGN
import Cardano.Crypto.KES.Class
import Control.DeepSeq (NFData)


-- | 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 (SignKeyDSIGN d) => NFData (SignKeyKES (CompactSingleKES d))

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

instance (DSIGNAlgorithm d, Typeable 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
$cto :: forall d x.
Rep (VerKeyKES (CompactSingleKES d)) x
-> VerKeyKES (CompactSingleKES d)
$cfrom :: forall d x.
VerKeyKES (CompactSingleKES d)
-> Rep (VerKeyKES (CompactSingleKES d)) x
Generic

    newtype SignKeyKES (CompactSingleKES d) = SignKeyCompactSingleKES (SignKeyDSIGN d)
        deriving (forall x.
 SignKeyKES (CompactSingleKES d)
 -> Rep (SignKeyKES (CompactSingleKES d)) x)
-> (forall x.
    Rep (SignKeyKES (CompactSingleKES d)) x
    -> SignKeyKES (CompactSingleKES d))
-> Generic (SignKeyKES (CompactSingleKES d))
forall x.
Rep (SignKeyKES (CompactSingleKES d)) x
-> SignKeyKES (CompactSingleKES d)
forall x.
SignKeyKES (CompactSingleKES d)
-> Rep (SignKeyKES (CompactSingleKES d)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x.
Rep (SignKeyKES (CompactSingleKES d)) x
-> SignKeyKES (CompactSingleKES d)
forall d x.
SignKeyKES (CompactSingleKES d)
-> Rep (SignKeyKES (CompactSingleKES d)) x
$cto :: forall d x.
Rep (SignKeyKES (CompactSingleKES d)) x
-> SignKeyKES (CompactSingleKES d)
$cfrom :: forall d x.
SignKeyKES (CompactSingleKES d)
-> Rep (SignKeyKES (CompactSingleKES d)) x
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
$cto :: forall d x.
Rep (SigKES (CompactSingleKES d)) x -> SigKES (CompactSingleKES d)
$cfrom :: forall d x.
SigKES (CompactSingleKES d) -> Rep (SigKES (CompactSingleKES d)) x
Generic


    --
    -- Metadata and basic key operations
    --

    algorithmNameKES :: proxy (CompactSingleKES d) -> String
algorithmNameKES proxy (CompactSingleKES d)
_ = Proxy d -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> 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"

    deriveVerKeyKES :: SignKeyKES (CompactSingleKES d) -> VerKeyKES (CompactSingleKES d)
deriveVerKeyKES (SignKeyCompactSingleKES sk) =
        VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
forall d. VerKeyDSIGN d -> VerKeyKES (CompactSingleKES d)
VerKeyCompactSingleKES (SignKeyDSIGN d -> VerKeyDSIGN d
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN d
sk)

    hashVerKeyKES :: VerKeyKES (CompactSingleKES d)
-> Hash h (VerKeyKES (CompactSingleKES d))
hashVerKeyKES (VerKeyCompactSingleKES 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 v h.
(DSIGNAlgorithm v, HashAlgorithm h) =>
VerKeyDSIGN v -> Hash h (VerKeyDSIGN v)
hashVerKeyDSIGN VerKeyDSIGN d
vk)


    --
    -- Core algorithm operations
    --

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

    signKES :: ContextKES (CompactSingleKES d)
-> Period
-> a
-> SignKeyKES (CompactSingleKES d)
-> SigKES (CompactSingleKES d)
signKES ContextKES (CompactSingleKES d)
ctxt Period
t a
a (SignKeyCompactSingleKES sk) =
        Bool -> SigKES (CompactSingleKES d) -> SigKES (CompactSingleKES d)
forall a. HasCallStack => Bool -> a -> a
assert (Period
t Period -> Period -> Bool
forall a. Eq a => a -> a -> Bool
== Period
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
signDSIGN ContextKES (CompactSingleKES d)
ContextDSIGN d
ctxt a
a SignKeyDSIGN d
sk) (SignKeyDSIGN d -> VerKeyDSIGN d
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN d
sk)

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

    updateKES :: ContextKES (CompactSingleKES d)
-> SignKeyKES (CompactSingleKES d)
-> Period
-> Maybe (SignKeyKES (CompactSingleKES d))
updateKES ContextKES (CompactSingleKES d)
_ctx (SignKeyCompactSingleKES _sk) Period
_to = Maybe (SignKeyKES (CompactSingleKES d))
forall a. Maybe a
Nothing

    totalPeriodsKES :: proxy (CompactSingleKES d) -> Period
totalPeriodsKES  proxy (CompactSingleKES d)
_ = Period
1

    --
    -- Key generation
    --

    seedSizeKES :: proxy (CompactSingleKES d) -> Period
seedSizeKES proxy (CompactSingleKES d)
_ = Proxy d -> Period
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
seedSizeDSIGN (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)
    genKeyKES :: Seed -> SignKeyKES (CompactSingleKES d)
genKeyKES Seed
seed = SignKeyDSIGN d -> SignKeyKES (CompactSingleKES d)
forall d. SignKeyDSIGN d -> SignKeyKES (CompactSingleKES d)
SignKeyCompactSingleKES (Seed -> SignKeyDSIGN d
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN Seed
seed)


    --
    -- raw serialise/deserialise
    --

    sizeVerKeyKES :: proxy (CompactSingleKES d) -> Period
sizeVerKeyKES  proxy (CompactSingleKES d)
_ = Proxy d -> Period
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
sizeVerKeyDSIGN  (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)
    sizeSignKeyKES :: proxy (CompactSingleKES d) -> Period
sizeSignKeyKES proxy (CompactSingleKES d)
_ = Proxy d -> Period
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
sizeSignKeyDSIGN (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)
    sizeSigKES :: proxy (CompactSingleKES d) -> Period
sizeSigKES     proxy (CompactSingleKES d)
_ = Proxy d -> Period
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
sizeSigDSIGN     (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d) Period -> Period -> Period
forall a. Num a => a -> a -> a
+
                       Proxy d -> Period
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
sizeVerKeyDSIGN  (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)

    rawSerialiseVerKeyKES :: VerKeyKES (CompactSingleKES d) -> ByteString
rawSerialiseVerKeyKES  (VerKeyCompactSingleKES  vk) = VerKeyDSIGN d -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN VerKeyDSIGN d
vk
    rawSerialiseSignKeyKES :: SignKeyKES (CompactSingleKES d) -> ByteString
rawSerialiseSignKeyKES (SignKeyCompactSingleKES sk) = SignKeyDSIGN d -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
rawSerialiseSignKeyDSIGN SignKeyDSIGN d
sk
    rawSerialiseSigKES :: SigKES (CompactSingleKES d) -> ByteString
rawSerialiseSigKES     (SigCompactSingleKES sig 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 (f :: * -> *) 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
    rawDeserialiseSignKeyKES :: ByteString -> Maybe (SignKeyKES (CompactSingleKES d))
rawDeserialiseSignKeyKES = (SignKeyDSIGN d -> SignKeyKES (CompactSingleKES d))
-> Maybe (SignKeyDSIGN d)
-> Maybe (SignKeyKES (CompactSingleKES d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SignKeyDSIGN d -> SignKeyKES (CompactSingleKES d)
forall d. SignKeyDSIGN d -> SignKeyKES (CompactSingleKES d)
SignKeyCompactSingleKES (Maybe (SignKeyDSIGN d) -> Maybe (SignKeyKES (CompactSingleKES d)))
-> (ByteString -> Maybe (SignKeyDSIGN d))
-> ByteString
-> Maybe (SignKeyKES (CompactSingleKES d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (SignKeyDSIGN d)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN
    rawDeserialiseSigKES :: ByteString -> Maybe (SigKES (CompactSingleKES d))
rawDeserialiseSigKES ByteString
b   = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
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 (m :: * -> *) 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 = Period -> Period -> ByteString -> ByteString
slice Period
off_sig Period
size_sig ByteString
b
        b_vk :: ByteString
b_vk = Period -> Period -> ByteString -> ByteString
slice Period
off_vk Period
size_vk  ByteString
b

        size_sig :: Period
size_sig   = Proxy d -> Period
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
sizeSigDSIGN    (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)
        size_vk :: Period
size_vk    = Proxy d -> Period
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
sizeVerKeyDSIGN (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)
        size_total :: Period
size_total = Proxy (CompactSingleKES d) -> Period
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Period
sizeSigKES    (Proxy (CompactSingleKES d)
forall k (t :: k). Proxy t
Proxy :: Proxy (CompactSingleKES d))

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

instance (KESAlgorithm (CompactSingleKES d), DSIGNAlgorithm d) => OptimizedKESAlgorithm (CompactSingleKES d) where
    verifySigKES :: ContextKES (CompactSingleKES d)
-> Period -> a -> SigKES (CompactSingleKES d) -> Either String ()
verifySigKES ContextKES (CompactSingleKES d)
ctxt Period
t a
a (SigCompactSingleKES sig vk) =
      Bool -> Either String () -> Either String ()
forall a. HasCallStack => Bool -> a -> a
assert (Period
t Period -> Period -> Bool
forall a. Eq a => a -> a -> Bool
== Period
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 ()
verifyDSIGN ContextKES (CompactSingleKES d)
ContextDSIGN d
ctxt VerKeyDSIGN d
vk a
a SigDSIGN d
sig

    verKeyFromSigKES :: ContextKES (CompactSingleKES d)
-> Period
-> SigKES (CompactSingleKES d)
-> VerKeyKES (CompactSingleKES d)
verKeyFromSigKES ContextKES (CompactSingleKES d)
_ctxt Period
t (SigCompactSingleKES _ vk) =
      Bool
-> VerKeyKES (CompactSingleKES d) -> VerKeyKES (CompactSingleKES d)
forall a. HasCallStack => Bool -> a -> a
assert (Period
t Period -> Period -> Bool
forall a. Eq a => a -> a -> Bool
== Period
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


--
-- VerKey instances
--

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

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

instance DSIGNAlgorithm 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 DSIGNAlgorithm d => FromCBOR (VerKeyKES (CompactSingleKES d)) where
  fromCBOR :: Decoder s (VerKeyKES (CompactSingleKES d))
fromCBOR = Decoder s (VerKeyKES (CompactSingleKES d))
forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES


--
-- SignKey instances
--

deriving instance DSIGNAlgorithm d => Show (SignKeyKES (CompactSingleKES d))

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

instance DSIGNAlgorithm d => ToCBOR (SignKeyKES (CompactSingleKES d)) where
  toCBOR :: SignKeyKES (CompactSingleKES d) -> Encoding
toCBOR = SignKeyKES (CompactSingleKES d) -> Encoding
forall v. KESAlgorithm v => SignKeyKES v -> Encoding
encodeSignKeyKES
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SignKeyKES (CompactSingleKES d)) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (SignKeyKES (CompactSingleKES d)) -> Size
forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr

instance DSIGNAlgorithm d => FromCBOR (SignKeyKES (CompactSingleKES d)) where
  fromCBOR :: Decoder s (SignKeyKES (CompactSingleKES d))
fromCBOR = Decoder s (SignKeyKES (CompactSingleKES d))
forall v s. KESAlgorithm v => Decoder s (SignKeyKES v)
decodeSignKeyKES


--
-- Sig instances
--

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

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

instance DSIGNAlgorithm 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 DSIGNAlgorithm d => FromCBOR (SigKES (CompactSingleKES d)) where
  fromCBOR :: 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 :: Period -> Period -> ByteString -> ByteString
slice Period
offset Period
size = Int -> ByteString -> ByteString
BS.take (Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
size)
                  (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop (Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Period
offset)