{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- According to the documentation for unsafePerformIO:
--
-- > Make sure that the either you switch off let-floating
-- > (-fno-full-laziness), or that the call to unsafePerformIO cannot float
-- > outside a lambda.
--
-- If we do not switch off let-floating, our calls to unsafeDupablePerformIO for
-- FFI functions become nondeterministic in their behaviour when run with
-- parallelism enabled (such as -with-rtsopts=-N), possibly yielding wrong
-- answers on a range of tasks, including serialization.
{-# OPTIONS_GHC -fno-full-laziness #-}

-- | Ed25519 digital signatures.
module Cardano.Crypto.DSIGN.Ed25519 (
  Ed25519DSIGN,
  SigDSIGN (..),
  SignKeyDSIGN (..),
  SignKeyDSIGNM (..),
  VerKeyDSIGN (..),
)
where

import Control.DeepSeq (NFData (..), rwhnf)
import Control.Monad (guard, unless, (<$!>))
import Control.Monad.Class.MonadST (MonadST (..))
import Control.Monad.Class.MonadThrow (MonadThrow (..), throwIO)
import Control.Monad.ST (ST)
import Control.Monad.ST.Unsafe (unsafeIOToST)
import qualified Data.ByteString as BS
import Data.Proxy
import Foreign.C.Error (Errno, errnoToIOError, getErrno)
import Foreign.Ptr (castPtr, nullPtr)
import GHC.Generics (Generic)
import GHC.IO.Exception (ioException)
import GHC.TypeLits (ErrorMessage (..), TypeError)
import NoThunks.Class (NoThunks)
import System.IO.Unsafe (unsafeDupablePerformIO)

import Cardano.Binary (FromCBOR (..), ToCBOR (..))

import Cardano.Crypto.DSIGN.Class
import Cardano.Crypto.DirectSerialise
import Cardano.Crypto.Libsodium (
  MLockedSizedBytes,
  mlsbCopyWith,
  mlsbFinalize,
  mlsbFromByteStringCheckWith,
  mlsbNewWith,
  mlsbToByteString,
  mlsbUseAsSizedPtr,
 )
import Cardano.Crypto.Libsodium.C
import Cardano.Crypto.Libsodium.MLockedSeed
import Cardano.Crypto.PinnedSizedBytes (
  PinnedSizedBytes,
  psbCreate,
  psbCreateSized,
  psbCreateSizedResult,
  psbFromByteStringCheck,
  psbToByteString,
  psbUseAsCPtrLen,
  psbUseAsSizedPtr,
 )
import Cardano.Crypto.Seed
import Cardano.Crypto.Util (SignableRepresentation (..))
import Cardano.Foreign

data Ed25519DSIGN

instance NoThunks (VerKeyDSIGN Ed25519DSIGN)
instance NoThunks (SignKeyDSIGN Ed25519DSIGN)
instance NoThunks (SigDSIGN Ed25519DSIGN)

deriving via
  (MLockedSizedBytes (SizeSignKeyDSIGN Ed25519DSIGN))
  instance
    NoThunks (SignKeyDSIGNM Ed25519DSIGN)

instance NFData (SignKeyDSIGNM Ed25519DSIGN) where
  rnf :: SignKeyDSIGNM Ed25519DSIGN -> ()
rnf = forall a. a -> ()
rwhnf

-- | Convert C-style return code / errno error reporting into Haskell
-- exceptions.
--
-- Runs an IO action (which should be some FFI call into C) that returns a
-- result code; if the result code returned is nonzero, fetch the errno, and
-- throw a suitable IO exception.
cOrThrowError :: String -> String -> IO Int -> IO ()
cOrThrowError :: String -> String -> IO Int -> IO ()
cOrThrowError String
contextDesc String
cFunName IO Int
action = do
  Int
res <- IO Int
action
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
res forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$ do
    Errno
errno <- IO Errno
getErrno
    forall a. IOException -> IO a
ioException forall a b. (a -> b) -> a -> b
$ String -> Errno -> Maybe Handle -> Maybe String -> IOException
errnoToIOError (String
contextDesc forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
cFunName) Errno
errno forall a. Maybe a
Nothing forall a. Maybe a
Nothing

--

-- | Convert C-style return code / errno error reporting into Haskell
-- exceptions.
--
-- Runs an IO action (which should be some FFI call into C) that returns a
-- result code; if the result code returned is nonzero, fetch the errno, and
-- return it.
cOrError :: MonadST m => (forall s. ST s Int) -> m (Maybe Errno)
cOrError :: forall (m :: * -> *).
MonadST m =>
(forall s. ST s Int) -> m (Maybe Errno)
cOrError forall s. ST s Int
action = forall (m :: * -> *) a. MonadST m => ST (PrimState m) a -> m a
stToIO forall a b. (a -> b) -> a -> b
$ do
  Int
res <- forall s. ST s Int
action
  if Int
res forall a. Eq a => a -> a -> Bool
== Int
0
    then
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else
      forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. IO a -> ST s a
unsafeIOToST IO Errno
getErrno

-- | Throws an error when 'Just' an 'Errno' is given.
throwOnErrno :: MonadThrow m => String -> String -> Maybe Errno -> m ()
throwOnErrno :: forall (m :: * -> *).
MonadThrow m =>
String -> String -> Maybe Errno -> m ()
throwOnErrno String
contextDesc String
cFunName Maybe Errno
maybeErrno = do
  case Maybe Errno
maybeErrno of
    Just Errno
errno -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ String -> Errno -> Maybe Handle -> Maybe String -> IOException
errnoToIOError (String
contextDesc forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
cFunName) Errno
errno forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    Maybe Errno
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance DSIGNAlgorithm Ed25519DSIGN where
  -- \| Seed size is 32 octets, the same as sign key size, because generating
  -- a sign key is literally just taking a chunk from the seed. We use
  -- SEEDBYTES to define both the seed size and the sign key size.
  type SeedSizeDSIGN Ed25519DSIGN = CRYPTO_SIGN_ED25519_SEEDBYTES

  -- \| Ed25519 key size is 32 octets
  -- (per <https://tools.ietf.org/html/rfc8032#section-5.1.6>)
  type SizeVerKeyDSIGN Ed25519DSIGN = CRYPTO_SIGN_ED25519_PUBLICKEYBYTES

  -- \| Ed25519 secret key size is 32 octets; however, libsodium packs both
  -- the secret key and the public key into a 64-octet compound and exposes
  -- that as the secret key; the actual 32-octet secret key is called
  -- \"seed\" in libsodium. For backwards compatibility reasons and
  -- efficiency, we use the 64-octet compounds internally (this is what
  -- libsodium expects), but we only serialize the 32-octet secret key part
  -- (the libsodium \"seed\"). And because of this, we need to define the
  -- sign key size to be SEEDBYTES (which is 32), not PRIVATEKEYBYTES (which
  -- would be 64).
  type SizeSignKeyDSIGN Ed25519DSIGN = CRYPTO_SIGN_ED25519_SEEDBYTES

  -- \| Ed25519 signature size is 64 octets
  type SizeSigDSIGN Ed25519DSIGN = CRYPTO_SIGN_ED25519_BYTES

  --
  -- Key and signature types
  --

  newtype VerKeyDSIGN Ed25519DSIGN = VerKeyEd25519DSIGN (PinnedSizedBytes (SizeVerKeyDSIGN Ed25519DSIGN))
    deriving (Int -> VerKeyDSIGN Ed25519DSIGN -> ShowS
[VerKeyDSIGN Ed25519DSIGN] -> ShowS
VerKeyDSIGN Ed25519DSIGN -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerKeyDSIGN Ed25519DSIGN] -> ShowS
$cshowList :: [VerKeyDSIGN Ed25519DSIGN] -> ShowS
show :: VerKeyDSIGN Ed25519DSIGN -> String
$cshow :: VerKeyDSIGN Ed25519DSIGN -> String
showsPrec :: Int -> VerKeyDSIGN Ed25519DSIGN -> ShowS
$cshowsPrec :: Int -> VerKeyDSIGN Ed25519DSIGN -> ShowS
Show, VerKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN -> Bool
$c/= :: VerKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN -> Bool
== :: VerKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN -> Bool
$c== :: VerKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN -> Bool
Eq, forall x.
Rep (VerKeyDSIGN Ed25519DSIGN) x -> VerKeyDSIGN Ed25519DSIGN
forall x.
VerKeyDSIGN Ed25519DSIGN -> Rep (VerKeyDSIGN Ed25519DSIGN) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (VerKeyDSIGN Ed25519DSIGN) x -> VerKeyDSIGN Ed25519DSIGN
$cfrom :: forall x.
VerKeyDSIGN Ed25519DSIGN -> Rep (VerKeyDSIGN Ed25519DSIGN) x
Generic)
    deriving newtype (VerKeyDSIGN Ed25519DSIGN -> ()
forall a. (a -> ()) -> NFData a
rnf :: VerKeyDSIGN Ed25519DSIGN -> ()
$crnf :: VerKeyDSIGN Ed25519DSIGN -> ()
NFData)

  -- Note that the size of the internal key data structure is the SECRET KEY
  -- bytes as per libsodium, while the declared key size (for serialization)
  -- is libsodium's SEED bytes. We expand 32-octet keys to 64-octet ones
  -- during deserialization, and we delete the 32 octets that contain the
  -- public key from the secret key before serializing.
  newtype SignKeyDSIGN Ed25519DSIGN
    = SignKeyEd25519DSIGN (PinnedSizedBytes CRYPTO_SIGN_ED25519_SECRETKEYBYTES)
    deriving (Int -> SignKeyDSIGN Ed25519DSIGN -> ShowS
[SignKeyDSIGN Ed25519DSIGN] -> ShowS
SignKeyDSIGN Ed25519DSIGN -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignKeyDSIGN Ed25519DSIGN] -> ShowS
$cshowList :: [SignKeyDSIGN Ed25519DSIGN] -> ShowS
show :: SignKeyDSIGN Ed25519DSIGN -> String
$cshow :: SignKeyDSIGN Ed25519DSIGN -> String
showsPrec :: Int -> SignKeyDSIGN Ed25519DSIGN -> ShowS
$cshowsPrec :: Int -> SignKeyDSIGN Ed25519DSIGN -> ShowS
Show, SignKeyDSIGN Ed25519DSIGN -> SignKeyDSIGN Ed25519DSIGN -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignKeyDSIGN Ed25519DSIGN -> SignKeyDSIGN Ed25519DSIGN -> Bool
$c/= :: SignKeyDSIGN Ed25519DSIGN -> SignKeyDSIGN Ed25519DSIGN -> Bool
== :: SignKeyDSIGN Ed25519DSIGN -> SignKeyDSIGN Ed25519DSIGN -> Bool
$c== :: SignKeyDSIGN Ed25519DSIGN -> SignKeyDSIGN Ed25519DSIGN -> Bool
Eq, forall x.
Rep (SignKeyDSIGN Ed25519DSIGN) x -> SignKeyDSIGN Ed25519DSIGN
forall x.
SignKeyDSIGN Ed25519DSIGN -> Rep (SignKeyDSIGN Ed25519DSIGN) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (SignKeyDSIGN Ed25519DSIGN) x -> SignKeyDSIGN Ed25519DSIGN
$cfrom :: forall x.
SignKeyDSIGN Ed25519DSIGN -> Rep (SignKeyDSIGN Ed25519DSIGN) x
Generic)
    deriving newtype (SignKeyDSIGN Ed25519DSIGN -> ()
forall a. (a -> ()) -> NFData a
rnf :: SignKeyDSIGN Ed25519DSIGN -> ()
$crnf :: SignKeyDSIGN Ed25519DSIGN -> ()
NFData)

  newtype SigDSIGN Ed25519DSIGN = SigEd25519DSIGN (PinnedSizedBytes (SizeSigDSIGN Ed25519DSIGN))
    deriving (Int -> SigDSIGN Ed25519DSIGN -> ShowS
[SigDSIGN Ed25519DSIGN] -> ShowS
SigDSIGN Ed25519DSIGN -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SigDSIGN Ed25519DSIGN] -> ShowS
$cshowList :: [SigDSIGN Ed25519DSIGN] -> ShowS
show :: SigDSIGN Ed25519DSIGN -> String
$cshow :: SigDSIGN Ed25519DSIGN -> String
showsPrec :: Int -> SigDSIGN Ed25519DSIGN -> ShowS
$cshowsPrec :: Int -> SigDSIGN Ed25519DSIGN -> ShowS
Show, SigDSIGN Ed25519DSIGN -> SigDSIGN Ed25519DSIGN -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SigDSIGN Ed25519DSIGN -> SigDSIGN Ed25519DSIGN -> Bool
$c/= :: SigDSIGN Ed25519DSIGN -> SigDSIGN Ed25519DSIGN -> Bool
== :: SigDSIGN Ed25519DSIGN -> SigDSIGN Ed25519DSIGN -> Bool
$c== :: SigDSIGN Ed25519DSIGN -> SigDSIGN Ed25519DSIGN -> Bool
Eq, forall x. Rep (SigDSIGN Ed25519DSIGN) x -> SigDSIGN Ed25519DSIGN
forall x. SigDSIGN Ed25519DSIGN -> Rep (SigDSIGN Ed25519DSIGN) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (SigDSIGN Ed25519DSIGN) x -> SigDSIGN Ed25519DSIGN
$cfrom :: forall x. SigDSIGN Ed25519DSIGN -> Rep (SigDSIGN Ed25519DSIGN) x
Generic)
    deriving newtype (SigDSIGN Ed25519DSIGN -> ()
forall a. (a -> ()) -> NFData a
rnf :: SigDSIGN Ed25519DSIGN -> ()
$crnf :: SigDSIGN Ed25519DSIGN -> ()
NFData)

  --
  -- Metadata and basic key operations
  --

  algorithmNameDSIGN :: forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
algorithmNameDSIGN proxy Ed25519DSIGN
_ = String
"ed25519"

  deriveVerKeyDSIGN :: SignKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN
deriveVerKeyDSIGN (SignKeyEd25519DSIGN PinnedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk) =
    PinnedSizedBytes (SizeVerKeyDSIGN Ed25519DSIGN)
-> VerKeyDSIGN Ed25519DSIGN
VerKeyEd25519DSIGN forall a b. (a -> b) -> a -> b
$
      forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
        forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr ->
          forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
(SizedPtr n -> m ()) -> m (PinnedSizedBytes n)
psbCreateSized forall a b. (a -> b) -> a -> b
$ \SizedPtr (SizeVerKeyDSIGN Ed25519DSIGN)
pkPtr ->
            String -> String -> IO Int -> IO ()
cOrThrowError String
"deriveVerKeyDSIGN @Ed25519DSIGN" String
"c_crypto_sign_ed25519_sk_to_pk" forall a b. (a -> b) -> a -> b
$
              SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
-> SizedPtr CRYPTO_SIGN_ED25519_BYTES -> IO Int
c_crypto_sign_ed25519_sk_to_pk SizedPtr (SizeVerKeyDSIGN Ed25519DSIGN)
pkPtr SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr

  --
  -- Core algorithm operations
  --

  type Signable Ed25519DSIGN = SignableRepresentation

  signDSIGN :: forall a.
(Signable Ed25519DSIGN a, HasCallStack) =>
ContextDSIGN Ed25519DSIGN
-> a -> SignKeyDSIGN Ed25519DSIGN -> SigDSIGN Ed25519DSIGN
signDSIGN () a
a (SignKeyEd25519DSIGN PinnedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk) =
    let bs :: ByteString
bs = forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a
     in PinnedSizedBytes (SizeSigDSIGN Ed25519DSIGN)
-> SigDSIGN Ed25519DSIGN
SigEd25519DSIGN forall a b. (a -> b) -> a -> b
$
          forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
            forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len) ->
              forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr ->
                forall (n :: Nat) b. KnownNat n => (SizedPtr n -> IO b) -> IO b
