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

-- | Abstract digital signatures.
module Cardano.Crypto.DSIGN.Class
  (
    -- * DSIGN algorithm class
    DSIGNAlgorithm (..)
  , Seed
  , seedSizeDSIGN
  , sizeVerKeyDSIGN
  , sizeSignKeyDSIGN
  , sizeSigDSIGN

    -- * 'SignedDSIGN' wrapper
  , SignedDSIGN (..)
  , signedDSIGN
  , verifySignedDSIGN

    -- * CBOR encoding and decoding
  , encodeVerKeyDSIGN
  , decodeVerKeyDSIGN
  , encodeSignKeyDSIGN
  , decodeSignKeyDSIGN
  , encodeSigDSIGN
  , decodeSigDSIGN
  , encodeSignedDSIGN
  , decodeSignedDSIGN

    -- * Encoded 'Size' expresssions
  , encodedVerKeyDSIGNSizeExpr
  , encodedSignKeyDESIGNSizeExpr
  , encodedSigDSIGNSizeExpr
  )
where

import Control.DeepSeq (NFData)
import qualified Data.ByteString as BS
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Data.Proxy (Proxy(..))
import Data.Typeable (Typeable)
import GHC.Exts (Constraint)
import GHC.Generics (Generic)
import GHC.Stack
import GHC.TypeLits (KnownNat, Nat, natVal, TypeError, ErrorMessage (..))
import NoThunks.Class (NoThunks)

import Cardano.Binary (Decoder, decodeBytes, Encoding, encodeBytes, Size, withWordSize)

import Cardano.Crypto.Util (Empty)
import Cardano.Crypto.Seed
import Cardano.Crypto.Hash.Class (HashAlgorithm, Hash, hashWith)



class ( Typeable v
      , Show (VerKeyDSIGN v)
      , Eq (VerKeyDSIGN v)
      , Show (SignKeyDSIGN v)
      , Show (SigDSIGN v)
      , Eq (SigDSIGN v)
      , NoThunks (SigDSIGN v)
      , NoThunks (SignKeyDSIGN v)
      , NoThunks (VerKeyDSIGN v)
      , KnownNat (SeedSizeDSIGN v)
      , KnownNat (SizeVerKeyDSIGN v)
      , KnownNat (SizeSignKeyDSIGN v)
      , KnownNat (SizeSigDSIGN v)
      )
      => DSIGNAlgorithm v where

  type SeedSizeDSIGN    v :: Nat
  type SizeVerKeyDSIGN  v :: Nat
  type SizeSignKeyDSIGN v :: Nat
  type SizeSigDSIGN     v :: Nat

  --
  -- Key and signature types
  --

  data VerKeyDSIGN  v :: Type
  data SignKeyDSIGN v :: Type
  data SigDSIGN     v :: Type

  --
  -- Metadata and basic key operations
  --

  algorithmNameDSIGN :: proxy v -> String

  deriveVerKeyDSIGN :: SignKeyDSIGN v -> VerKeyDSIGN v

  hashVerKeyDSIGN :: HashAlgorithm h => VerKeyDSIGN v -> Hash h (VerKeyDSIGN v)
  hashVerKeyDSIGN = forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN


  --
  -- Core algorithm operations
  --

  -- | Context required to run the DSIGN algorithm
  --
  -- Unit by default (no context required)
  type ContextDSIGN v :: Type
  type ContextDSIGN v = ()

  type Signable v :: Type -> Constraint
  type Signable v = Empty

  signDSIGN
    :: (Signable v a, HasCallStack)
    => ContextDSIGN v
    -> a
    -> SignKeyDSIGN v
    -> SigDSIGN v

  verifyDSIGN
    :: (Signable v a, HasCallStack)
    => ContextDSIGN v
    -> VerKeyDSIGN v
    -> a
    -> SigDSIGN v
    -> Either String ()


  --
  -- Key generation
  --

  -- | Note that this function may error (with 'SeedBytesExhausted') if the
  -- provided seed is not long enough. Callers should ensure that the seed has
  -- is at least 'seedSizeDSIGN' bytes long.
  genKeyDSIGN :: Seed -> SignKeyDSIGN v

  --
  -- Serialisation/(de)serialisation in fixed-size raw format
  --

  rawSerialiseVerKeyDSIGN    :: VerKeyDSIGN  v -> ByteString
  rawSerialiseSignKeyDSIGN   :: SignKeyDSIGN v -> ByteString
  rawSerialiseSigDSIGN       :: SigDSIGN     v -> ByteString

  rawDeserialiseVerKeyDSIGN  :: ByteString -> Maybe (VerKeyDSIGN  v)
  rawDeserialiseSignKeyDSIGN :: ByteString -> Maybe (SignKeyDSIGN v)
  rawDeserialiseSigDSIGN     :: ByteString -> Maybe (SigDSIGN     v)

--
-- Do not provide Ord instances for keys, see #38
--

