    -- |An implementation of the core methods of the elliptic curve Curve25519
    -- suite. These functions are largely wrappers over the curve25519-donna
    -- library from Google. While this version is theoretically pure, in that
    -- it doesn't generate any exceptions, you should be warned that it uses
    -- unsafePerformIO under the hood.
    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')

    -- |The type of a Curve25519 private key.
    newtype PrivateKey = Priv ByteString

    -- |The type of a Curve25519 public key.
    newtype PublicKey  = Pub  ByteString

    instance Show PrivateKey where
      show :: PrivateKey -> String
    show (Priv ByteString
    x) = Integer -> String
    forall a. Show a => a -> String
    show (ByteString -> Integer
    buildNumber ByteString
    x)

    instance Show PublicKey where
      show :: PublicKey -> String
    show (Pub ByteString
    x) = Integer -> String
    forall a. Show a => a -> String
    show (ByteString -> Integer
    buildNumber ByteString
    x)

    -- |Randomly generate a Curve25519 private key.
    generatePrivate :: CryptoRandomGen g => g -> Either GenError (PrivateKey, g)
    generatePrivate :: forall g. CryptoRandomGen g => g -> Either GenError (PrivateKey, g)
    generatePrivate g
    g =
      case Int -> g -> Either GenError (ByteString, g)
    forall g.
    CryptoRandomGen g =>
    Int -> g -> Either GenError (ByteString, g)
    genBytes Int
    32 g
    g of
        Left GenError
    e              -> GenError -> Either GenError (PrivateKey, g)
    forall a b. a -> Either a b
    Left GenError
    e
        Right (ByteString
    bytesbs, g
    g') -> (PrivateKey, g) -> Either GenError (PrivateKey, g)
    forall a b. b -> Either a b
    Right (Maybe PrivateKey -> PrivateKey
    forall a. HasCallStack => Maybe a -> a
    fromJust (ByteString -> Maybe PrivateKey
    importPrivate ByteString
    bytesbs), g
    g')

    -- | Imports a 'ByteString' to use as private key.
    -- The 'ByteString' must be exactly 32 bytes long for this to work.
    --
    -- Though minor changes may be made to create a valid key this property is guaranteed:
    -- prop> (\x -> importPrivate x >>= (importPrivate . exportPrivate)) = importPrivate
    importPrivate :: ByteString -> Maybe PrivateKey
    importPrivate :: ByteString -> Maybe PrivateKey
    importPrivate ByteString
    bstr
      | ByteString -> Int
    BS.length ByteString
    bstr Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    32 = Maybe PrivateKey
    forall a. Maybe a
    Nothing
      | Bool
    otherwise  =
        let Just (Word8
    b0, ByteString
    b1_31)  = ByteString -> Maybe (Word8, ByteString)
    BS.uncons ByteString
    bstr
            Just (ByteString
    b1_30, Word8
    b31) = ByteString -> Maybe (ByteString, Word8)
    BS.unsnoc ByteString
    b1_31
            b0' :: Word8
    b0'               = Word8
    b0   Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    248
            b31' :: Word8
    b31'              = Word8
    b31  Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    127
            b31'' :: Word8
    b31''             = Word8
    b31' Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. Word8
    64
            bytes :: ByteString
    bytes             = (Word8
    b0' Word8 -> ByteString -> ByteString
    `BS.cons` ByteString
    b1_30) ByteString -> Word8 -> ByteString
    `BS.snoc` Word8
    b31''
        in PrivateKey -> Maybe PrivateKey
    forall a. a -> Maybe a
    Just (PrivateKey -> Maybe PrivateKey) -> PrivateKey -> Maybe PrivateKey
    forall a b. (a -> b) -> a -> b
    $ ByteString -> PrivateKey
    Priv ByteString
    bytes

    -- | Export a private key to a 'ByteString'
    exportPrivate :: PrivateKey -> ByteString
    exportPrivate :: PrivateKey -> ByteString
    exportPrivate (Priv ByteString
    bstr) = ByteString
    bstr

    -- |Randomly generate a Curve25519 public key.
    generatePublic :: PrivateKey -> PublicKey
    generatePublic :: PrivateKey -> PublicKey
    generatePublic (Priv ByteString
    priv) = ByteString -> PublicKey
    Pub (ByteString -> ByteString -> ByteString
    curve25519 ByteString
    priv ByteString
    basePoint)

    -- |Import a public key from a 'ByteString'.
    -- The 'ByteString' must be exactly 32 bytes long for this to work.
    importPublic :: ByteString -> Maybe PublicKey
    importPublic :: ByteString -> Maybe PublicKey
    importPublic ByteString
    bstr | ByteString -> Int
    BS.length ByteString
    bstr Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    32 = PublicKey -> Maybe PublicKey
    forall a. a -> Maybe a
    Just (ByteString -> PublicKey
    Pub ByteString
    bstr)
                      | Bool
    otherwise            = Maybe PublicKey
    forall a. Maybe a
    Nothing

    -- |Export a public key to a 'ByteString'.
    exportPublic :: PublicKey -> ByteString
    exportPublic :: PublicKey -> ByteString
    exportPublic (Pub ByteString
    bstr) = ByteString
    bstr

    -- |Randomly generate a key pair.
    generateKeyPair :: CryptoRandomGen g =>
                       g ->
                       Either GenError (PrivateKey, PublicKey, g)
    generateKeyPair :: forall g.
    CryptoRandomGen g =>
    g -> Either GenError (PrivateKey, PublicKey, g)
    generateKeyPair g
    g =
      case g -> Either GenError (PrivateKey, g)
    forall g. CryptoRandomGen g => g -> Either GenError (PrivateKey, g)
    generatePrivate g
    g of
       Left GenError
    e           -> GenError -> Either GenError (PrivateKey, PublicKey, g)
    forall a b. a -> Either a b
    Left GenError
    e
       Right (PrivateKey
    priv, g
    g') -> (PrivateKey, PublicKey, g)
    -> Either GenError (PrivateKey, PublicKey, g)
    forall a b. b -> Either a b
    Right (PrivateKey
    priv, PrivateKey -> PublicKey
    generatePublic PrivateKey
    priv, g
    g')

    -- |Generate a shared secret from a private key and a public key.
    makeShared :: PrivateKey -> PublicKey -> ByteString
    makeShared :: PrivateKey -> PublicKey -> ByteString
    makeShared (Priv ByteString
    a) (Pub ByteString
    b) = ByteString -> ByteString -> ByteString
    curve25519 ByteString
    a ByteString
    b

    -- Internal. A moderately evil wrapper over the core C routine.
    curve25519 :: ByteString -> ByteString -> ByteString
    curve25519 :: ByteString -> ByteString -> ByteString
    curve25519 ByteString
    a ByteString
    b =
      IO ByteString -> ByteString
    forall a. IO a -> a
    unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $
        ByteString -> (CString -> IO ByteString) -> IO ByteString
    forall a. ByteString -> (CString -> IO a) -> IO a
    unsafeUseAsCString ByteString
    a ((CString -> IO ByteString) -> IO ByteString)
    -> (CString -> IO ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \ CString
    ptra ->
          ByteString -> (CString -> IO ByteString) -> IO ByteString
    forall a. ByteString -> (CString -> IO a) -> IO a
    unsafeUseAsCString ByteString
    b ((CString -> IO ByteString) -> IO ByteString)
    -> (CString -> IO ByteString) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \ CString
    ptrb ->
            do ptrc <- Int -> IO (Ptr Word8)
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    32
               curve25519_donna ptrc ptra ptrb
               unsafePackCStringFinalizer ptrc 32 (free ptrc)

    basePoint :: ByteString
    basePoint :: ByteString
    basePoint = Word8 -> ByteString -> ByteString
    BS.cons Word8
    9 (Int -> Word8 -> ByteString
    BS.replicate Int
    31 Word8
    0)

    buildNumber :: ByteString -> Integer
    buildNumber :: ByteString -> Integer
    buildNumber ByteString
    bstr = (Integer -> Word8 -> Integer) -> Integer -> [Word8] -> Integer
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Integer -> Word8 -> Integer
    forall {a} {a}. (Bits a, Integral a, Num a) => a -> a -> a
    run Integer
    0 (ByteString -> [Word8]
    BS.unpack ByteString
    bstr)
     where
      run :: a -> a -> a
    run a
    acc a
    x = (a
    acc a -> Int -> a
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8) a -> a -> a
    forall a. Num a => a -> a -> a
    + a -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x

    foreign import ccall unsafe
      curve25519_donna :: Ptr Word8 -> Ptr CChar -> Ptr CChar -> IO ()