allocaSized forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
pkPtr -> do
                  String -> String -> IO Int -> IO ()
cOrThrowError String
"signDSIGN @Ed25519DSIGN" String
"c_crypto_sign_ed25519_sk_to_pk" forall a b. (a -> b) -> a -> b
$
                    SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
-> SizedPtr CRYPTO_SIGN_ED25519_BYTES -> IO Int
c_crypto_sign_ed25519_sk_to_pk SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
pkPtr SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr
                  forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
(SizedPtr n -> m ()) -> m (PinnedSizedBytes n)
psbCreateSized forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_BYTES
sigPtr -> do
                    String -> String -> IO Int -> IO ()
cOrThrowError String
"signDSIGN @Ed25519DSIGN" String
"c_crypto_sign_ed25519_detached" forall a b. (a -> b) -> a -> b
$
                      SizedPtr CRYPTO_SIGN_ED25519_BYTES
-> Ptr CULLong
-> Ptr CUChar
-> CULLong
-> SizedPtr CRYPTO_SIGN_ED25519_BYTES
-> IO Int
c_crypto_sign_ed25519_detached SizedPtr CRYPTO_SIGN_ED25519_BYTES
sigPtr forall a. Ptr a
nullPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr

  verifyDSIGN :: forall a.
(Signable Ed25519DSIGN a, HasCallStack) =>
ContextDSIGN Ed25519DSIGN
-> VerKeyDSIGN Ed25519DSIGN
-> a
-> SigDSIGN Ed25519DSIGN
-> Either String ()
verifyDSIGN () (VerKeyEd25519DSIGN PinnedSizedBytes (SizeVerKeyDSIGN Ed25519DSIGN)
vk) a
a (SigEd25519DSIGN PinnedSizedBytes (SizeSigDSIGN Ed25519DSIGN)
sig) =
    let bs :: ByteString
