{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# 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 'SingleKES' that turns any
-- 'DSIGNAlgorithm' into an instance of 'KESAlgorithm' with a single period.
--
-- See "Cardano.Crypto.KES.Sum" for the composition case.
--
module Cardano.Crypto.KES.Single (
    SingleKES
  , VerKeyKES (..)
  , SignKeyKES (..)
  , SigKES (..)
  ) where

import Data.Proxy (Proxy(..))
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)

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 SingleKES d

deriving instance NFData (VerKeyDSIGN d) => NFData (VerKeyKES (SingleKES d))
deriving instance NFData (SignKeyDSIGN d) => NFData (SignKeyKES (SingleKES d))
deriving instance NFData (SigDSIGN d) => NFData (SigKES (SingleKES d))

instance (DSIGNAlgorithm d, Typeable d) => KESAlgorithm (SingleKES d) where
    type SeedSizeKES (SingleKES d) = SeedSizeDSIGN d

    --
    -- Key and signature types
    --

    newtype VerKeyKES (SingleKES d) = VerKeySingleKES (VerKeyDSIGN d)
        deriving (forall x.
 VerKeyKES (SingleKES d) -> Rep (VerKeyKES (SingleKES d)) x)
-> (forall x.
    Rep (VerKeyKES (SingleKES d)) x -> VerKeyKES (SingleKES d))
