{-# 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 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 => KESAlgorithm (SingleKES d) where
    type SeedSizeKES (SingleKES d) = SeedSizeDSIGN d

    --
    -- Key and signature types
    --

    newtype VerKeyKES (SingleKES d) = VerKeySingleKES (VerKeyDSIGN d)
        deriving 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 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 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 :: forall (proxy :: * -> *). proxy (SingleKES d) -> String
algorithmNameKES proxy (SingleKES d)
_ = forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
algorithmNameDSIGN (forall {k} (t :: k). Proxy t
Proxy :: Proxy d) forall a. [a] -> [a] -> [a]
++ String
"_kes_2^0"

    deriveVerKeyKES :: SignKeyKES (SingleKES d) -> VerKeyKES (SingleKES d)
deriveVerKeyKES (SignKeySingleKES SignKeyDSIGN d
sk) =
        forall d. VerKeyDSIGN d -> VerKeyKES (SingleKES d)
VerKeySingleKES (forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN d
sk)

    hashVerKeyKES :: forall h.
HashAlgorithm h =>
VerKeyKES (SingleKES d) -> Hash h (VerKeyKES (SingleKES d))
hashVerKeyKES (VerKeySingleKES VerKeyDSIGN d
vk) =
        forall h a b. Hash h a -> Hash h b
castHash (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 :: forall a.
(Signable (SingleKES d) a, HasCallStack) =>
ContextKES (SingleKES d)
-> Period -> a -> SignKeyKES (SingleKES d) -> SigKES (SingleKES d)
signKES ContextKES (SingleKES d)
ctxt Period
t a
a (SignKeySingleKES SignKeyDSIGN d
sk) =
        forall a. HasCallStack => Bool -> a -> a
assert (Period
t forall a. Eq a => a -> a -> Bool
== Period
0) forall a b. (a -> b) -> a -> b
$
        forall d. SigDSIGN d -> SigKES (SingleKES d)
SigSingleKES (forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN ContextKES (SingleKES d)
ctxt a
a SignKeyDSIGN d
sk)

    verifyKES :: forall a.
(Signable (SingleKES d) a, HasCallStack) =>
ContextKES (SingleKES d)
-> VerKeyKES (SingleKES d)
-> Period
-> a
-> SigKES (SingleKES d)
-> Either String ()
verifyKES ContextKES (SingleKES d)
ctxt (VerKeySingleKES VerKeyDSIGN d
vk) Period
t a
a (SigSingleKES SigDSIGN d
sig) =
        forall a. HasCallStack => Bool -> a -> a
assert (Period
t forall a. Eq a => a -> a -> Bool
== Period
0) forall a b. (a -> b) -> a -> b
$
        forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either String ()
verifyDSIGN ContextKES (SingleKES d)
ctxt VerKeyDSIGN d
vk a
a SigDSIGN d
sig

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

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

    --
    -- Key generation
    --

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


    --
    -- raw serialise/deserialise
    --

    sizeVerKeyKES :: forall (proxy :: * -> *). proxy (SingleKES d) -> Period
sizeVerKeyKES  proxy (SingleKES d)
_ = forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
sizeVerKeyDSIGN  (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
    sizeSignKeyKES :: forall (proxy :: * -> *). proxy (SingleKES d) -> Period
sizeSignKeyKES proxy (SingleKES d)
_ = forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
sizeSignKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
    sizeSigKES :: forall (proxy :: * -> *). proxy (SingleKES d) -> Period
sizeSigKES     proxy (SingleKES d)
_ = forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
sizeSigDSIGN     (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)

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

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

instance DSIGNAlgorithm d => FromCBOR (VerKeyKES (SingleKES d)) where
  fromCBOR :: forall s. Decoder s (VerKeyKES (SingleKES d))
fromCBOR = 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 = 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 = forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size
encodedSignKeyKESSizeExpr

instance DSIGNAlgorithm d => FromCBOR (SignKeyKES (SingleKES d)) where
  fromCBOR :: forall s. Decoder s (SignKeyKES (SingleKES d))
fromCBOR = 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 = 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 = forall v. KESAlgorithm v => Proxy (SigKES v) -> Size
encodedSigKESSizeExpr

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