bs = forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a
     in forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
          forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len) ->
            forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes (SizeVerKeyDSIGN Ed25519DSIGN)
vk forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
vkPtr ->
              forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes (SizeSigDSIGN Ed25519DSIGN)
sig forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_BYTES
sigPtr -> do
                Int
res <- SizedPtr CRYPTO_SIGN_ED25519_BYTES
-> Ptr CUChar
-> CULLong
-> SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
-> IO Int
c_crypto_sign_ed25519_verify_detached SizedPtr CRYPTO_SIGN_ED25519_BYTES
sigPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
vkPtr
                if Int
res forall a. Eq a => a -> a -> Bool
== Int
0
                  then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ())
                  else do
                    -- errno <- getErrno
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left String
"Verification failed")

  --
  -- Key generation
  --
  genKeyDSIGN :: Seed -> SignKeyDSIGN Ed25519DSIGN
genKeyDSIGN Seed
seed =
    PinnedSizedBytes CRYPTO_SIGN_ED25519_BYTES
-> SignKeyDSIGN Ed25519DSIGN
SignKeyEd25519DSIGN forall a b. (a -> b) -> a -> b
$
      let (ByteString
sb, Seed
_) = Word -> Seed -> (ByteString, Seed)
getBytesFromSeedT (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
seedSizeDSIGN (forall {k} (t :: k). Proxy t
Proxy @Ed25519DSIGN)) Seed
seed
       in forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
            forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
