/
Signing.hs
185 lines (170 loc) · 6.74 KB
/
Signing.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
-- |
--
-- Module: Sel.Hashing.Signing
-- 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.Signing
( -- ** 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 (ByteString)
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 LibSodium.Bindings.Signing
( cryptoSignBytes
, cryptoSignDetached
, cryptoSignKeyPair
, cryptoSignPublicKeyBytes
, cryptoSignSecretKeyBytes
, cryptoSignVerifyDetached
)
import System.IO.Unsafe (unsafeDupablePerformIO)
-- $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
newtype SecretKey = SecretKey (ForeignPtr CUChar)
-- |
--
-- @since 0.0.1.0
data SignedMessage = SignedMessage
{ messageLength :: CSize
, messageForeignPtr :: ForeignPtr CUChar
, signatureForeignPtr :: ForeignPtr CUChar
}
-- | 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 = do
publicKeyForeignPtr <- mallocForeignPtrBytes (fromIntegral @CSize @Int cryptoSignPublicKeyBytes)
secretKeyForeignPtr <- mallocForeignPtrBytes (fromIntegral @CSize @Int cryptoSignSecretKeyBytes)
withForeignPtr publicKeyForeignPtr $ \pkPtr ->
withForeignPtr secretKeyForeignPtr $ \skPtr ->
void $
cryptoSignKeyPair
pkPtr
skPtr
pure (PublicKey publicKeyForeignPtr, SecretKey secretKeyForeignPtr)
-- | Sign a message.
--
-- @since 0.0.1.0
signMessage :: ByteString -> SecretKey -> IO SignedMessage
signMessage message (SecretKey skFPtr) =
ByteString.unsafeUseAsCStringLen message $ \(cString, messageLength) -> do
let sigLength = fromIntegral @CSize @Int cryptoSignBytes
(messageForeignPtr :: ForeignPtr CUChar) <- Foreign.mallocForeignPtrBytes messageLength
signatureForeignPtr <- Foreign.mallocForeignPtrBytes sigLength
withForeignPtr messageForeignPtr $ \messagePtr ->
withForeignPtr signatureForeignPtr $ \signaturePtr ->
withForeignPtr skFPtr $ \skPtr -> do
Foreign.copyArray messagePtr (Foreign.castPtr @CChar @CUChar cString) messageLength
void $
cryptoSignDetached
signaturePtr
Foreign.nullPtr -- Always of size 'cryptoSignBytes'
(castPtr @CChar @CUChar cString)
(fromIntegral @Int @CULLong messageLength)
skPtr
pure $ SignedMessage (fromIntegral @Int @CSize messageLength) messageForeignPtr 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 ByteString
openMessage SignedMessage{messageLength, messageForeignPtr, signatureForeignPtr} (PublicKey pkForeignPtr) = unsafeDupablePerformIO $
withForeignPtr pkForeignPtr $ \publicKeyPtr ->
withForeignPtr signatureForeignPtr $ \signaturePtr -> do
withForeignPtr messageForeignPtr $ \messagePtr -> do
result <-
cryptoSignVerifyDetached
signaturePtr
messagePtr
(fromIntegral @CSize @CULLong messageLength)
publicKeyPtr
case result of
(-1) -> pure Nothing
_ -> do
bsPtr <- mallocBytes (fromIntegral messageLength)
memcpy bsPtr (castPtr messagePtr) messageLength
Just <$> unsafePackMallocCStringLen (castPtr bsPtr :: Ptr CChar, fromIntegral messageLength)
-- | Get the signature part of a 'SignedMessage'.
--
-- @since 0.0.1.0
getSignature :: SignedMessage -> ByteString
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)
-- | Get the message part of a 'SignedMessage' __without verifying the signature__.
--
-- @since 0.0.1.0
unsafeGetMessage :: SignedMessage -> ByteString
unsafeGetMessage SignedMessage{messageLength, messageForeignPtr} = unsafeDupablePerformIO $
withForeignPtr messageForeignPtr $ \messagePtr -> do
bsPtr <- Foreign.mallocBytes (fromIntegral messageLength)
memcpy bsPtr messagePtr messageLength
unsafePackMallocCStringLen (Foreign.castPtr bsPtr :: Ptr CChar, fromIntegral messageLength)
-- | Combine a message and a signature into a 'SignedMessage'.
--
-- @since 0.0.1.0
mkSignature :: ByteString -> ByteString -> SignedMessage
mkSignature message signature = unsafeDupablePerformIO $
ByteString.unsafeUseAsCStringLen message $ \(messageStringPtr, messageLength) ->
ByteString.unsafeUseAsCStringLen signature $ \(signatureStringPtr, _) -> do
(messageForeignPtr :: ForeignPtr CUChar) <- Foreign.mallocForeignPtrBytes messageLength
signatureForeignPtr <- Foreign.mallocForeignPtrBytes (fromIntegral cryptoSignBytes)
withForeignPtr messageForeignPtr $ \messagePtr ->
withForeignPtr signatureForeignPtr $ \signaturePtr -> do
Foreign.copyArray messagePtr (Foreign.castPtr messageStringPtr) messageLength
Foreign.copyArray signaturePtr (Foreign.castPtr signatureStringPtr) (fromIntegral cryptoSignBytes)
pure $ SignedMessage (fromIntegral @Int @CSize messageLength) messageForeignPtr signatureForeignPtr