module Crypto.Curve25519.Pure(
PrivateKey
, PublicKey
, importPublic, exportPublic
, importPrivate, exportPrivate
, generatePrivate
, generatePublic
, generateKeyPair
, makeShared
)
where
import Crypto.Random
import Data.Bits
import Data.ByteString(ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Unsafe
import Data.Word
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Ptr
import System.IO.Unsafe
import Data.Maybe (fromJust)
import Data.List (foldl')
newtype PrivateKey = Priv ByteString
newtype PublicKey = Pub ByteString
instance Show PrivateKey where
show (Priv x) = show (buildNumber x)
instance Show PublicKey where
show (Pub x) = show (buildNumber x)
generatePrivate :: CryptoRandomGen g => g -> Either GenError (PrivateKey, g)
generatePrivate g =
case genBytes 32 g of
Left e -> Left e
Right (bytesbs, g') -> Right (fromJust (importPrivate bytesbs), g')
importPrivate :: ByteString -> Maybe PrivateKey
importPrivate bstr
| BS.length bstr /= 32 = Nothing
| otherwise =
let Just (b0, b1_31) = BS.uncons bstr
Just (b1_30, b31) = BS.unsnoc b1_31
b0' = b0 .&. 248
b31' = b31 .&. 127
b31'' = b31' .|. 64
bytes = (b0' `BS.cons` b1_30) `BS.snoc` b31''
in Just $ Priv bytes
exportPrivate :: PrivateKey -> ByteString
exportPrivate (Priv bstr) = bstr
generatePublic :: PrivateKey -> PublicKey
generatePublic (Priv priv) = Pub (curve25519 priv basePoint)
importPublic :: ByteString -> Maybe PublicKey
importPublic bstr | BS.length bstr == 32 = Just (Pub bstr)
| otherwise = Nothing
exportPublic :: PublicKey -> ByteString
exportPublic (Pub bstr) = bstr
generateKeyPair :: CryptoRandomGen g =>
g ->
Either GenError (PrivateKey, PublicKey, g)
generateKeyPair g =
case generatePrivate g of
Left e -> Left e
Right (priv, g') -> Right (priv, generatePublic priv, g')
makeShared :: PrivateKey -> PublicKey -> ByteString
makeShared (Priv a) (Pub b) = curve25519 a b
curve25519 :: ByteString -> ByteString -> ByteString
curve25519 a b =
unsafePerformIO $
unsafeUseAsCString a $ \ ptra ->
unsafeUseAsCString b $ \ ptrb ->
do ptrc <- mallocBytes 32
curve25519_donna ptrc ptra ptrb
unsafePackCStringFinalizer ptrc 32 (free ptrc)
basePoint :: ByteString
basePoint = BS.cons 9 (BS.replicate 31 0)
buildNumber :: ByteString -> Integer
buildNumber bstr = foldl' run 0 (BS.unpack bstr)
where
run acc x = (acc `shiftL` 8) + fromIntegral x
foreign import ccall unsafe
curve25519_donna :: Ptr Word8 -> Ptr CChar -> Ptr CChar -> IO ()