(SizedPtr n -> m ()) -> m (PinnedSizedBytes n)
psbCreateSized forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr ->
              forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
sb forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
seedPtr, Int
_) ->
                forall (n :: Nat) b. KnownNat n => (SizedPtr n -> IO b) -> IO b
allocaSized forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
pkPtr -> do
                  String -> String -> IO Int -> IO ()
cOrThrowError String
"genKeyDSIGN @Ed25519DSIGN" String
"c_crypto_sign_ed25519_seed_keypair" forall a b. (a -> b) -> a -> b
$
                    SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
-> SizedPtr CRYPTO_SIGN_ED25519_BYTES
-> SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
-> IO Int
c_crypto_sign_ed25519_seed_keypair SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
pkPtr SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr (forall (n :: Nat). Ptr Void -> SizedPtr n
SizedPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ Ptr CChar
seedPtr)

  --
  -- raw serialise/deserialise
  --

  rawSerialiseVerKeyDSIGN :: VerKeyDSIGN Ed25519DSIGN -> ByteString
rawSerialiseVerKeyDSIGN (VerKeyEd25519DSIGN PinnedSizedBytes (SizeVerKeyDSIGN Ed25519DSIGN)
vk) = forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString PinnedSizedBytes (SizeVerKeyDSIGN Ed25519DSIGN)
vk
  rawSerialiseSignKeyDSIGN :: SignKeyDSIGN Ed25519DSIGN -> ByteString
rawSerialiseSignKeyDSIGN (SignKeyEd25519DSIGN PinnedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk) =
    forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString @(SeedSizeDSIGN Ed25519DSIGN) forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
      forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
(SizedPtr n -> m ()) -> m (PinnedSizedBytes n)
psbCreateSized forall a b. (a -> b) -> a -> b
$ \SizedPtr (SeedSizeDSIGN Ed25519DSIGN)
seedPtr ->
        forall (n :: Nat) r (m :: * -> *).
MonadST m =>
PinnedSizedBytes n -> (SizedPtr n -> m r) -> m r
psbUseAsSizedPtr PinnedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr ->
          String -> String -> IO Int -> IO ()
cOrThrowError String
"deriveVerKeyDSIGN @Ed25519DSIGN" String
"c_crypto_sign_ed25519_sk_to_seed" forall a b. (a -> b) -> a -> b
$
            SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
-> SizedPtr CRYPTO_SIGN_ED25519_BYTES -> IO Int
c_crypto_sign_ed25519_sk_to_seed SizedPtr (SeedSizeDSIGN Ed25519DSIGN)
seedPtr SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr

  rawSerialiseSigDSIGN :: SigDSIGN Ed25519DSIGN -> ByteString
rawSerialiseSigDSIGN (SigEd25519DSIGN PinnedSizedBytes (SizeSigDSIGN Ed25519DSIGN)
sig) = forall (n :: Nat). PinnedSizedBytes n -> ByteString
psbToByteString PinnedSizedBytes (SizeSigDSIGN Ed25519DSIGN)
sig

  rawDeserialiseVerKeyDSIGN :: ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
rawDeserialiseVerKeyDSIGN = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PinnedSizedBytes (SizeVerKeyDSIGN Ed25519DSIGN)
-> VerKeyDSIGN Ed25519DSIGN
VerKeyEd25519DSIGN forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat).
KnownNat n =>
ByteString -> Maybe (PinnedSizedBytes n)
psbFromByteStringCheck
  {-# INLINE rawDeserialiseVerKeyDSIGN #-}
  rawDeserialiseSignKeyDSIGN :: ByteString -> Maybe (SignKeyDSIGN Ed25519DSIGN)
rawDeserialiseSignKeyDSIGN ByteString
bs = do
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs) forall a. Eq a => a -> a -> Bool
== forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
seedSizeDSIGN (forall {k} (t :: k). Proxy t
Proxy @Ed25519DSIGN))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Seed
mkSeedFromBytes forall a b. (a -> b) -> a -> b
$ ByteString
bs
  rawDeserialiseSigDSIGN :: ByteString -> Maybe (SigDSIGN Ed25519DSIGN)
