File: Curve448.hs

package info (click to toggle)
haskell-crypton 1.0.4-3
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 3,548 kB
  • sloc: haskell: 26,764; ansic: 22,294; makefile: 6
file content (134 lines) | stat: -rw-r--r-- 3,885 bytes parent folder | download
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
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
-- Module      : Crypto.PubKey.Curve448
-- License     : BSD-style
-- Maintainer  : John Galt <jgalt@centromere.net>
-- Stability   : experimental
-- Portability : unknown
--
-- Curve448 support
--
-- Internally uses Decaf point compression to omit the cofactor
-- and implementation by Mike Hamburg.  Externally API and
-- data types are compatible with the encoding specified in RFC 7748.
module Crypto.PubKey.Curve448 (
    SecretKey,
    PublicKey,
    DhSecret,

    -- * Smart constructors
    dhSecret,
    publicKey,
    secretKey,

    -- * Methods
    dh,
    toPublic,
    generateSecretKey,
) where

import Data.Word
import Foreign.Ptr

import Crypto.Error
import Crypto.Internal.ByteArray (
    ByteArrayAccess,
    Bytes,
    ScrubbedBytes,
    withByteArray,
 )
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Compat
import Crypto.Internal.Imports
import Crypto.Random

-- | A Curve448 Secret key
newtype SecretKey = SecretKey ScrubbedBytes
    deriving (Show, Eq, ByteArrayAccess, NFData)

-- | A Curve448 public key
newtype PublicKey = PublicKey Bytes
    deriving (Show, Eq, ByteArrayAccess, NFData)

-- | A Curve448 Diffie Hellman secret related to a
-- public key and a secret key.
newtype DhSecret = DhSecret ScrubbedBytes
    deriving (Show, Eq, ByteArrayAccess, NFData)

-- | Try to build a public key from a bytearray
publicKey :: ByteArrayAccess bs => bs -> CryptoFailable PublicKey
publicKey bs
    | B.length bs == x448_bytes =
        CryptoPassed $ PublicKey $ B.copyAndFreeze bs (\_ -> return ())
    | otherwise = CryptoFailed CryptoError_PublicKeySizeInvalid

-- | Try to build a secret key from a bytearray
secretKey :: ByteArrayAccess bs => bs -> CryptoFailable SecretKey
secretKey bs
    | B.length bs == x448_bytes = unsafeDoIO $
        withByteArray bs $ \inp -> do
            valid <- isValidPtr inp
            if valid
                then (CryptoPassed . SecretKey) <$> B.copy bs (\_ -> return ())
                else return $ CryptoFailed CryptoError_SecretKeyStructureInvalid
    | otherwise = CryptoFailed CryptoError_SecretKeySizeInvalid
  where
    isValidPtr :: Ptr Word8 -> IO Bool
    isValidPtr _ =
        return True
{-# NOINLINE secretKey #-}

-- | Create a DhSecret from a bytearray object
dhSecret :: ByteArrayAccess b => b -> CryptoFailable DhSecret
dhSecret bs
    | B.length bs == x448_bytes =
        CryptoPassed $ DhSecret $ B.copyAndFreeze bs (\_ -> return ())
    | otherwise = CryptoFailed CryptoError_SharedSecretSizeInvalid

-- | Compute the Diffie Hellman secret from a public key and a secret key.
--
-- This implementation may return an all-zero value as it does not check for
-- the condition.
dh :: PublicKey -> SecretKey -> DhSecret
dh (PublicKey pub) (SecretKey sec) = DhSecret
    <$> B.allocAndFreeze x448_bytes
    $ \result ->
        withByteArray sec $ \psec ->
            withByteArray pub $ \ppub ->
                decaf_x448 result ppub psec
{-# NOINLINE dh #-}

-- | Create a public key from a secret key
toPublic :: SecretKey -> PublicKey
toPublic (SecretKey sec) = PublicKey
    <$> B.allocAndFreeze x448_bytes
    $ \result ->
        withByteArray sec $ \psec ->
            decaf_x448_derive_public_key result psec
{-# NOINLINE toPublic #-}

-- | Generate a secret key.
generateSecretKey :: MonadRandom m => m SecretKey
generateSecretKey = SecretKey <$> getRandomBytes x448_bytes

x448_bytes :: Int
x448_bytes = 448 `quot` 8

foreign import ccall "crypton_decaf_x448"
    decaf_x448
        :: Ptr Word8
        -- ^ public
        -> Ptr Word8
        -- ^ basepoint
        -> Ptr Word8
        -- ^ secret
        -> IO ()

foreign import ccall "crypton_decaf_x448_derive_public_key"
    decaf_x448_derive_public_key
        :: Ptr Word8
        -- ^ public
        -> Ptr Word8
        -- ^ secret
        -> IO ()