{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
--
-- Module: Sel.PublicKey.Signature
-- Description: Public-key signatures with the Ed25519 algorithm
-- Copyright: (C) Hécate Moonlight 2022
-- License: BSD-3-Clause
-- Maintainer: The Haskell Cryptography Group
-- Portability: GHC only
module Sel.PublicKey.Signature
  ( -- ** Introduction
    -- $introduction
    PublicKey
  , SecretKey
  , SignedMessage

    -- ** Key Pair generation
  , generateKeyPair

    -- ** Message Signing
  , signMessage
  , openMessage

    -- ** Constructing and Deconstructing
  , getSignature
  , unsafeGetMessage
  , mkSignature
  )
where

import Control.Monad (void)
import Data.ByteString (StrictByteString)
import Data.ByteString.Unsafe (unsafePackMallocCStringLen)
import qualified Data.ByteString.Unsafe as ByteString
import Foreign
  ( ForeignPtr
  , Ptr
  , castPtr
  , mallocBytes
  , mallocForeignPtrBytes
  , withForeignPtr
  )
import Foreign.C (CChar, CSize, CUChar, CULLong)
import qualified Foreign.Marshal.Array as Foreign
import qualified Foreign.Ptr as Foreign
import GHC.IO.Handle.Text (memcpy)
import System.IO.Unsafe (unsafeDupablePerformIO)

import LibSodium.Bindings.CryptoSign
  ( cryptoSignBytes
  , cryptoSignDetached
  , cryptoSignKeyPair
  , cryptoSignPublicKeyBytes
  , cryptoSignSecretKeyBytes
  , cryptoSignVerifyDetached
  )
import Sel.Internal

-- $introduction
--
-- Public-key Signatures work with a 'SecretKey' and 'PublicKey'
--
-- * The 'SecretKey' is used to append a signature to any number of messages. It must stay private;
-- * The 'PublicKey' is used by third-parties to to verify that the signature appended to a message was
-- issued by the creator of the public key. It must be distributed to third-parties.
--
-- Verifiers need to already know and ultimately trust a public key before messages signed
-- using it can be verified.

-- |
--
-- @since 0.0.1.0
newtype PublicKey = PublicKey (ForeignPtr CUChar)

-- |
--
-- @since 0.0.1.0
instance Eq PublicKey where
  (PublicKey ForeignPtr CUChar
pk1) == :: PublicKey -> PublicKey -> Bool
== (PublicKey ForeignPtr CUChar
pk2) =
    IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Bool
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool
foreignPtrEq ForeignPtr CUChar
pk1 ForeignPtr CUChar
pk2 CSize
cryptoSignPublicKeyBytes

-- |
--
-- @since 0.0.1.0
instance Ord PublicKey where
  compare :: PublicKey -> PublicKey -> Ordering
compare (PublicKey ForeignPtr CUChar
pk1) (PublicKey ForeignPtr CUChar
pk2) =
    IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Ordering
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering
foreignPtrOrd ForeignPtr CUChar
pk1 ForeignPtr CUChar
pk2 CSize
cryptoSignPublicKeyBytes

-- |
--
-- @since 0.0.1.0
newtype SecretKey = SecretKey (ForeignPtr CUChar)

-- |
--
-- @since 0.0.1.0
instance Eq SecretKey where
  (SecretKey ForeignPtr CUChar
sk1) == :: SecretKey -> SecretKey -> Bool
== (SecretKey ForeignPtr CUChar
sk2) =
    IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Bool
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool
foreignPtrEq ForeignPtr CUChar
sk1 ForeignPtr CUChar
sk2 CSize
cryptoSignSecretKeyBytes

-- |
--
-- @since 0.0.1.0
instance Ord SecretKey where
  compare :: SecretKey -> SecretKey -> Ordering
compare (SecretKey ForeignPtr CUChar
sk1) (SecretKey ForeignPtr CUChar
sk2) =
    IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Ordering
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering
foreignPtrOrd ForeignPtr CUChar
sk1 ForeignPtr CUChar
sk2 CSize
cryptoSignSecretKeyBytes

-- |
--
-- @since 0.0.1.0
data SignedMessage = SignedMessage
  { SignedMessage -> CSize
messageLength :: CSize
  , SignedMessage -> ForeignPtr CUChar
messageForeignPtr :: ForeignPtr CUChar
  , SignedMessage -> ForeignPtr CUChar
signatureForeignPtr :: ForeignPtr CUChar
  }

-- |
--
-- @since 0.0.1.0
instance Eq SignedMessage where
  (SignedMessage CSize
len1 ForeignPtr CUChar
msg1 ForeignPtr CUChar
sig1) == :: SignedMessage -> SignedMessage -> Bool
== (SignedMessage CSize
len2 ForeignPtr CUChar
msg2 ForeignPtr CUChar
sig2) =
    IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
      Bool
result1 <- ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Bool
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool
foreignPtrEq ForeignPtr CUChar
msg1 ForeignPtr CUChar
msg2 CSize
len1
      Bool
result2 <- ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Bool
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool
foreignPtrEq ForeignPtr CUChar
sig1 ForeignPtr CUChar
sig2 CSize
cryptoSignBytes
      Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (CSize
len1 CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
== CSize
len2) Bool -> Bool -> Bool
&& Bool
result1 Bool -> Bool -> Bool
&& Bool
result2

-- |
--
-- @since 0.0.1.0
instance Ord SignedMessage where
  compare :: SignedMessage -> SignedMessage -> Ordering
compare (SignedMessage CSize
len1 ForeignPtr CUChar
msg1 ForeignPtr CUChar
sig1) (SignedMessage CSize
len2 ForeignPtr CUChar
msg2 ForeignPtr CUChar
sig2) =
    IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ do
      Ordering
result1 <- ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Ordering
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering
foreignPtrOrd ForeignPtr CUChar
msg1 ForeignPtr CUChar
msg2 CSize
len1
      Ordering
result2 <- ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Ordering
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering
foreignPtrOrd ForeignPtr CUChar
sig1 ForeignPtr CUChar
sig2 CSize
cryptoSignBytes
      Ordering -> IO Ordering
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ordering -> IO Ordering) -> Ordering -> IO Ordering
forall a b. (a -> b) -> a -> b
$ CSize -> CSize -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CSize
len1 CSize
len2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
result1 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
result2