rawDeserialiseSigDSIGN = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PinnedSizedBytes (SizeSigDSIGN Ed25519DSIGN)
-> SigDSIGN Ed25519DSIGN
SigEd25519DSIGN forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat).
KnownNat n =>
ByteString -> Maybe (PinnedSizedBytes n)
psbFromByteStringCheck
  {-# INLINE rawDeserialiseSigDSIGN #-}

instance DSIGNMAlgorithm Ed25519DSIGN where
  -- Note that the size of the internal key data structure is the SECRET KEY
  -- bytes as per libsodium, while the declared key size (for serialization)
  -- is libsodium's SEED bytes. We expand 32-octet keys to 64-octet ones
  -- during deserialization, and we delete the 32 octets that contain the
  -- public key from the secret key before serializing.
  newtype SignKeyDSIGNM Ed25519DSIGN
    = SignKeyEd25519DSIGNM (MLockedSizedBytes CRYPTO_SIGN_ED25519_SECRETKEYBYTES)
    deriving (Int -> SignKeyDSIGNM Ed25519DSIGN -> ShowS
[SignKeyDSIGNM Ed25519DSIGN] -> ShowS
SignKeyDSIGNM Ed25519DSIGN -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignKeyDSIGNM Ed25519DSIGN] -> ShowS
$cshowList :: [SignKeyDSIGNM Ed25519DSIGN] -> ShowS
show :: SignKeyDSIGNM Ed25519DSIGN -> String
$cshow :: SignKeyDSIGNM Ed25519DSIGN -> String
showsPrec :: Int -> SignKeyDSIGNM Ed25519DSIGN -> ShowS
$cshowsPrec :: Int -> SignKeyDSIGNM Ed25519DSIGN -> ShowS
Show)

  deriveVerKeyDSIGNM :: forall (m :: * -> *).
(MonadThrow m, MonadST m) =>
SignKeyDSIGNM Ed25519DSIGN -> m (VerKeyDSIGN Ed25519DSIGN)
deriveVerKeyDSIGNM (SignKeyEd25519DSIGNM MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk) =
    PinnedSizedBytes (SizeVerKeyDSIGN Ed25519DSIGN)
-> VerKeyDSIGN Ed25519DSIGN
VerKeyEd25519DSIGN forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
      forall (n :: Nat) r (m :: * -> *).
MonadST m =>
MLockedSizedBytes n -> (SizedPtr n -> m r) -> m r
mlsbUseAsSizedPtr MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr -> do
        (PinnedSizedBytes CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
psb, Maybe Errno
maybeErrno) <-
          forall (n :: Nat) r (m :: * -> *).
(KnownNat n, MonadST m) =>
(SizedPtr n -> m r) -> m (PinnedSizedBytes n, r)
psbCreateSizedResult forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
pkPtr ->
            forall (m :: * -> *) a. MonadST m => ST (PrimState m) a -> m a
stToIO forall a b. (a -> b) -> a -> b
$ do
              forall (m :: * -> *).
MonadST m =>
(forall s. ST s Int) -> m (Maybe Errno)
cOrError forall a b. (a -> b) -> a -> b
$
                forall a s. IO a -> ST s a
unsafeIOToST forall a b. (a -> b) -> a -> b
$
                  SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
-> SizedPtr CRYPTO_SIGN_ED25519_BYTES -> IO Int
c_crypto_sign_ed25519_sk_to_pk SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
pkPtr SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr
        forall (m :: * -> *).
MonadThrow m =>
String -> String -> Maybe Errno -> m ()
throwOnErrno String
"deriveVerKeyDSIGN @Ed25519DSIGN" String
"c_crypto_sign_ed25519_sk_to_pk" Maybe Errno
maybeErrno
        forall (m :: * -> *) a. Monad m => a -> m a
return PinnedSizedBytes CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
psb

  signDSIGNM :: forall a (m :: * -> *).
(Signable Ed25519DSIGN a, MonadST m, MonadThrow m) =>
ContextDSIGN Ed25519DSIGN
-> a -> SignKeyDSIGNM Ed25519DSIGN -> m (SigDSIGN Ed25519DSIGN)
signDSIGNM () a
a (SignKeyEd25519DSIGNM MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk) =
    let bs :: ByteString
bs = forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a
     in PinnedSizedBytes (SizeSigDSIGN Ed25519DSIGN)
-> SigDSIGN Ed25519DSIGN
SigEd25519DSIGN forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
          forall (n :: Nat) r (m :: * -> *).
MonadST m =>
MLockedSizedBytes n -> (SizedPtr n -> m r) -> m r
mlsbUseAsSizedPtr MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr -> do
            (PinnedSizedBytes CRYPTO_SIGN_ED25519_BYTES
psb, Maybe Errno
maybeErrno) <-
              forall (n :: Nat) r (m :: * -> *).
(KnownNat n, MonadST m) =>
(SizedPtr n -> m r) -> m (PinnedSizedBytes n, r)
psbCreateSizedResult forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_BYTES
sigPtr ->
                forall (m :: * -> *) a. MonadST m => ST (PrimState m) a -> m a
stToIO forall a b. (a -> b) -> a -> b
$ do
                  forall (m :: * -> *).