instance ( TypeError ('Text "Ord not supported for signing keys, use the hash instead")
         , Eq (SignKeyDSIGN v)
         )
      => Ord (SignKeyDSIGN v) where
    compare :: SignKeyDSIGN v -> SignKeyDSIGN v -> Ordering
compare = forall a. HasCallStack => [Char] -> a
error [Char]
"unsupported"

instance ( TypeError ('Text "Ord not supported for verification keys, use the hash instead")
         , Eq (VerKeyDSIGN v)
         )
      => Ord (VerKeyDSIGN v) where
    compare :: VerKeyDSIGN v -> VerKeyDSIGN v -> Ordering
compare = forall a. HasCallStack => [Char] -> a
error [Char]
"unsupported"

-- | The upper bound on the 'Seed' size needed by 'genKeyDSIGN'
seedSizeDSIGN :: forall v proxy. DSIGNAlgorithm v => proxy v -> Word
seedSizeDSIGN :: forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
seedSizeDSIGN proxy v
_ = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @(SeedSizeDSIGN v)))

sizeVerKeyDSIGN    :: forall v proxy. DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN :: forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN  proxy v
_ = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @(SizeVerKeyDSIGN v)))
sizeSignKeyDSIGN   :: forall v proxy. DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN :: forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN proxy v
_ = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @(SizeSignKeyDSIGN v)))
sizeSigDSIGN       :: forall v proxy. DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN :: forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN     proxy v
_ = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @(SizeSigDSIGN v)))

--
-- Convenient CBOR encoding/decoding
--
-- Implementations in terms of the raw (de)serialise
--

encodeVerKeyDSIGN :: DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN :: forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN = ByteString -> Encoding
encodeBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN

encodeSignKeyDSIGN :: DSIGNAlgorithm v => SignKeyDSIGN v -> Encoding
encodeSignKeyDSIGN :: forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> Encoding
encodeSignKeyDSIGN = ByteString -> Encoding
encodeBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
rawSerialiseSignKeyDSIGN

encodeSigDSIGN :: DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN :: forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN = ByteString -> Encoding
encodeBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN

decodeVerKeyDSIGN :: forall v s. DSIGNAlgorithm v => Decoder s (VerKeyDSIGN v)
decodeVerKeyDSIGN :: forall v s. DSIGNAlgorithm v => Decoder s (VerKeyDSIGN v)
decodeVerKeyDSIGN = do
    ByteString
bs <- forall s. Decoder s ByteString
decodeBytes
    case forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN ByteString
bs of
      Just VerKeyDSIGN v
vk -> forall (m :: * -> *) a. Monad m => a -> m a
return VerKeyDSIGN v
vk
      Maybe (VerKeyDSIGN v)
Nothing
        | Int
actual forall a. Eq a => a -> a -> Bool
/= Int
expected
                    -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"decodeVerKeyDSIGN: wrong length, expected " forall a. [a] -> [a] -> [a]
++
                             forall a. Show a => a -> [Char]
show Int
expected forall a. [a] -> [a] -> [a]
++ [Char]
" bytes but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
actual)
        | Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"decodeVerKeyDSIGN: cannot decode key"
        where
          expected :: Int
expected = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))
          actual :: Int
actual   = ByteString -> Int
BS.length ByteString
bs

decodeSignKeyDSIGN :: forall v s. DSIGNAlgorithm v => Decoder s (SignKeyDSIGN v)
decodeSignKeyDSIGN :: forall v s. DSIGNAlgorithm v => Decoder s (SignKeyDSIGN v)
decodeSignKeyDSIGN = do
    ByteString
bs <- forall s. Decoder s ByteString
decodeBytes
    case forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN ByteString
bs of
      Just SignKeyDSIGN v
sk -> forall (m :: * -> *) a. Monad m => a -> m a
return SignKeyDSIGN v
sk
      Maybe (SignKeyDSIGN v)
Nothing
        | Int
actual forall a. Eq a => a -> a -> Bool
/= Int
expected
                    -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"decodeSignKeyDSIGN: wrong length, expected " forall a. [a] -> [a] -> [a]
++
                             forall a. Show a => a -> [Char]
show Int
expected forall a. [a] -> [a] -> [a]
++ [Char]
" bytes but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
actual)
        | Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"decodeSignKeyDSIGN: cannot decode key"
        where
          expected :: Int
expected = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))
          actual :: Int
actual   = ByteString -> Int
BS.length ByteString
bs

decodeSigDSIGN :: forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN :: forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN = do
    ByteString
bs <- forall s. Decoder s ByteString
decodeBytes
    case forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN ByteString
bs of
      Just SigDSIGN v
sig -> forall (m :: * -> *) a. Monad m => a -> m a
return SigDSIGN v
sig
      Maybe (SigDSIGN v)
Nothing
        | Int
actual forall a. Eq a => a -> a -> Bool
/= Int
expected
                    -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"decodeSigDSIGN: wrong length, expected " forall a. [a] -> [a] -> [a]
++
                             forall a. Show a => a -> [Char]
show Int
expected forall a. [a] -> [a] -> [a]
++ [Char]
" bytes but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
actual)
        | Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"decodeSigDSIGN: cannot decode signature"
        where
          expected :: Int