-- | Generate a pair of public and secret key.
--
-- The length parameters used are 'cryptoSignPublicKeyBytes'
-- and 'cryptoSignSecretKeyBytes'.
--
-- @since 0.0.1.0
generateKeyPair :: IO (PublicKey, SecretKey)
generateKeyPair :: IO (PublicKey, SecretKey)
generateKeyPair = do
  ForeignPtr CUChar
publicKeyForeignPtr <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @Int CSize
cryptoSignPublicKeyBytes)
  ForeignPtr CUChar
secretKeyForeignPtr <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @Int CSize
cryptoSignSecretKeyBytes)
  ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
publicKeyForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
pkPtr ->
    ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
secretKeyForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
skPtr ->
      IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
        Ptr CUChar -> Ptr CUChar -> IO CInt
cryptoSignKeyPair
          Ptr CUChar
pkPtr
          Ptr CUChar
skPtr
  (PublicKey, SecretKey) -> IO (PublicKey, SecretKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr CUChar -> PublicKey
PublicKey ForeignPtr CUChar
publicKeyForeignPtr, ForeignPtr CUChar -> SecretKey
SecretKey ForeignPtr CUChar
secretKeyForeignPtr)

-- | Sign a message.
--
-- @since 0.0.1.0
signMessage :: StrictByteString -> SecretKey -> IO SignedMessage
signMessage :: StrictByteString -> SecretKey -> IO SignedMessage
signMessage StrictByteString
message (SecretKey ForeignPtr CUChar
skFPtr) =
  StrictByteString
-> (CStringLen -> IO SignedMessage) -> IO SignedMessage
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
ByteString.unsafeUseAsCStringLen StrictByteString
message ((CStringLen -> IO SignedMessage) -> IO SignedMessage)
-> (CStringLen -> IO SignedMessage) -> IO SignedMessage
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cString, Int
messageLength) -> do
    let sigLength :: Int
sigLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @Int CSize
cryptoSignBytes
    (ForeignPtr CUChar
messageForeignPtr :: ForeignPtr CUChar) <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes Int
messageLength
    ForeignPtr CUChar
signatureForeignPtr <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes Int
sigLength
    ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
messageForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
messagePtr ->
      ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
signatureForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
signaturePtr ->
        ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
skFPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
skPtr -> do
          Ptr CUChar -> Ptr CUChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray Ptr CUChar
messagePtr (forall a b. Ptr a -> Ptr b
Foreign.castPtr @CChar @CUChar Ptr CChar
cString) Int
messageLength
          IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr CUChar
-> Ptr CULLong -> Ptr CUChar -> CULLong -> Ptr CUChar -> IO CInt
cryptoSignDetached
              Ptr CUChar
signaturePtr
              Ptr CULLong
forall a. Ptr a
Foreign.nullPtr -- Always of size 'cryptoSignBytes'
              (forall a b. Ptr a -> Ptr b
castPtr @CChar @CUChar Ptr CChar
cString)
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
messageLength)
              Ptr CUChar