MonadST m =>
(forall s. ST s Int) -> m (Maybe Errno)
cOrError forall a b. (a -> b) -> a -> b
$ forall a s. IO a -> ST s a
unsafeIOToST forall a b. (a -> b) -> a -> b
$ do
                    forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
ptr, Int
len) ->
                      SizedPtr CRYPTO_SIGN_ED25519_BYTES
-> Ptr CULLong
-> Ptr CUChar
-> CULLong
-> SizedPtr CRYPTO_SIGN_ED25519_BYTES
-> IO Int
c_crypto_sign_ed25519_detached SizedPtr CRYPTO_SIGN_ED25519_BYTES
sigPtr forall a. Ptr a
nullPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr
            forall (m :: * -> *).
MonadThrow m =>
String -> String -> Maybe Errno -> m ()
throwOnErrno String
"signDSIGNM @Ed25519DSIGN" String
"c_crypto_sign_ed25519_detached" Maybe Errno
maybeErrno
            forall (m :: * -> *) a. Monad m => a -> m a
return PinnedSizedBytes CRYPTO_SIGN_ED25519_BYTES
psb

  --
  -- Key generation
  --
  {-# NOINLINE genKeyDSIGNMWith #-}
  genKeyDSIGNMWith :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeDSIGN Ed25519DSIGN)
-> m (SignKeyDSIGNM Ed25519DSIGN)
genKeyDSIGNMWith MLockedAllocator m
allocator MLockedSeed (SeedSizeDSIGN Ed25519DSIGN)
seed =
    MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
-> SignKeyDSIGNM Ed25519DSIGN
SignKeyEd25519DSIGNM forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> do
      MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk <- forall (n :: Nat) (m :: * -> *).
MLockedAllocator m
-> (KnownNat n, MonadST m) => m (MLockedSizedBytes n)
mlsbNewWith MLockedAllocator m
allocator
      forall (n :: Nat) r (m :: * -> *).
MonadST m =>
MLockedSizedBytes n -> (SizedPtr n -> m r) -> m r
mlsbUseAsSizedPtr MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr ->
        forall (m :: * -> *) (n :: Nat) b.
MonadST m =>
MLockedSeed n -> (Ptr Word8 -> m b) -> m b
mlockedSeedUseAsCPtr MLockedSeed (SeedSizeDSIGN Ed25519DSIGN)
seed forall a b. (a -> b) -> a -> b
$ \Ptr Word8
seedPtr -> do
          Maybe Errno
maybeErrno <- forall (m :: * -> *) a. MonadST m => ST (PrimState m) a -> m a
stToIO forall a b. (a -> b) -> a -> b
$ forall {n :: Nat} {a} {s}.
KnownNat n =>
(SizedPtr n -> ST RealWorld a) -> ST s a
allocaSizedST forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
pkPtr -> do
            forall (m :: * -> *).
MonadST m =>
(forall s. ST s Int) -> m (Maybe Errno)
cOrError forall a b. (a -> b) -> a -> b
$
              forall a s. IO a -> ST s a
unsafeIOToST forall a b. (a -> b) -> a -> b
$
                SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
-> SizedPtr CRYPTO_SIGN_ED25519_BYTES
-> SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
-> IO Int
c_crypto_sign_ed25519_seed_keypair SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
pkPtr SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr (forall (n :: Nat). Ptr Void -> SizedPtr n
SizedPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr forall a b. (a -> b) -> a -> b
$ Ptr Word8
seedPtr)
          forall (m :: * -> *).
MonadThrow m =>
String -> String -> Maybe Errno -> m ()
throwOnErrno String
"genKeyDSIGNM @Ed25519DSIGN" String
"c_crypto_sign_ed25519_seed_keypair" Maybe Errno
maybeErrno
      forall (m :: * -> *) a. Monad m => a -> m a
return MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk
    where
      allocaSizedST :: (SizedPtr n -> ST RealWorld a) -> ST s a
allocaSizedST SizedPtr n -> ST RealWorld a
k =
        forall a s. IO a -> ST s a
unsafeIOToST forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) b. KnownNat n => (SizedPtr n -> IO b) -> IO b
allocaSized forall a b. (a -> b) -> a -> b
$ \SizedPtr n
ptr -> forall (m :: * -> *) a. MonadST m => ST (PrimState m) a -> m a
stToIO forall a b. (a -> b) -> a -> b
$ SizedPtr n -> ST RealWorld a
k SizedPtr n
ptr

  cloneKeyDSIGNMWith :: forall (m :: * -> *).
MonadST m =>
MLockedAllocator m
-> SignKeyDSIGNM Ed25519DSIGN -> m (SignKeyDSIGNM Ed25519DSIGN)
cloneKeyDSIGNMWith MLockedAllocator m
allocator (SignKeyEd25519DSIGNM MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk) =
    MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
-> SignKeyDSIGNM Ed25519DSIGN
SignKeyEd25519DSIGNM forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedAllocator m
-> MLockedSizedBytes n -> m (MLockedSizedBytes n)
mlsbCopyWith MLockedAllocator m
allocator MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk

  getSeedDSIGNMWith :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> Proxy Ed25519DSIGN
-> SignKeyDSIGNM Ed25519DSIGN
-> m (MLockedSeed (SeedSizeDSIGN Ed25519DSIGN))
getSeedDSIGNMWith MLockedAllocator m
allocator Proxy Ed25519DSIGN
_ (SignKeyEd25519DSIGNM MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk) = do
    MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed <- forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedAllocator m -> m (MLockedSeed n)
mlockedSeedNewWith MLockedAllocator m
allocator
    forall (n :: Nat) r (m :: * -> *).
MonadST m =>
MLockedSizedBytes n -> (SizedPtr n -> m r) -> m r
mlsbUseAsSizedPtr MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr ->
      forall (m :: * -> *) (n :: Nat) b.
