blob: eb11bb2d0b24194350419855a130225478408908 (
plain)
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
|
-- | This module implements additional bindings for libsodium which are
-- required for the SSB handshake.
{-# LANGUAGE ForeignFunctionInterface #-}
module Sodium where
import Data.ByteString.Unsafe
import qualified Data.ByteString as BS
import Protolude
import Foreign.C
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Storable
import System.IO.Unsafe
import qualified Crypto.Saltine.Internal.ByteSizes as Bytes
import Crypto.Saltine.Class
import qualified Crypto.Saltine.Core.Box as Box
import qualified Crypto.Saltine.Core.Sign as Sign
foreign import ccall "crypto_sign_ed25519_sk_to_curve25519"
c_sign_ed25519_sk_to_curve25519 :: Ptr CChar
-- ^ Converted Curve25519 secret key buffer
-> Ptr CChar
-- ^ Ed25519 secret key buffer
-> IO CInt
-- ^ Always 0
foreign import ccall "crypto_sign_ed25519_pk_to_curve25519"
c_sign_ed25519_pk_to_curve25519 :: Ptr CChar
-- ^ Converted Curve25519 public key buffer
-> Ptr CChar
-- ^ Ed25519 public key buffer
-> IO CInt
-- ^ Always 0
-- | Size of a @curve_25519@-generated secret key
curve25519SK = 64
newtype Curve25519SecretKey = CSK ByteString deriving (Eq, Ord)
instance IsEncoding Curve25519SecretKey where
decode v = if BS.length v == curve25519SK
then Just (CSK v)
else Nothing
{-# INLINE decode #-}
encode (CSK v) = v
{-# INLINE encode #-}
secretKeyToCurve25519 :: Sign.SecretKey -> Curve25519SecretKey
secretKeyToCurve25519 sk = unsafePerformIO $ do
(_err, csk) <- buildUnsafeByteString' curve25519PK $ \cskbuf ->
constByteStrings [skbuf] $ \[(skbuf', _)] ->
c_sign_ed25519_sk_to_curve25519 cskbuf skbuf'
return $ CSK csk
where
skbuf = encode sk :: ByteString
-- | Size of a @curve_25519@-generated public key
curve25519PK = 32
newtype Curve25519PublicKey = CPK ByteString deriving (Eq, Ord)
instance IsEncoding Curve25519PublicKey where
decode v = if BS.length v == curve25519PK
then Just (CPK v)
else Nothing
{-# INLINE decode #-}
encode (CPK v) = v
{-# INLINE encode #-}
publicKeyToCurve25519 :: Box.PublicKey -> Curve25519PublicKey
publicKeyToCurve25519 pk = unsafePerformIO $ do
(_err, cpk) <- buildUnsafeByteString' curve25519PK $ \cpkbuf ->
constByteStrings [pkbuf] $ \[(pkbuf', _)] ->
c_sign_ed25519_pk_to_curve25519 cpkbuf pkbuf'
return $ CPK cpk
where
pkbuf = encode pk :: ByteString
-- | Copied from Saltine :)
-- | Convenience function for accessing constant C strings
constByteStrings :: [ByteString] -> ([CStringLen] -> IO b) -> IO b
constByteStrings =
foldr (\v kk -> \k -> (unsafeUseAsCStringLen v) (\a -> kk (\as -> k (a:as)))) ($ [])
-- | Slightly safer cousin to 'buildUnsafeByteString' that remains in the
-- 'IO' monad.
buildUnsafeByteString' :: Int -> (Ptr CChar -> IO b) -> IO (b, ByteString)
buildUnsafeByteString' n k = do
ph <- mallocBytes n
bs <- unsafePackMallocCStringLen (ph, fromIntegral n)
out <- unsafeUseAsCString bs k
return (out, bs)
|