skPtr
    SignedMessage -> IO SignedMessage
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SignedMessage -> IO SignedMessage)
-> SignedMessage -> IO SignedMessage
forall a b. (a -> b) -> a -> b
$ CSize -> ForeignPtr CUChar -> ForeignPtr CUChar -> SignedMessage
SignedMessage (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
messageLength) ForeignPtr CUChar
messageForeignPtr ForeignPtr CUChar
signatureForeignPtr

-- | Open a signed message with the signatory's public key.
-- The function returns 'Nothing' if there is a key mismatch.
--
-- @since 0.0.1.0
openMessage :: SignedMessage -> PublicKey -> Maybe StrictByteString
openMessage :: SignedMessage -> PublicKey -> Maybe StrictByteString
openMessage SignedMessage{CSize
messageLength :: SignedMessage -> CSize
messageLength :: CSize
messageLength, ForeignPtr CUChar
messageForeignPtr :: SignedMessage -> ForeignPtr CUChar
messageForeignPtr :: ForeignPtr CUChar
messageForeignPtr, ForeignPtr CUChar
signatureForeignPtr :: SignedMessage -> ForeignPtr CUChar
signatureForeignPtr :: ForeignPtr CUChar
signatureForeignPtr} (PublicKey ForeignPtr CUChar
pkForeignPtr) = IO (Maybe StrictByteString) -> Maybe StrictByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe StrictByteString) -> Maybe StrictByteString)
-> IO (Maybe StrictByteString) -> Maybe StrictByteString
forall a b. (a -> b) -> a -> b
$
  ForeignPtr CUChar
-> (Ptr CUChar -> IO (Maybe StrictByteString))
-> IO (Maybe StrictByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
pkForeignPtr ((Ptr CUChar -> IO (Maybe StrictByteString))
 -> IO (Maybe StrictByteString))
-> (Ptr CUChar -> IO (Maybe StrictByteString))
-> IO (Maybe StrictByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
publicKeyPtr ->
    ForeignPtr CUChar
-> (Ptr CUChar -> IO (Maybe StrictByteString))
-> IO (Maybe StrictByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
signatureForeignPtr ((Ptr CUChar -> IO (Maybe StrictByteString))
 -> IO (Maybe StrictByteString))
-> (Ptr CUChar -> IO (Maybe StrictByteString))
-> IO (Maybe StrictByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
signaturePtr -> do
      ForeignPtr CUChar
-> (Ptr CUChar -> IO (Maybe StrictByteString))
-> IO (Maybe StrictByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
messageForeignPtr ((Ptr CUChar -> IO (Maybe StrictByteString))
 -> IO (Maybe StrictByteString))
-> (Ptr CUChar -> IO (Maybe StrictByteString))
-> IO (Maybe StrictByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
messagePtr -> do
        CInt
result <-
          Ptr CUChar -> Ptr CUChar -> CULLong -> Ptr CUChar -> IO CInt
cryptoSignVerifyDetached
            Ptr CUChar
signaturePtr
            Ptr CUChar
messagePtr
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral @CSize @CULLong CSize
messageLength)
            Ptr CUChar
publicKeyPtr
        case CInt
result of
          (-1) -> Maybe StrictByteString -> IO (Maybe StrictByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe StrictByteString
forall a. Maybe a
Nothing
          CInt
_ -> do
            Ptr Any
bsPtr <- Int -> IO (Ptr Any)
forall a. Int -> IO (Ptr a)
mallocBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
messageLength)
            Ptr Any -> Ptr Any -> CSize -> IO (Ptr ())
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr ())
memcpy Ptr Any
bsPtr (Ptr CUChar -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
messagePtr) CSize
messageLength
            StrictByteString -> Maybe StrictByteString
forall a. a -> Maybe a
Just (StrictByteString -> Maybe StrictByteString)
-> IO StrictByteString -> IO (Maybe StrictByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO StrictByteString
unsafePackMallocCStringLen (Ptr Any -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
bsPtr :: Ptr CChar, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
messageLength)

-- | Get the signature part of a 'SignedMessage'.
--
-- @since 0.0.1.0
getSignature :: SignedMessage -> StrictByteString
getSignature :: SignedMessage -> StrictByteString
getSignature SignedMessage{ForeignPtr CUChar
signatureForeignPtr :: SignedMessage -> ForeignPtr CUChar
signatureForeignPtr :: ForeignPtr CUChar
signatureForeignPtr} = IO StrictByteString -> StrictByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO StrictByteString -> StrictByteString)
-> IO StrictByteString -> StrictByteString
forall a b. (a -> b) -> a -> b
$
  ForeignPtr CUChar
-> (Ptr CUChar -> IO StrictByteString) -> IO StrictByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
signatureForeignPtr ((Ptr CUChar -> IO StrictByteString) -> IO StrictByteString)
-> (Ptr CUChar -> IO StrictByteString) -> IO StrictByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
signaturePtr -> do
    Ptr CUChar
bsPtr <- Int -> IO (Ptr CUChar)
forall a. Int -> IO (Ptr a)
Foreign.mallocBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSignBytes)
    Ptr CUChar -> Ptr CUChar -> CSize -> IO (Ptr ())
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr ())
memcpy Ptr CUChar
bsPtr Ptr CUChar
signaturePtr CSize
cryptoSignBytes
    CStringLen -> IO StrictByteString
unsafePackMallocCStringLen (Ptr CUChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr CUChar
bsPtr :: Ptr CChar, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSignBytes)

-- | Get the message part of a 'SignedMessage' __without verifying the signature__.
--
-- @since 0.0.1.0
unsafeGetMessage :: SignedMessage -> StrictByteString
unsafeGetMessage :: SignedMessage -> StrictByteString
unsafeGetMessage SignedMessage{CSize
messageLength :: SignedMessage -> CSize
messageLength :: CSize
messageLength, ForeignPtr CUChar
messageForeignPtr :: SignedMessage -> ForeignPtr CUChar
messageForeignPtr :: ForeignPtr CUChar
messageForeignPtr} = IO StrictByteString -> StrictByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO StrictByteString -> StrictByteString)
-> IO StrictByteString -> StrictByteString
forall a b. (a -> b) -> a -> b
$
  ForeignPtr CUChar
-> (Ptr CUChar -> IO StrictByteString) -> IO StrictByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
messageForeignPtr ((Ptr CUChar -> IO StrictByteString) -> IO StrictByteString)
-> (Ptr CUChar -> IO StrictByteString) -> IO StrictByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
messagePtr -> do
    Ptr CUChar
bsPtr <- Int -> IO (Ptr CUChar)
forall a. Int -> IO (Ptr a)
Foreign.mallocBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
messageLength)
    Ptr CUChar -> Ptr CUChar -> CSize -> IO (Ptr ())
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr ())
memcpy Ptr CUChar
bsPtr Ptr CUChar
messagePtr CSize
messageLength
    CStringLen -> IO StrictByteString
