Add serde functions to public key signature module

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

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'.
 --

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))

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
+    )

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'