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

-- | 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 Cardano.Crypto.PinnedSizedBytes
import qualified Cardano.Crypto.Libsodium as NaCl

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

instance ( NaCl.SodiumDSIGNAlgorithm d -- needed for secure forgetting
         , Typeable d) => KESAlgorithm (SingleKES d) where
    type SeedSizeKES (SingleKES d) = SeedSizeDSIGN d

    --
    -- Key and signature types
    --

    newtype VerKeyKES (SingleKES d) = VerKeySingleKES (NaCl.SodiumVerKeyDSIGN 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 (NaCl.SodiumSignKeyDSIGN 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 (NaCl.SodiumSigDSIGN 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) =
        SodiumVerKeyDSIGN d -> VerKeyKES (SingleKES d)
forall d. SodiumVerKeyDSIGN d -> VerKeyKES (SingleKES d)
VerKeySingleKES (SodiumVerKeyDSIGN d -> VerKeyKES (SingleKES d))
-> SodiumVerKeyDSIGN d -> VerKeyKES (SingleKES d)
forall a b. (a -> b) -> a -> b
$ Proxy d -> SodiumSignKeyDSIGN d -> SodiumVerKeyDSIGN d
forall v.
SodiumDSIGNAlgorithm v =>
Proxy v -> SodiumSignKeyDSIGN v -> SodiumVerKeyDSIGN v
NaCl.naclDeriveVerKeyDSIGN (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d) SodiumSignKeyDSIGN d
sk

    hashVerKeyKES :: VerKeyKES (SingleKES d) -> Hash h (VerKeyKES (SingleKES d))
hashVerKeyKES (VerKeySingleKES vk) =
        Hash h (SodiumVerKeyDSIGN d) -> Hash h (VerKeyKES (SingleKES d))
forall h a b. Hash h a -> Hash h b
castHash ((SodiumVerKeyDSIGN d -> ByteString)
-> SodiumVerKeyDSIGN d -> Hash h (SodiumVerKeyDSIGN d)
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith SodiumVerKeyDSIGN d -> ByteString
forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString SodiumVerKeyDSIGN 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
$
        SodiumSigDSIGN d -> SigKES (SingleKES d)
forall d. SodiumSigDSIGN d -> SigKES (SingleKES d)
SigSingleKES (Proxy d -> a -> SodiumSignKeyDSIGN d -> SodiumSigDSIGN d
forall v a.
(SodiumDSIGNAlgorithm v, SignableRepresentation a) =>
Proxy v -> a -> SodiumSignKeyDSIGN v -> SodiumSigDSIGN v
NaCl.naclSignDSIGN (Proxy d
forall k (t :: k). Proxy t
Proxy @d) a
a SodiumSignKeyDSIGN 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
$
        Proxy d
-> SodiumVerKeyDSIGN d -> a -> SodiumSigDSIGN d -> Either String ()
forall v a.
(SodiumDSIGNAlgorithm v, SignableRepresentation a) =>
Proxy v
-> SodiumVerKeyDSIGN v -> a -> SodiumSigDSIGN v -> Either String ()
NaCl.naclVerifyDSIGN (Proxy d
forall k (t :: k). Proxy t
Proxy @d) SodiumVerKeyDSIGN d
vk a
a SodiumSigDSIGN 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
    --

    genKeyKES :: MLockedSizedBytes (SeedSizeKES (SingleKES d))
-> SignKeyKES (SingleKES d)
genKeyKES MLockedSizedBytes (SeedSizeKES (SingleKES d))
seed = SodiumSignKeyDSIGN d -> SignKeyKES (SingleKES d)
forall d. SodiumSignKeyDSIGN d -> SignKeyKES (SingleKES d)
SignKeySingleKES (Proxy d
-> MLockedSizedBytes (SeedSizeDSIGN d) -> SodiumSignKeyDSIGN d
forall v.
SodiumDSIGNAlgorithm v =>
Proxy v
-> MLockedSizedBytes (SeedSizeDSIGN v) -> SodiumSignKeyDSIGN v
NaCl.naclGenKeyDSIGN (Proxy d
forall k (t :: k). Proxy t
Proxy @d) MLockedSizedBytes (SeedSizeDSIGN d)
MLockedSizedBytes (SeedSizeKES (SingleKES d))
seed)

    --
    -- forgetting
    --

    -- TODO: to implement this, we
    -- should know how to forget DSIGN keys.
    forgetSignKeyKES :: SignKeyKES (SingleKES d) -> IO ()
forgetSignKeyKES = IO () -> SignKeyKES (SingleKES d) -> IO ()
forall a b. a -> b -> a
const (IO () -> SignKeyKES (SingleKES d) -> IO ())
-> IO () -> SignKeyKES (SingleKES d) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    --
    -- 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) = SodiumVerKeyDSIGN d -> ByteString
forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString SodiumVerKeyDSIGN d
vk
    rawSerialiseSignKeyKES :: SignKeyKES (SingleKES d) -> ByteString
rawSerialiseSignKeyKES (SignKeySingleKES sk) = SodiumSignKeyDSIGN d -> ByteString
forall (n :: Nat). KnownNat n => MLockedSizedBytes n -> ByteString
NaCl.mlsbToByteString SodiumSignKeyDSIGN d
sk
    rawSerialiseSigKES :: SigKES (SingleKES d) -> ByteString
rawSerialiseSigKES     (SigSingleKES    sig) = SodiumSigDSIGN d -> ByteString
forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString SodiumSigDSIGN d
sig

    rawDeserialiseVerKeyKES :: ByteString -> Maybe (VerKeyKES (SingleKES d))
rawDeserialiseVerKeyKES  = (SodiumVerKeyDSIGN d -> VerKeyKES (SingleKES d))
-> Maybe (SodiumVerKeyDSIGN d) -> Maybe (VerKeyKES (SingleKES d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SodiumVerKeyDSIGN d -> VerKeyKES (SingleKES d)
forall d. SodiumVerKeyDSIGN d -> VerKeyKES (SingleKES d)
VerKeySingleKES  (Maybe (SodiumVerKeyDSIGN d) -> Maybe (VerKeyKES (SingleKES d)))
-> (ByteString -> Maybe (SodiumVerKeyDSIGN d))
-> ByteString
-> Maybe (VerKeyKES (SingleKES d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (SodiumVerKeyDSIGN d)
forall (n :: Nat).
KnownNat n =>
ByteString -> Maybe (PinnedSizedBytes n)
psbFromByteStringCheck
    rawDeserialiseSignKeyKES :: ByteString -> Maybe (SignKeyKES (SingleKES d))
rawDeserialiseSignKeyKES = (SodiumSignKeyDSIGN d -> SignKeyKES (SingleKES d))
-> Maybe (SodiumSignKeyDSIGN d) -> Maybe (SignKeyKES (SingleKES d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SodiumSignKeyDSIGN d -> SignKeyKES (SingleKES d)
forall d. SodiumSignKeyDSIGN d -> SignKeyKES (SingleKES d)
SignKeySingleKES (Maybe (SodiumSignKeyDSIGN d) -> Maybe (SignKeyKES (SingleKES d)))
-> (ByteString -> Maybe (SodiumSignKeyDSIGN d))
-> ByteString
-> Maybe (SignKeyKES (SingleKES d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (SodiumSignKeyDSIGN d)
forall (n :: Nat).
KnownNat n =>
ByteString -> Maybe (MLockedSizedBytes n)
NaCl.mlsbFromByteStringCheck
    rawDeserialiseSigKES :: ByteString -> Maybe (SigKES (SingleKES d))
rawDeserialiseSigKES     = (SodiumSigDSIGN d -> SigKES (SingleKES d))
-> Maybe (SodiumSigDSIGN d) -> Maybe (SigKES (SingleKES d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SodiumSigDSIGN d -> SigKES (SingleKES d)
forall d. SodiumSigDSIGN d -> SigKES (SingleKES d)
SigSingleKES     (Maybe (SodiumSigDSIGN d) -> Maybe (SigKES (SingleKES d)))
-> (ByteString -> Maybe (SodiumSigDSIGN d))
-> ByteString
-> Maybe (SigKES (SingleKES d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (SodiumSigDSIGN d)
forall (n :: Nat).
KnownNat n =>
ByteString -> Maybe (PinnedSizedBytes n)
psbFromByteStringCheck

--
-- 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 NaCl.SodiumDSIGNAlgorithm 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 NaCl.SodiumDSIGNAlgorithm 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 NaCl.SodiumDSIGNAlgorithm 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 NaCl.SodiumDSIGNAlgorithm 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 NaCl.SodiumDSIGNAlgorithm 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 NaCl.SodiumDSIGNAlgorithm 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