-> Generic (VerKeyKES (SingleKES d))
forall x.
Rep (VerKeyKES (SingleKES d)) x -> VerKeyKES (SingleKES d)
forall x.
VerKeyKES (SingleKES d) -> Rep (VerKeyKES (SingleKES d)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x.
Rep (VerKeyKES (SingleKES d)) x -> VerKeyKES (SingleKES d)
forall d x.
VerKeyKES (SingleKES d) -> Rep (VerKeyKES (SingleKES d)) x
$cto :: forall d x.
Rep (VerKeyKES (SingleKES d)) x -> VerKeyKES (SingleKES d)
$cfrom :: forall d x.
VerKeyKES (SingleKES d) -> Rep (VerKeyKES (SingleKES d)) x
Generic

    newtype SignKeyKES (SingleKES d) = SignKeySingleKES (SignKeyDSIGN d)
        deriving (forall x.
 SignKeyKES (SingleKES d) -> Rep (SignKeyKES (SingleKES d)) x)
-> (forall x.
    Rep (SignKeyKES (SingleKES d)) x -> SignKeyKES (SingleKES d))
-> Generic (SignKeyKES (SingleKES d))
forall x.
Rep (SignKeyKES (SingleKES d)) x -> SignKeyKES (SingleKES d)
forall x.
SignKeyKES (SingleKES d) -> Rep (SignKeyKES (SingleKES d)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x.
Rep (SignKeyKES (SingleKES d)) x -> SignKeyKES (SingleKES d)
forall d x.
SignKeyKES (SingleKES d) -> Rep (SignKeyKES (SingleKES d)) x
$cto :: forall d x.
Rep (SignKeyKES (SingleKES d)) x -> SignKeyKES (SingleKES d)
$cfrom :: forall d x.
SignKeyKES (SingleKES d) -> Rep (SignKeyKES (SingleKES d)) x
Generic

    newtype SigKES (SingleKES d) = SigSingleKES (SigDSIGN d)
        deriving (forall x. SigKES (SingleKES d) -> Rep (SigKES (SingleKES d)) x)
-> (forall x. Rep (SigKES (SingleKES d)) x -> SigKES (SingleKES d))
-> Generic (SigKES (SingleKES d))
forall x. Rep (SigKES (SingleKES d)) x -> SigKES (SingleKES d)
forall x. SigKES (SingleKES d) -> Rep (SigKES (SingleKES d)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall d x. Rep (SigKES (SingleKES d)) x -> SigKES (SingleKES d)
forall d x. SigKES (SingleKES d) -> Rep (SigKES (SingleKES d)) x
$cto :: forall d x. Rep (SigKES (SingleKES d)) x -> SigKES (SingleKES d)
$cfrom :: forall d x. SigKES (SingleKES d) -> Rep (SigKES (SingleKES d)) x
Generic


    --
    -- Metadata and basic key operations
    --

    algorithmNameKES :: proxy (SingleKES d) -> String
algorithmNameKES proxy (SingleKES 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 (SingleKES d) -> VerKeyKES (SingleKES d)
deriveVerKeyKES (SignKeySingleKES sk) =
        VerKeyDSIGN d -> VerKeyKES (SingleKES d)
forall d. VerKeyDSIGN d -> VerKeyKES (SingleKES d)
VerKeySingleKES (SignKeyDSIGN d -> VerKeyDSIGN d
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN d
sk)

    hashVerKeyKES :: VerKeyKES (SingleKES d) -> Hash h (VerKeyKES (SingleKES d))
hashVerKeyKES (VerKeySingleKES vk) =
        Hash h (VerKeyDSIGN d) -> Hash h (VerKeyKES (SingleKES 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 (SingleKES d) = DSIGN.ContextDSIGN d
    type Signable   (SingleKES d) = DSIGN.Signable     d

    signKES :: ContextKES (SingleKES d)
-> Period -> a -> SignKeyKES (SingleKES d) -> SigKES (SingleKES d)
signKES ContextKES (SingleKES d)
ctxt Period
t a
a (SignKeySingleKES sk) =
        Bool -> SigKES (SingleKES d) -> SigKES (SingleKES d)
forall a. HasCallStack => Bool -> a -> a
assert (Period
t Period -> Period -> Bool
forall a. Eq a => a -> a -> Bool
== Period
0) (SigKES (SingleKES d) -> SigKES (SingleKES d))
-> SigKES (SingleKES d) -> SigKES (SingleKES d)
forall a b. (a -> b) -> a -> b
$
        SigDSIGN d -> SigKES (SingleKES d)
forall d. SigDSIGN d -> SigKES (SingleKES d)
SigSingleKES (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 (SingleKES d)
ContextDSIGN d
ctxt a
a SignKeyDSIGN d
sk)

    verifyKES :: ContextKES (SingleKES d)
-> VerKeyKES (SingleKES d)
-> Period
-> a
-> SigKES (SingleKES d)
-> Either String ()
verifyKES ContextKES (SingleKES d)
ctxt (VerKeySingleKES vk) Period
t a
a (SigSingleKES sig) =
        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 (SingleKES d)
ContextDSIGN d
ctxt VerKeyDSIGN d
vk a
a SigDSIGN d
sig

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

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

    --
    -- Key generation
    --

    seedSizeKES :: proxy (SingleKES d) -> Period
seedSizeKES proxy (SingleKES 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 (SingleKES d)
genKeyKES Seed
seed = SignKeyDSIGN d -> SignKeyKES (SingleKES d)
forall d. SignKeyDSIGN d -> SignKeyKES (SingleKES d)
SignKeySingleKES (Seed -> SignKeyDSIGN d
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN Seed
seed)


    --
    -- raw serialise/deserialise
    --

    sizeVerKeyKES :: proxy (SingleKES d) -> Period
sizeVerKeyKES  proxy (SingleKES 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 (SingleKES d) -> Period
sizeSignKeyKES proxy (SingleKES 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 (SingleKES d) -> Period
sizeSigKES     proxy (SingleKES d)
_ = Proxy d -> Period
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
sizeSigDSIGN     (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)

    rawSerialiseVerKeyKES :: VerKeyKES (SingleKES d) -> ByteString
rawSerialiseVerKeyKES  (VerKeySingleKES  vk) = VerKeyDSIGN d -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN VerKeyDSIGN d
vk
    rawSerialiseSignKeyKES :: SignKeyKES (SingleKES d) -> ByteString
rawSerialiseSignKeyKES (SignKeySingleKES sk) = SignKeyDSIGN d -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
rawSerialiseSignKeyDSIGN SignKeyDSIGN d
sk
    rawSerialiseSigKES :: SigKES (SingleKES d) -> ByteString
rawSerialiseSigKES     (SigSingleKES    sig) = SigDSIGN d -> ByteString
forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN SigDSIGN d
sig

    rawDeserialiseVerKeyKES :: ByteString -> Maybe (VerKeyKES (SingleKES d))
rawDeserialiseVerKeyKES  = (VerKeyDSIGN d -> VerKeyKES (SingleKES d))
-> Maybe (VerKeyDSIGN d) -> Maybe (VerKeyKES (SingleKES d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VerKeyDSIGN d -> VerKeyKES (SingleKES d)
forall d. VerKeyDSIGN d -> VerKeyKES (SingleKES d)
VerKeySingleKES  (Maybe (VerKeyDSIGN d) -> Maybe (VerKeyKES (SingleKES d)))
-> (ByteString -> Maybe (VerKeyDSIGN d))
-> ByteString
-> Maybe (VerKeyKES (SingleKES 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 (SingleKES d))
rawDeserialiseSignKeyKES = (SignKeyDSIGN d -> SignKeyKES (SingleKES d))
-> Maybe (SignKeyDSIGN d) -> Maybe (SignKeyKES (SingleKES d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SignKeyDSIGN d -> SignKeyKES (SingleKES d)
forall d. SignKeyDSIGN d -> SignKeyKES (SingleKES d)
SignKeySingleKES (Maybe (SignKeyDSIGN d) -> Maybe (SignKeyKES (SingleKES d)))
-> (ByteString -> Maybe (SignKeyDSIGN d))
-> ByteString
-> Maybe (SignKeyKES (SingleKES 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 (SingleKES d))
rawDeserialiseSigKES     = (SigDSIGN d -> SigKES (SingleKES d))
-> Maybe (SigDSIGN d) -> Maybe (SigKES (SingleKES d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SigDSIGN d -> SigKES (SingleKES d)
forall d. SigDSIGN d -> SigKES (SingleKES d)
SigSingleKES     (Maybe (SigDSIGN d) -> Maybe (SigKES (SingleKES d)))
-> (ByteString -> Maybe (SigDSIGN d))
-> ByteString
-> Maybe (SigKES (SingleKES d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (SigDSIGN d)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN


--
-- VerKey instances
--

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

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

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

instance DSIGNAlgorithm d => FromCBOR (VerKeyKES (SingleKES d)) where
  fromCBOR :: Decoder s (VerKeyKES (SingleKES d))
fromCBOR = Decoder s (VerKeyKES (SingleKES d))
forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES


--
-- SignKey instances
--

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

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

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

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


--
-- Sig instances
--

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

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

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

instance DSIGNAlgorithm d => FromCBOR (SigKES (SingleKES d)) where
  fromCBOR :: Decoder s (SigKES (SingleKES d))
fromCBOR = Decoder s (SigKES (SingleKES d))
forall v s. KESAlgorithm v => Decoder s (SigKES v)
decodeSigKES