MonadST m =>
MLockedSeed n -> (SizedPtr n -> m b) -> m b
mlockedSeedUseAsSizedPtr MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed forall a b. (a -> b) -> a -> b
$ \SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seedPtr -> do
        Maybe Errno
maybeErrno <-
          forall (m :: * -> *) a. MonadST m => ST (PrimState m) a -> m a
stToIO forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *).
MonadST m =>
(forall s. ST s Int) -> m (Maybe Errno)
cOrError forall a b. (a -> b) -> a -> b
$
              forall a s. IO a -> ST s a
unsafeIOToST forall a b. (a -> b) -> a -> b
$
                SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
-> SizedPtr CRYPTO_SIGN_ED25519_BYTES -> IO Int
c_crypto_sign_ed25519_sk_to_seed SizedPtr CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seedPtr SizedPtr CRYPTO_SIGN_ED25519_BYTES
skPtr
        forall (m :: * -> *).
MonadThrow m =>
String -> String -> Maybe Errno -> m ()
throwOnErrno String
"genKeyDSIGNM @Ed25519DSIGN" String
"c_crypto_sign_ed25519_seed_keypair" Maybe Errno
maybeErrno
    forall (m :: * -> *) a. Monad m => a -> m a
return MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed

  --
  -- Secure forgetting
  --
  forgetSignKeyDSIGNMWith :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m -> SignKeyDSIGNM Ed25519DSIGN -> m ()
forgetSignKeyDSIGNMWith MLockedAllocator m
_ (SignKeyEd25519DSIGNM MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk) = forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
mlsbFinalize MLockedSizedBytes CRYPTO_SIGN_ED25519_BYTES
sk

instance UnsoundDSIGNMAlgorithm Ed25519DSIGN where
  --
  -- Ser/deser (dangerous - do not use in production code)
  --
  rawSerialiseSignKeyDSIGNM :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
SignKeyDSIGNM Ed25519DSIGN -> m ByteString
rawSerialiseSignKeyDSIGNM SignKeyDSIGNM Ed25519DSIGN
sk = do
    MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed <- forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
Proxy v -> SignKeyDSIGNM v -> m (MLockedSeed (SeedSizeDSIGN v))
getSeedDSIGNM (forall {k} (t :: k). Proxy t
Proxy @Ed25519DSIGN) SignKeyDSIGNM Ed25519DSIGN
sk
    -- We need to copy the seed into unsafe memory and finalize the MLSB, in
    -- order to avoid leaking mlocked memory. This will, however, expose the
    -- secret seed to the unprotected Haskell heap (see 'mlsbToByteString').
    ByteString
raw <- forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
mlsbToByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). MLockedSeed n -> MLockedSizedBytes n
mlockedSeedMLSB forall a b. (a -> b) -> a -> b
$ MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed
    forall (m :: * -> *) (n :: Nat). MonadST m => MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed
    forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
raw

  rawDeserialiseSignKeyDSIGNMWith :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
MLockedAllocator m
-> ByteString -> m (Maybe (SignKeyDSIGNM Ed25519DSIGN))
rawDeserialiseSignKeyDSIGNMWith MLockedAllocator m
allocator ByteString
raw = do
    Maybe (MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES)
mseed <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (n :: Nat). MLockedSizedBytes n -> MLockedSeed n
MLockedSeed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedAllocator m -> ByteString -> m (Maybe (MLockedSizedBytes n))
mlsbFromByteStringCheckWith MLockedAllocator m
allocator ByteString
raw
    case Maybe (MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES)
mseed of
      Maybe (MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Just MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed -> do
        Maybe (SignKeyDSIGNM Ed25519DSIGN)
sk <- forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedAllocator m
-> MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
genKeyDSIGNMWith MLockedAllocator m
allocator MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed
        forall (m :: * -> *) (n :: Nat). MonadST m => MLockedSeed n -> m ()
mlockedSeedFinalize MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed
        forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SignKeyDSIGNM Ed25519DSIGN)
sk

instance ToCBOR (VerKeyDSIGN Ed25519DSIGN) where
  toCBOR :: VerKeyDSIGN Ed25519DSIGN -> Encoding
toCBOR = forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> Encoding
encodeVerKeyDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerKeyDSIGN Ed25519DSIGN) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = forall v. DSIGNAlgorithm v => Proxy (VerKeyDSIGN v) -> Size
encodedVerKeyDSIGNSizeExpr

instance FromCBOR (VerKeyDSIGN Ed25519DSIGN) where
  fromCBOR :: forall s. Decoder s (VerKeyDSIGN Ed25519DSIGN)
fromCBOR = forall v s. DSIGNAlgorithm v => Decoder s (VerKeyDSIGN v)
decodeVerKeyDSIGN

instance ToCBOR (SignKeyDSIGN Ed25519DSIGN) where
  toCBOR :: SignKeyDSIGN Ed25519DSIGN -> Encoding
toCBOR = forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> Encoding
encodeSignKeyDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SignKeyDSIGN Ed25519DSIGN) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = forall v. DSIGNAlgorithm v => Proxy (SignKeyDSIGN v) -> Size
encodedSignKeyDSIGNSizeExpr

instance FromCBOR (SignKeyDSIGN Ed25519DSIGN) where
  fromCBOR :: forall s. Decoder s (SignKeyDSIGN Ed25519DSIGN)
fromCBOR = forall v s. DSIGNAlgorithm v => Decoder s (SignKeyDSIGN v)
decodeSignKeyDSIGN

instance ToCBOR (SigDSIGN Ed25519DSIGN) where
  toCBOR :: SigDSIGN Ed25519DSIGN -> Encoding
toCBOR = forall v. DSIGNAlgorithm v => SigDSIGN v -> Encoding
encodeSigDSIGN
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigDSIGN Ed25519DSIGN) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = forall v. DSIGNAlgorithm v => Proxy (SigDSIGN v) -> Size
encodedSigDSIGNSizeExpr

