From 40b3ab431ead1bad35e5c88f6870c09d9080b487 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?H=C3=A9cate=20Moonlight?= Date: Sun, 12 May 2024 01:15:43 +0200 Subject: [PATCH] Add serde functions to public key signature module --- cabal.project | 5 +- .../src/LibSodium/Bindings/CryptoSign.hs | 4 +- sel/CHANGELOG.md | 1 + sel/src/Sel/PublicKey/Signature.hs | 199 ++++++++++++++++-- sel/test/Test/PublicKey/Signature.hs | 35 +++ 5 files changed, 229 insertions(+), 15 deletions(-) diff --git a/cabal.project b/cabal.project index e0ec136e..985bc330 100644 --- a/cabal.project +++ b/cabal.project @@ -5,9 +5,12 @@ packages: package libsodium-bindings ghc-options: -Werror +package sel + ghc-options: -Werror + package * ghc-options: -haddock - documentation: True test-show-details: direct tests: True +documentation: True diff --git a/libsodium-bindings/src/LibSodium/Bindings/CryptoSign.hs b/libsodium-bindings/src/LibSodium/Bindings/CryptoSign.hs index a6584e7a..00effdea 100644 --- a/libsodium-bindings/src/LibSodium/Bindings/CryptoSign.hs +++ b/libsodium-bindings/src/LibSodium/Bindings/CryptoSign.hs @@ -321,7 +321,7 @@ foreign import capi "sodium.h crypto_sign_final_verify" -- ^ Returns 0 on success, -1 on error. -- | This function extracts the seed from the --- secret key secret key and copies it into the buffer holding the seed. +-- secret key and copies it into the buffer holding the seed. -- The size of the seed will be equal to 'cryptoSignSeedBytes'. -- -- /See:/ [crypto_sign_ed25519_sk_to_seed()](https://doc.libsodium.org/public-key_cryptography/public-key_signatures#extracting-the-seed-and-the-public-key-from-the-secret-key) @@ -336,7 +336,7 @@ foreign import capi "sodium.h crypto_sign_ed25519_sk_to_seed" -> IO CInt -- ^ Returns 0 on success, -1 on error. --- | This function extracts the public key from the secret key secret key +-- | This function extracts the public key from the secret key -- and copies it into public key. -- The size of public key will be equal to 'cryptoSignPublicKeyBytes'. -- diff --git a/sel/CHANGELOG.md b/sel/CHANGELOG.md index 7f3e267a..849ef754 100644 --- a/sel/CHANGELOG.md +++ b/sel/CHANGELOG.md @@ -3,3 +3,4 @@ ## sel-0.0.2.0 -- XXXX-XX-XX * Add usages of `secureMain` in examples +* Add utility functions and instances to Sel.PublicKey.Signature ([#153](https://github.com/haskell-cryptography/libsodium-bindings/pull/153)) diff --git a/sel/src/Sel/PublicKey/Signature.hs b/sel/src/Sel/PublicKey/Signature.hs index acae5412..432a31f1 100644 --- a/sel/src/Sel/PublicKey/Signature.hs +++ b/sel/src/Sel/PublicKey/Signature.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingVia #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -14,8 +16,15 @@ module Sel.PublicKey.Signature ( -- ** Introduction -- $introduction + + -- ** Public and Secret keys PublicKey + , publicKeyToHexByteString + , publicKeyFromHexByteString + , publicKeyFromSecretKey , SecretKey + , unsafeSecretKeyToHexByteString + , secretKeyFromHexByteString , SignedMessage -- ** Key Pair generation @@ -25,39 +34,51 @@ module Sel.PublicKey.Signature , signMessage , openMessage - -- ** Constructing and Deconstructing + -- ** Constructing and Deconstructing signatures , getSignature , unsafeGetMessage , mkSignature + + -- ** Exceptions + , PublicKeyExtractionException (..) ) where -import Control.Monad (void) +import Control.Monad (void, when) +import qualified Data.Base16.Types as Base16 import Data.ByteString (StrictByteString) -import Data.ByteString.Unsafe (unsafePackMallocCStringLen) +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Internal as ByteString import qualified Data.ByteString.Unsafe as ByteString +import Data.Text.Display (Display, OpaqueInstance (..), ShowInstance (..)) import Foreign ( ForeignPtr , Ptr + , Word8 , 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 qualified Foreign +import Foreign.C (CChar, CSize, CUChar, CULLong, throwErrno) import GHC.IO.Handle.Text (memcpy) import System.IO.Unsafe (unsafeDupablePerformIO) +import Control.Exception (Exception, throw) +import Data.Text (Text) +import qualified Data.Text as Text import LibSodium.Bindings.CryptoSign ( cryptoSignBytes , cryptoSignDetached + , cryptoSignED25519SkToPk , cryptoSignKeyPair , cryptoSignPublicKeyBytes , cryptoSignSecretKeyBytes , cryptoSignVerifyDetached ) +import LibSodium.Bindings.SecureMemory (finalizerSodiumFree, sodiumMalloc) import Sel.Internal -- $introduction @@ -71,10 +92,15 @@ import Sel.Internal -- Verifiers need to already know and ultimately trust a public key before messages signed -- using it can be verified. --- | +-- | A public key of size 'cryptoSignPublicKeyBytes'. -- -- @since 0.0.1.0 newtype PublicKey = PublicKey (ForeignPtr CUChar) + deriving + ( Display + -- ^ @since 0.0.2.0 + ) + via (ShowInstance PublicKey) -- | -- @@ -94,8 +120,90 @@ instance Ord PublicKey where -- | -- +-- @since 0.0.2.0 +instance Show PublicKey where + show = ByteString.unpackChars . publicKeyToHexByteString + +-- | Convert a 'PublicKey' to a hexadecimal-encoded 'StrictByteString'. +-- +-- @since 0.0.2.0 +publicKeyToHexByteString :: PublicKey -> StrictByteString +publicKeyToHexByteString (PublicKey publicKeyForeignPtr) = + Base16.extractBase16 . Base16.encodeBase16' $ + ByteString.fromForeignPtr0 + (Foreign.castForeignPtr @CUChar @Word8 publicKeyForeignPtr) + (fromIntegral @CSize @Int cryptoSignPublicKeyBytes) + +-- | Create a 'PublicKey' from a binary 'StrictByteString' that you have obtained on your own, +-- usually from the network or disk. +-- +-- The input public key, once decoded from base16, must be of length +-- 'cryptoSignKeyBytes'. +-- +-- @since 0.0.1.0 +publicKeyFromHexByteString :: StrictByteString -> Either Text PublicKey +publicKeyFromHexByteString hexNonce = unsafeDupablePerformIO $ + case Base16.decodeBase16Untyped hexNonce of + Right bytestring -> + if ByteString.length bytestring == fromIntegral cryptoSignPublicKeyBytes + then ByteString.unsafeUseAsCStringLen bytestring $ \(outsidePublicKeyPtr, _) -> + fmap Right $ + newPublicKeyWith $ \publicKeyPtr -> + Foreign.copyArray + (Foreign.castPtr @CUChar @CChar publicKeyPtr) + outsidePublicKeyPtr + (fromIntegral cryptoSignPublicKeyBytes) + else pure $ Left $ Text.pack "Public Key is too short" + Left msg -> pure $ Left msg + +-- | Produce the 'PublicKey' from a 'SecretKey'. +-- +-- This function may throw a 'PublicKeyExtractionException' if the operation fails. +-- +-- @since 0.0.2.0 +publicKeyFromSecretKey :: SecretKey -> PublicKey +publicKeyFromSecretKey (SecretKey secretKeyForeignPtr) = unsafeDupablePerformIO $ do + publicKeyForeignPtr <- mallocForeignPtrBytes (fromIntegral @CSize @Int cryptoSignPublicKeyBytes) + withForeignPtr publicKeyForeignPtr $ \pkPtr -> + withForeignPtr secretKeyForeignPtr $ \skPtr -> do + result <- + cryptoSignED25519SkToPk + pkPtr + skPtr + when (result /= 0) $ throw PublicKeyExtractionException + pure (PublicKey publicKeyForeignPtr) + +-- | Prepare memory for a 'SecretKey' and use the provided action to fill it. +-- +-- Memory is allocated with 'LibSodium.Bindings.SecureMemory.sodiumMalloc' (see the note attached there). +-- A finalizer is run when the key is goes out of scope. +-- +-- @since 0.0.1.0 +newPublicKeyWith :: (Foreign.Ptr CUChar -> IO ()) -> IO PublicKey +newPublicKeyWith action = do + ptr <- sodiumMalloc cryptoSignPublicKeyBytes + when (ptr == Foreign.nullPtr) $ do + throwErrno "sodium_malloc" + fPtr <- Foreign.newForeignPtr finalizerSodiumFree ptr + action ptr + pure $ PublicKey fPtr + +-- | A secret key of size 'cryptoSignSecretKeyBytes'. +-- -- @since 0.0.1.0 newtype SecretKey = SecretKey (ForeignPtr CUChar) + deriving + ( Display + -- ^ @since 0.0.2.0 + -- > display secretKey == "[REDACTED]" + ) + via (OpaqueInstance "[REDACTED]" SecretKey) + +-- | > show secretKey == "[REDACTED]" +-- +-- @since 0.0.2.0 +instance Show SecretKey where + show _ = "[REDACTED]" -- | -- @@ -113,11 +221,62 @@ instance Ord SecretKey where unsafeDupablePerformIO $ foreignPtrOrd sk1 sk2 cryptoSignSecretKeyBytes --- | +-- | Convert a 'SecretKey' to a hexadecimal-encoded 'StrictByteString'. +-- +-- ⚠️ Be prudent as to where you store it! +-- +-- @since 0.0.2.0 +unsafeSecretKeyToHexByteString :: SecretKey -> StrictByteString +unsafeSecretKeyToHexByteString (SecretKey secretKeyForeignPtr) = + Base16.extractBase16 . Base16.encodeBase16' $ + ByteString.fromForeignPtr0 + (Foreign.castForeignPtr @CUChar @Word8 secretKeyForeignPtr) + (fromIntegral @CSize @Int cryptoSignSecretKeyBytes) + +-- | Create a 'SecretKey' from a binary 'StrictByteString' that you have obtained on your own, +-- usually from the network or disk. +-- +-- The input secret key, once decoded from base16, must be of length +-- 'cryptoSignKeyBytes'. +-- +-- @since 0.0.1.0 +secretKeyFromHexByteString :: StrictByteString -> Either Text SecretKey +secretKeyFromHexByteString hexNonce = unsafeDupablePerformIO $ + case Base16.decodeBase16Untyped hexNonce of + Right bytestring -> + if ByteString.length bytestring == fromIntegral cryptoSignSecretKeyBytes + then ByteString.unsafeUseAsCStringLen bytestring $ \(outsideSecretKeyPtr, _) -> + fmap Right $ + newSecretKeyWith $ \secretKeyPtr -> + Foreign.copyArray + (Foreign.castPtr @CUChar @CChar secretKeyPtr) + outsideSecretKeyPtr + (fromIntegral cryptoSignSecretKeyBytes) + else pure $ Left $ Text.pack "Secret Key is too short" + Left msg -> pure $ Left msg + +-- | Prepare memory for a 'SecretKey' and use the provided action to fill it. +-- +-- Memory is allocated with 'LibSodium.Bindings.SecureMemory.sodiumMalloc' (see the note attached there). +-- A finalizer is run when the key is goes out of scope. +-- +-- @since 0.0.2.0 +newSecretKeyWith :: (Foreign.Ptr CUChar -> IO ()) -> IO SecretKey +newSecretKeyWith action = do + ptr <- sodiumMalloc cryptoSignSecretKeyBytes + when (ptr == Foreign.nullPtr) $ do + throwErrno "sodium_malloc" + fPtr <- Foreign.newForeignPtr finalizerSodiumFree ptr + action ptr + pure $ SecretKey fPtr + +-- | A message and its signature. +-- The signature is of length 'cryptoSignBytes'. -- -- @since 0.0.1.0 data SignedMessage = SignedMessage { messageLength :: CSize + -- ^ Original message length , messageForeignPtr :: ForeignPtr CUChar , signatureForeignPtr :: ForeignPtr CUChar } @@ -202,7 +361,7 @@ openMessage SignedMessage{messageLength, messageForeignPtr, signatureForeignPtr} _ -> do bsPtr <- mallocBytes (fromIntegral messageLength) memcpy bsPtr (castPtr messagePtr) messageLength - Just <$> unsafePackMallocCStringLen (castPtr bsPtr :: Ptr CChar, fromIntegral messageLength) + Just <$> ByteString.unsafePackMallocCStringLen (castPtr bsPtr :: Ptr CChar, fromIntegral messageLength) -- | Get the signature part of a 'SignedMessage'. -- @@ -212,7 +371,7 @@ getSignature SignedMessage{signatureForeignPtr} = unsafeDupablePerformIO $ withForeignPtr signatureForeignPtr $ \signaturePtr -> do bsPtr <- Foreign.mallocBytes (fromIntegral cryptoSignBytes) memcpy bsPtr signaturePtr cryptoSignBytes - unsafePackMallocCStringLen (Foreign.castPtr bsPtr :: Ptr CChar, fromIntegral cryptoSignBytes) + ByteString.unsafePackMallocCStringLen (Foreign.castPtr bsPtr :: Ptr CChar, fromIntegral cryptoSignBytes) -- | Get the message part of a 'SignedMessage' __without verifying the signature__. -- @@ -222,7 +381,7 @@ unsafeGetMessage SignedMessage{messageLength, messageForeignPtr} = unsafeDupable withForeignPtr messageForeignPtr $ \messagePtr -> do bsPtr <- Foreign.mallocBytes (fromIntegral messageLength) memcpy bsPtr messagePtr messageLength - unsafePackMallocCStringLen (Foreign.castPtr bsPtr :: Ptr CChar, fromIntegral messageLength) + ByteString.unsafePackMallocCStringLen (Foreign.castPtr bsPtr :: Ptr CChar, fromIntegral messageLength) -- | Combine a message and a signature into a 'SignedMessage'. -- @@ -238,3 +397,19 @@ mkSignature message signature = unsafeDupablePerformIO $ Foreign.copyArray messagePtr (Foreign.castPtr messageStringPtr) messageLength Foreign.copyArray signaturePtr (Foreign.castPtr signatureStringPtr) (fromIntegral cryptoSignBytes) pure $ SignedMessage (fromIntegral @Int @CSize messageLength) messageForeignPtr signatureForeignPtr + +-- | +-- @since 0.0.2.0 +data PublicKeyExtractionException = PublicKeyExtractionException + deriving stock + ( Eq + -- ^ @since 0.0.2.0 + , Ord + -- ^ @since 0.0.2.0 + , Show + -- ^ @since 0.0.2.0 + ) + deriving anyclass + ( Exception + -- ^ @since 0.0.2.0 + ) diff --git a/sel/test/Test/PublicKey/Signature.hs b/sel/test/Test/PublicKey/Signature.hs index 22bc5821..82da82f8 100644 --- a/sel/test/Test/PublicKey/Signature.hs +++ b/sel/test/Test/PublicKey/Signature.hs @@ -5,14 +5,40 @@ module Test.PublicKey.Signature where import Sel.PublicKey.Signature import Test.Tasty import Test.Tasty.HUnit +import TestUtils spec :: TestTree spec = testGroup "Signing tests" [ testCase "Sign a message with a public key and decrypt it with a secret key" testSignMessage + , testCase "Extract the public key from a secret key" testExtractPublicKey + , testCase "Round-trip secret key serialisation" testSecretKeySerdeRoundtrip + , testCase "Round-trip public key serialisation" testPublicKeySerdeRoundtrip ] +testSecretKeySerdeRoundtrip :: Assertion +testSecretKeySerdeRoundtrip = do + (_, secretKey) <- generateKeyPair + + let secretKeyByteString = unsafeSecretKeyToHexByteString secretKey + reconstructedSecretKey <- assertRight $ secretKeyFromHexByteString secretKeyByteString + assertEqual + "Secret key cannot be read from hex bytestring" + secretKey + reconstructedSecretKey + +testPublicKeySerdeRoundtrip :: Assertion +testPublicKeySerdeRoundtrip = do + (publicKey, _) <- generateKeyPair + + let publicKeyByteString = publicKeyToHexByteString publicKey + reconstructedPublicKey <- assertRight $ publicKeyFromHexByteString publicKeyByteString + assertEqual + "Public key cannot be read from hex bytestring" + publicKey + reconstructedPublicKey + testSignMessage :: Assertion testSignMessage = do (publicKey, secretKey) <- generateKeyPair @@ -22,3 +48,12 @@ testSignMessage = do "Message is well-opened with the correct key" (Just "hello hello") result + +testExtractPublicKey :: Assertion +testExtractPublicKey = do + (publicKey, secretKey) <- generateKeyPair + let extractedPublicKey' = publicKeyFromSecretKey secretKey + assertEqual + "Public key extracted from Secret Key is not correct" + publicKey + extractedPublicKey'