unsafePackMallocCStringLen (Ptr CUChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr CUChar
bsPtr :: Ptr CChar, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
messageLength)

-- | Combine a message and a signature into a 'SignedMessage'.
--
-- @since 0.0.1.0
mkSignature :: StrictByteString -> StrictByteString -> SignedMessage
mkSignature :: StrictByteString -> StrictByteString -> SignedMessage
mkSignature StrictByteString
message StrictByteString
signature = IO SignedMessage -> SignedMessage
forall a. IO a -> a
unsafeDupablePerformIO (IO SignedMessage -> SignedMessage)
-> IO SignedMessage -> SignedMessage
forall a b. (a -> b) -> a -> b
$
  StrictByteString
-> (CStringLen -> IO SignedMessage) -> IO SignedMessage
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
ByteString.unsafeUseAsCStringLen StrictByteString
message ((CStringLen -> IO SignedMessage) -> IO SignedMessage)
-> (CStringLen -> IO SignedMessage) -> IO SignedMessage
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
messageStringPtr, Int
messageLength) ->
    StrictByteString
-> (CStringLen -> IO SignedMessage) -> IO SignedMessage
forall a. StrictByteString -> (CStringLen -> IO a) -> IO a
ByteString.unsafeUseAsCStringLen StrictByteString
signature ((CStringLen -> IO SignedMessage) -> IO SignedMessage)
-> (CStringLen -> IO SignedMessage) -> IO SignedMessage
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
signatureStringPtr, Int
_) -> do
      (ForeignPtr CUChar
messageForeignPtr :: ForeignPtr CUChar) <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes Int
messageLength
      ForeignPtr CUChar
signatureForeignPtr <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSignBytes)
      ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
messageForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
messagePtr ->
        ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CUChar
signatureForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
signaturePtr -> do
          Ptr CUChar -> Ptr CUChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray Ptr CUChar
messagePtr (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr CChar
messageStringPtr) Int
messageLength
          Ptr CUChar -> Ptr CUChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray Ptr CUChar
signaturePtr (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr CChar
signatureStringPtr) (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoSignBytes)
      SignedMessage -> IO SignedMessage
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SignedMessage -> IO SignedMessage)
-> SignedMessage -> IO SignedMessage
forall a b. (a -> b) -> a -> b
$ CSize -> ForeignPtr CUChar -> ForeignPtr CUChar -> SignedMessage
SignedMessage (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
messageLength) ForeignPtr CUChar
messageForeignPtr ForeignPtr CUChar
signatureForeignPtr