instance FromCBOR (SigDSIGN Ed25519DSIGN) where
  fromCBOR :: forall s. Decoder s (SigDSIGN Ed25519DSIGN)
fromCBOR = forall v s. DSIGNAlgorithm v => Decoder s (SigDSIGN v)
decodeSigDSIGN

instance
  TypeError ('Text "CBOR encoding would violate mlocking guarantees") =>
  ToCBOR (SignKeyDSIGNM Ed25519DSIGN)
  where
  toCBOR :: SignKeyDSIGNM Ed25519DSIGN -> Encoding
toCBOR = forall a. HasCallStack => String -> a
error String
"unsupported"
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SignKeyDSIGNM Ed25519DSIGN) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = forall a. HasCallStack => String -> a
error String
"unsupported"

instance
  TypeError ('Text "CBOR decoding would violate mlocking guarantees") =>
  FromCBOR (SignKeyDSIGNM Ed25519DSIGN)
  where
  fromCBOR :: forall s. Decoder s (SignKeyDSIGNM Ed25519DSIGN)
fromCBOR = forall a. HasCallStack => String -> a
error String
"unsupported"

instance DirectSerialise (SignKeyDSIGNM Ed25519DSIGN) where
  -- /Note:/ We only serialize the 32-byte seed, not the full 64-byte key. The
  -- latter contains both the seed and the 32-byte verification key, which is
  -- convenient, but redundant, since we can always reconstruct it from the
  -- seed. This is also reflected in the 'SizeSignKeyDSIGNM', which equals
  -- 'SeedSizeDSIGNM' == 32, rather than reporting the in-memory size of 64.
  directSerialise :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> SignKeyDSIGNM Ed25519DSIGN -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push SignKeyDSIGNM Ed25519DSIGN
sk = do
    forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
      (forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
Proxy v -> SignKeyDSIGNM v -> m (MLockedSeed (SeedSizeDSIGN v))
getSeedDSIGNM (forall {k} (t :: k). Proxy t
Proxy @Ed25519DSIGN) SignKeyDSIGNM Ed25519DSIGN
sk)
      forall (m :: * -> *) (n :: Nat). MonadST m => MLockedSeed n -> m ()
mlockedSeedFinalize
      ( \MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed -> forall (m :: * -> *) (n :: Nat) b.
MonadST m =>
MLockedSeed n -> (Ptr Word8 -> m b) -> m b
mlockedSeedUseAsCPtr MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
          Ptr CChar -> CSize -> m ()
push
            (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr)
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
seedSizeDSIGN (forall {k} (t :: k). Proxy t
Proxy @Ed25519DSIGN))
      )

instance DirectDeserialise (SignKeyDSIGNM Ed25519DSIGN) where
  -- /Note:/ We only serialize the 32-byte seed, not the full 64-byte key. See
  -- the DirectSerialise instance above.
  directDeserialise :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m (SignKeyDSIGNM Ed25519DSIGN)
directDeserialise Ptr CChar -> CSize -> m ()
pull = do
    forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
      forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
m (MLockedSeed n)
mlockedSeedNew
      forall (m :: * -> *) (n :: Nat). MonadST m => MLockedSeed n -> m ()
mlockedSeedFinalize
      ( \MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed -> do
          forall (m :: * -> *) (n :: Nat) b.
MonadST m =>
MLockedSeed n -> (Ptr Word8 -> m b) -> m b
mlockedSeedUseAsCPtr MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
            Ptr CChar -> CSize -> m ()
pull
              (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr)
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
seedSizeDSIGN (forall {k} (t :: k). Proxy t
Proxy @Ed25519DSIGN))
          forall v (m :: * -> *).
(DSIGNMAlgorithm v, MonadST m, MonadThrow m) =>
MLockedSeed (SeedSizeDSIGN v) -> m (SignKeyDSIGNM v)
genKeyDSIGNM MLockedSeed CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
seed
      )

instance DirectSerialise (VerKeyDSIGN Ed25519DSIGN) where
  directSerialise :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> VerKeyDSIGN Ed25519DSIGN -> m ()
directSerialise Ptr CChar -> CSize -> m ()
push (VerKeyEd25519DSIGN PinnedSizedBytes (SizeVerKeyDSIGN Ed25519DSIGN)
psb) = do
    forall (n :: Nat) r (m :: * -> *).
(KnownNat n, MonadST m) =>
PinnedSizedBytes n -> (Ptr Word8 -> CSize -> m r) -> m r
psbUseAsCPtrLen PinnedSizedBytes (SizeVerKeyDSIGN Ed25519DSIGN)
psb forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr CSize
_ ->
      Ptr CChar -> CSize -> m ()
push
        (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr)
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @Ed25519DSIGN))

instance DirectDeserialise (VerKeyDSIGN Ed25519DSIGN) where
  directDeserialise :: forall (m :: * -> *).
(MonadST m, MonadThrow m) =>
(Ptr CChar -> CSize -> m ()) -> m (VerKeyDSIGN Ed25519DSIGN)
directDeserialise Ptr CChar -> CSize -> m ()
pull = do
    PinnedSizedBytes CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
psb <- forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
(Ptr Word8 -> m ()) -> m (PinnedSizedBytes n)
psbCreate forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
      Ptr CChar -> CSize -> m ()
pull
        (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr)
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeVerKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @Ed25519DSIGN))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! PinnedSizedBytes (SizeVerKeyDSIGN Ed25519DSIGN)
-> VerKeyDSIGN Ed25519DSIGN
VerKeyEd25519DSIGN PinnedSizedBytes CRYPTO_SIGN_ED25519_PUBLICKEYBYTES
psb