{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# 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,

  -- * MLocked DSIGN algorithm class
  DSIGNMAlgorithm (..),
  genKeyDSIGNM,
  cloneKeyDSIGNM,
  getSeedDSIGNM,
  forgetSignKeyDSIGNM,

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

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

  -- * Encoded 'Size' expresssions
  encodedVerKeyDSIGNSizeExpr,
  encodedSignKeyDSIGNSizeExpr,
  encodedSigDSIGNSizeExpr,

  -- * Helper
  failSizeCheck,

  -- * Unsound CBOR encoding and decoding of MLocked DSIGN keys
  UnsoundDSIGNMAlgorithm (..),
  encodeSignKeyDSIGNM,
  decodeSignKeyDSIGNM,
  rawDeserialiseSignKeyDSIGNM,
)
where

import Control.DeepSeq (NFData)
import Control.Monad.Class.MonadST (MonadST)
import Control.Monad.Class.MonadThrow (MonadThrow)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
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 (ErrorMessage (..), KnownNat, Nat, TypeError, natVal)
import NoThunks.Class (NoThunks)

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

import Cardano.Crypto.Hash.Class (Hash, HashAlgorithm, hashWith)
import Cardano.Crypto.Libsodium (MLockedAllocator, mlockedMalloc)
import Cardano.Crypto.Libsodium.MLockedSeed
import Cardano.Crypto.Seed
import Cardano.Crypto.Util (Empty)

-- | The pure DSIGN API, which supports the full set of DSIGN operations, but
-- does not allow for secure forgetting of private keys.
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 = (VerKeyDSIGN v -> ByteString)
-> VerKeyDSIGN v -> Hash h (VerKeyDSIGN v)
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith VerKeyDSIGN v -> ByteString
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 = [Char] -> SignKeyDSIGN v -> SignKeyDSIGN v -> Ordering
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 = [Char] -> VerKeyDSIGN v -> VerKeyDSIGN v -> Ordering
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
_ = Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Proxy (SeedSizeDSIGN v) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
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
_ = Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Proxy (SizeVerKeyDSIGN v) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
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
_ = Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Proxy (SizeSignKeyDSIGN v) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
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
_ = Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Proxy (SizeSigDSIGN v) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
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 (ByteString -> Encoding)
-> (VerKeyDSIGN v -> ByteString) -> VerKeyDSIGN v -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN v -> ByteString
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 (ByteString -> Encoding)
-> (SignKeyDSIGN v -> ByteString) -> SignKeyDSIGN v -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyDSIGN v -> ByteString
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 (ByteString -> Encoding)
-> (SigDSIGN v -> ByteString) -> SigDSIGN v -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigDSIGN v -> ByteString
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 <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  case ByteString -> Maybe (VerKeyDSIGN v)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN ByteString
bs of
    Just VerKeyDSIGN v
vk -> VerKeyDSIGN v -> Decoder s (VerKeyDSIGN v)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return VerKeyDSIGN v
vk
    Maybe (VerKeyDSIGN v)