expected = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))
          actual :: Int
actual   = ByteString -> Int
BS.length ByteString
bs


newtype SignedDSIGN v a = SignedDSIGN (SigDSIGN v)
  deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v a x. Rep (SignedDSIGN v a) x -> SignedDSIGN v a
forall v a x. SignedDSIGN v a -> Rep (SignedDSIGN v a) x
$cto :: forall v a x. Rep (SignedDSIGN v a) x -> SignedDSIGN v a
$cfrom :: forall v a x. SignedDSIGN v a -> Rep (SignedDSIGN v a) x
Generic

deriving instance DSIGNAlgorithm v => Show (SignedDSIGN v a)
deriving instance DSIGNAlgorithm v => Eq   (SignedDSIGN v a)

deriving instance NFData (SigDSIGN v) => NFData (SignedDSIGN v a)

instance DSIGNAlgorithm v => NoThunks (SignedDSIGN v a)
  -- use generic instance

signedDSIGN
  :: (DSIGNAlgorithm v, Signable v a)
  => ContextDSIGN v
  -> a
  -> SignKeyDSIGN v
  -> SignedDSIGN v a
signedDSIGN :: forall v a.
(DSIGNAlgorithm v, Signable v a) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SignedDSIGN v a
signedDSIGN ContextDSIGN v
ctxt a
a SignKeyDSIGN v
key = forall v a. SigDSIGN v -> SignedDSIGN v a
SignedDSIGN (forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN ContextDSIGN v
ctxt a
a SignKeyDSIGN v
key)

verifySignedDSIGN
  :: (DSIGNAlgorithm v, Signable v a, HasCallStack)
  => ContextDSIGN v
  -> VerKeyDSIGN v
  -> a
  -> SignedDSIGN v a
  -> Either String ()
verifySignedDSIGN :: forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SignedDSIGN v a -> Either [Char] ()
verifySignedDSIGN ContextDSIGN v
ctxt VerKeyDSIGN v
key a
a (SignedDSIGN SigDSIGN v
s) = forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either [Char] ()
verifyDSIGN ContextDSIGN v
ctxt VerKeyDSIGN v
key a
a SigDSIGN v
s

encodeSignedDSIGN :: DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
encodeSignedDSIGN :: forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
encodeSignedDSIGN (SignedDSIGN SigDSIGN v
s) = forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN SigDSIGN v
s

decodeSignedDSIGN :: DSIGNAlgorithm v => Decoder s (SignedDSIGN v a)
decodeSignedDSIGN :: forall v s a. DSIGNAlgorithm v => Decoder s (SignedDSIGN v a)
decodeSignedDSIGN = forall v a. SigDSIGN v -> SignedDSIGN v a
SignedDSIGN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN

--
-- Encoded 'Size' expressions for 'ToCBOR' instances
--

-- | 'Size' expression for 'VerKeyDSIGN' which is using 'sizeVerKeyDSIGN'
-- encoded as 'Size'.
--
encodedVerKeyDSIGNSizeExpr :: forall v. DSIGNAlgorithm v => Proxy (VerKeyDSIGN v) -> Size
encodedVerKeyDSIGNSizeExpr :: forall v. DSIGNAlgorithm v => Proxy (VerKeyDSIGN v) -> Size
encodedVerKeyDSIGNSizeExpr Proxy (VerKeyDSIGN v)
_proxy =
      -- 'encodeBytes' envelope
      forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall s a. (Integral s, Integral a) => s -> a
withWordSize :: Word -> Integer) (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy :: Proxy v)))
      -- payload
    forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))

-- | 'Size' expression for 'SignKeyDSIGN' which is using 'sizeSignKeyDSIGN'
-- encoded as 'Size'.
--
encodedSignKeyDESIGNSizeExpr :: forall v. DSIGNAlgorithm v => Proxy (SignKeyDSIGN v) -> Size
encodedSignKeyDESIGNSizeExpr :: forall v. DSIGNAlgorithm v => Proxy (SignKeyDSIGN v) -> Size
encodedSignKeyDESIGNSizeExpr Proxy (SignKeyDSIGN v)
_proxy =
      -- 'encodeBytes' envelope
      forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall s a. (Integral s, Integral a) => s -> a
withWordSize :: Word -> Integer) (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy :: Proxy v)))
      -- payload
    forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))

-- | 'Size' expression for 'SigDSIGN' which is using 'sizeSigDSIGN' encoded as
-- 'Size'.
--
encodedSigDSIGNSizeExpr :: forall v. DSIGNAlgorithm v => Proxy (SigDSIGN v) -> Size
encodedSigDSIGNSizeExpr :: forall v. DSIGNAlgorithm v => Proxy (SigDSIGN v) -> Size
encodedSigDSIGNSizeExpr Proxy (SigDSIGN v)
_proxy =
      -- 'encodeBytes' envelope
      forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall s a. (Integral s, Integral a) => s -> a
withWordSize :: Word -> Integer) (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN (forall {k} (t :: k). Proxy t
Proxy :: Proxy v)))
      -- payload
    forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))