Nothing -> [Char] -> [Char] -> ByteString -> Word -> Decoder s (VerKeyDSIGN v)
forall (m :: * -> *) a.
MonadFail m =>
[Char] -> [Char] -> ByteString -> Word -> m a
failSizeCheck [Char]
"decodeVerKeyDSIGN" [Char]
"key" ByteString
bs (Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (Proxy v
forall {k} (t :: k). Proxy t
Proxy :: Proxy v))
{-# INLINE decodeVerKeyDSIGN #-}

decodeSignKeyDSIGN :: forall v s. DSIGNAlgorithm v => Decoder s (SignKeyDSIGN v)
decodeSignKeyDSIGN :: forall v s. DSIGNAlgorithm v => Decoder s (SignKeyDSIGN v)
decodeSignKeyDSIGN = do
  ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  case ByteString -> Maybe (SignKeyDSIGN v)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN ByteString
bs of
    Just SignKeyDSIGN v
sk -> SignKeyDSIGN v -> Decoder s (SignKeyDSIGN v)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return SignKeyDSIGN v
sk
    Maybe (SignKeyDSIGN v)
Nothing -> [Char]
-> [Char] -> ByteString -> Word -> Decoder s (SignKeyDSIGN v)
forall (m :: * -> *) a.
MonadFail m =>
[Char] -> [Char] -> ByteString -> Word -> m a
failSizeCheck [Char]
"decodeSignKeyDSIGN" [Char]
"key" ByteString
bs (Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (Proxy v
forall {k} (t :: k). Proxy t
Proxy :: Proxy v))

decodeSigDSIGN :: forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN :: forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN = do
  ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  case ByteString -> Maybe (SigDSIGN v)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN ByteString
bs of
    Just SigDSIGN v
sig -> SigDSIGN v -> Decoder s (SigDSIGN v)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return SigDSIGN v
sig
    Maybe (SigDSIGN v)
Nothing -> [Char] -> [Char] -> ByteString -> Word -> Decoder s (SigDSIGN v)
forall (m :: * -> *) a.
MonadFail m =>
[Char] -> [Char] -> ByteString -> Word -> m a
failSizeCheck [Char]
"decodeSigDSIGN" [Char]
"signature" ByteString
bs (Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN (Proxy v
forall {k} (t :: k). Proxy t
Proxy :: Proxy v))
{-# INLINE decodeSigDSIGN #-}

-- | Helper function that always fails, but it provides a different message whenever
-- expected size does not match.
failSizeCheck :: MonadFail m => String -> String -> ByteString -> Word -> m a
failSizeCheck :: forall (m :: * -> *) a.
MonadFail m =>
[Char] -> [Char] -> ByteString -> Word -> m a
failSizeCheck [Char]
fname [Char]
name ByteString
bs Word
expectedSize
  | Word
actualSize Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
expectedSize =
      [Char] -> m a
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail
        ( [Char]
fname
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": wrong length, expected "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word -> [Char]
forall a. Show a => a -> [Char]
show Word
expectedSize
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" bytes but got "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word -> [Char]
forall a. Show a => a -> [Char]
show Word
actualSize
        )
  | Bool
otherwise = [Char] -> m a
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m a) -> [Char] -> m a
forall a b. (a -> b) -> a -> b
$ [Char]
fname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": cannot decode " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name
  where
    actualSize :: Word
actualSize = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)
{-# NOINLINE failSizeCheck #-}

newtype SignedDSIGN v a = SignedDSIGN (SigDSIGN v)
  deriving ((forall x. SignedDSIGN v a -> Rep (SignedDSIGN v a) x)
-> (forall x. Rep (SignedDSIGN v a) x -> SignedDSIGN v a)
-> Generic (SignedDSIGN v a)
forall x. Rep (SignedDSIGN v a) x -> SignedDSIGN v a
forall x. SignedDSIGN v a -> Rep (SignedDSIGN v a) x
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
$cfrom :: forall v a x. SignedDSIGN v a -> Rep (SignedDSIGN v a) x
from :: forall x. SignedDSIGN v a -> Rep (SignedDSIGN v a) x
$cto :: forall v a x. Rep (SignedDSIGN v a) x -> SignedDSIGN v a
to :: forall x. Rep (SignedDSIGN v a) x -> SignedDSIGN v a
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 = SigDSIGN v -> SignedDSIGN v a
forall v a. SigDSIGN v -> SignedDSIGN v a
SignedDSIGN (ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
forall a.
(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) = ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either [Char] ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SigDSIGN v -> Either [Char] ()
forall a.
(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) = SigDSIGN v -> Encoding
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 = SigDSIGN v -> SignedDSIGN v a
forall v a. SigDSIGN v -> SignedDSIGN v a
SignedDSIGN (SigDSIGN v -> SignedDSIGN v a)
-> Decoder s (SigDSIGN v) -> Decoder s (SignedDSIGN v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (SigDSIGN v)
forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN
{-# INLINE decodeSignedDSIGN #-}

--
-- 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
  Integer -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word -> Integer
forall s a. (Integral s, Integral a) => s -> a
withWordSize :: Word -> Integer) (Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (Proxy v
forall {k} (t :: k). Proxy t
Proxy :: Proxy v)))
    -- payload
    Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Word -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (Proxy v
forall {k} (t :: k). Proxy t
Proxy :: Proxy v))

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

class (DSIGNAlgorithm v, NoThunks (SignKeyDSIGNM v)) => DSIGNMAlgorithm v where
  data SignKeyDSIGNM v :: Type

  deriveVerKeyDSIGNM :: (MonadThrow m, MonadST m) => SignKeyDSIGNM v -> m (VerKeyDSIGN v)

  --
  -- Core algorithm operations
  --

  signDSIGNM ::
    (Signable v a, MonadST m, MonadThrow m) =>
    ContextDSIGN v ->
    a ->
    SignKeyDSIGNM v ->
    m (SigDSIGN v)

  --
  -- Key generation
  --

  genKeyDSIGNMWith ::
    (MonadST m, MonadThrow m) =>
    MLockedAllocator m ->
    MLockedSeed (SeedSizeDSIGN v) ->
    m (SignKeyDSIGNM v)

  cloneKeyDSIGNMWith :: MonadST m => MLockedAllocator m -> SignKeyDSIGNM v -> m (SignKeyDSIGNM v)

  getSeedDSIGNMWith ::
    (MonadST m, MonadThrow m) =>
    MLockedAllocator m ->
    Proxy v ->
    SignKeyDSIGNM v ->
    m (MLockedSeed (SeedSizeDSIGN v))

  --
  -- Secure forgetting
  --

  forgetSignKeyDSIGNMWith ::
    (MonadST m, MonadThrow m) => MLockedAllocator m -> SignKeyDSIGNM v -> m ()

forgetSignKeyDSIGNM :: (DSIGNMAlgorithm v, MonadST m, MonadThrow m) => SignKeyDSIGNM v -> m ()
forgetSignKeyDSIGNM :: forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ()
forgetSignKeyDSIGNM = MLockedAllocator m -> SignKeyDSIGNM v -> m ()
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyDSIGNM v -> m ()
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyDSIGNM v -> m ()
forgetSignKeyDSIGNMWith MLockedAllocator m
forall (m :: * -> *). MonadST m => MLockedAllocator m
mlockedMalloc

genKeyDSIGNM ::
  (DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
  MLockedSeed (SeedSizeDSIGN v) ->
  m (SignKeyDSIGNM v)
genKeyDSIGNM :: forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
genKeyDSIGNM = MLockedAllocator m
-> MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
genKeyDSIGNMWith MLockedAllocator m
forall (m :: * -> *). MonadST m => MLockedAllocator m
mlockedMalloc

cloneKeyDSIGNM ::
  (DSIGNMAlgorithm v, MonadST m) => SignKeyDSIGNM v -> m (SignKeyDSIGNM v)
cloneKeyDSIGNM :: forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m) =>
SignKeyDSIGNM v -> m (SignKeyDSIGNM v)
cloneKeyDSIGNM = MLockedAllocator m -> SignKeyDSIGNM v -> m (SignKeyDSIGNM v)
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m) =>
MLockedAllocator m -> SignKeyDSIGNM v -> m (SignKeyDSIGNM v)
forall (m :: * -> *).
MonadST m =>
MLockedAllocator m -> SignKeyDSIGNM v -> m (SignKeyDSIGNM v)
cloneKeyDSIGNMWith MLockedAllocator m
forall (m :: * -> *). MonadST m => MLockedAllocator m
mlockedMalloc

getSeedDSIGNM ::
  (DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
  Proxy v ->
  SignKeyDSIGNM v ->
  m (MLockedSeed (SeedSizeDSIGN v))
getSeedDSIGNM :: forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
Proxy v -> SignKeyDSIGNM v -> m (MLockedSeed (SeedSizeDSIGN v))
getSeedDSIGNM = MLockedAllocator m
-> Proxy v -> SignKeyDSIGNM v -> m (MLockedSeed (SeedSizeDSIGN v))
forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> Proxy v -> SignKeyDSIGNM v -> m (MLockedSeed (SeedSizeDSIGN v))
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> Proxy v -> SignKeyDSIGNM v -> m (MLockedSeed (SeedSizeDSIGN v))
getSeedDSIGNMWith MLockedAllocator m
forall (m :: * -> *). MonadST m => MLockedAllocator m
mlockedMalloc

-- | Unsound operations on DSIGNM sign keys. These operations violate secure
-- forgetting constraints by leaking secrets to unprotected memory. Consider
-- using the 'DirectSerialise' / 'DirectDeserialise' APIs instead.
class DSIGNMAlgorithm v => UnsoundDSIGNMAlgorithm v where
  --
  -- Serialisation/(de)serialisation in fixed-size raw format
  --

  rawSerialiseSignKeyDSIGNM ::
    (MonadST m, MonadThrow m) => SignKeyDSIGNM v -> m ByteString

  rawDeserialiseSignKeyDSIGNMWith ::
    (MonadST m, MonadThrow m) => MLockedAllocator m -> ByteString -> m (Maybe (SignKeyDSIGNM v))

rawDeserialiseSignKeyDSIGNM ::
  (UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
  ByteString ->
  m (Maybe (SignKeyDSIGNM v))
rawDeserialiseSignKeyDSIGNM :: forall v (m :: * -> *).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
ByteString -> m (Maybe (SignKeyDSIGNM v))
rawDeserialiseSignKeyDSIGNM =
  MLockedAllocator m -> ByteString -> m (Maybe (SignKeyDSIGNM v))
forall v (m :: * -> *).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m -> ByteString -> m (Maybe (SignKeyDSIGNM v))
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m -> ByteString -> m (Maybe (SignKeyDSIGNM v))
rawDeserialiseSignKeyDSIGNMWith MLockedAllocator m
forall (m :: * -> *). MonadST m => MLockedAllocator m
mlockedMalloc

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

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

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

encodeSignKeyDSIGNM ::
  (UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
  SignKeyDSIGNM v ->
  m Encoding
encodeSignKeyDSIGNM :: forall v (m :: * -> *).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m Encoding
encodeSignKeyDSIGNM = (ByteString -> Encoding) -> m ByteString -> m Encoding
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Encoding
encodeBytes (m ByteString -> m Encoding)
-> (SignKeyDSIGNM v -> m ByteString)
-> SignKeyDSIGNM v
-> m Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyDSIGNM v -> m ByteString
forall v (m :: * -> *).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ByteString
forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
SignKeyDSIGNM v -> m ByteString
rawSerialiseSignKeyDSIGNM

decodeSignKeyDSIGNM ::
  forall m v s.
  (UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
  Decoder s (m (SignKeyDSIGNM v))
decodeSignKeyDSIGNM :: forall (m :: * -> *) v s.
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
Decoder s (m (SignKeyDSIGNM v))
decodeSignKeyDSIGNM = do
  ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
decodeBytes
  m (SignKeyDSIGNM v) -> Decoder s (m (SignKeyDSIGNM v))
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (m (SignKeyDSIGNM v) -> Decoder s (m (SignKeyDSIGNM v)))
-> m (SignKeyDSIGNM v) -> Decoder s (m (SignKeyDSIGNM v))
forall a b. (a -> b) -> a -> b
$
    ByteString -> m (Maybe (SignKeyDSIGNM v))
forall v (m :: * -> *).
(UnsoundDSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
ByteString -> m (Maybe (SignKeyDSIGNM v))
rawDeserialiseSignKeyDSIGNM ByteString
bs m (Maybe (SignKeyDSIGNM v))
-> (Maybe (SignKeyDSIGNM v) -> m (SignKeyDSIGNM v))
-> m (SignKeyDSIGNM v)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just SignKeyDSIGNM v
vk -> SignKeyDSIGNM v -> m (SignKeyDSIGNM v)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SignKeyDSIGNM v
vk
      Maybe (SignKeyDSIGNM v)
Nothing
        | Int
actual Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
expected ->
            [Char] -> m (SignKeyDSIGNM v)
forall a. HasCallStack => [Char] -> a
error
              ( [Char]
"decodeSignKeyDSIGNM: wrong length, expected "
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
expected
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" bytes but got "
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
actual
              )
        | Bool
otherwise -> [Char] -> m (SignKeyDSIGNM v)
forall a. HasCallStack => [Char] -> a
error [Char]
"decodeSignKeyDSIGNM: cannot decode key"
        where
          expected :: Int
expected = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (Proxy v
forall {k} (t :: k). Proxy t
Proxy :: Proxy v))
          actual :: Int
actual = ByteString -> Int
BS.length ByteString
bs