summaryrefslogtreecommitdiff
path: root/dht/cryptonite-backport/Crypto
diff options
context:
space:
mode:
authorJames Crayne <jim.crayne@gmail.com>2019-09-28 13:43:29 -0400
committerJoe Crayne <joe@jerkface.net>2020-01-01 19:27:53 -0500
commit11987749fc6e6d3e53ea737d46d5ab13a16faeb8 (patch)
tree5716463275c2d3e902889db619908ded2a73971c /dht/cryptonite-backport/Crypto
parentadd2c76bced51fde5e9917e7449ef52be70faf87 (diff)
Factor out some new libraries
word64-map: Data.Word64Map network-addr: Network.Address tox-crypto: Crypto.Tox lifted-concurrent: Control.Concurrent.Lifted.Instrument Control.Concurrent.Async.Lifted.Instrument psq-wrap: Data.Wrapper.PSQInt Data.Wrapper.PSQ minmax-psq: Data.MinMaxPSQ tasks: Control.Concurrent.Tasks kad: Network.Kademlia Network.Kademlia.Bootstrap Network.Kademlia.Routing Network.Kademlia.CommonAPI Network.Kademlia.Persistence Network.Kademlia.Search
Diffstat (limited to 'dht/cryptonite-backport/Crypto')
-rw-r--r--dht/cryptonite-backport/Crypto/Cipher/Salsa.hs83
-rw-r--r--dht/cryptonite-backport/Crypto/Cipher/XSalsa.hs50
-rw-r--r--dht/cryptonite-backport/Crypto/ECC/Class.hs127
-rw-r--r--dht/cryptonite-backport/Crypto/ECC/Simple/Prim.hs208
-rw-r--r--dht/cryptonite-backport/Crypto/ECC/Simple/Types.hs615
-rw-r--r--dht/cryptonite-backport/Crypto/Error/Types.hs106
-rw-r--r--dht/cryptonite-backport/Crypto/Internal/ByteArray.hs19
-rw-r--r--dht/cryptonite-backport/Crypto/Internal/Compat.hs48
-rw-r--r--dht/cryptonite-backport/Crypto/Internal/DeepSeq.hs33
-rw-r--r--dht/cryptonite-backport/Crypto/Internal/Imports.hs16
-rw-r--r--dht/cryptonite-backport/Crypto/PubKey/Curve25519.hs131
11 files changed, 1436 insertions, 0 deletions
diff --git a/dht/cryptonite-backport/Crypto/Cipher/Salsa.hs b/dht/cryptonite-backport/Crypto/Cipher/Salsa.hs
new file mode 100644
index 00000000..b6b188b1
--- /dev/null
+++ b/dht/cryptonite-backport/Crypto/Cipher/Salsa.hs
@@ -0,0 +1,83 @@
1-- |
2-- Module : Crypto.Cipher.Salsa
3-- License : BSD-style
4-- Maintainer : Vincent Hanquez <vincent@snarc.org>
5-- Stability : stable
6-- Portability : good
7--
8{-# LANGUAGE ForeignFunctionInterface #-}
9{-# LANGUAGE GeneralizedNewtypeDeriving #-}
10module Crypto.Cipher.Salsa
11 ( initialize
12 , combine
13 , generate
14 , State(..)
15 ) where
16
17import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes)
18import qualified Crypto.Internal.ByteArray as B
19import Crypto.Internal.Compat
20import Crypto.Internal.Imports
21import Foreign.Ptr
22import Foreign.C.Types
23
24-- | Salsa context
25newtype State = State ScrubbedBytes
26 deriving (NFData)
27
28-- | Initialize a new Salsa context with the number of rounds,
29-- the key and the nonce associated.
30initialize :: (ByteArrayAccess key, ByteArrayAccess nonce)
31 => Int -- ^ number of rounds (8,12,20)
32 -> key -- ^ the key (128 or 256 bits)
33 -> nonce -- ^ the nonce (64 or 96 bits)
34 -> State -- ^ the initial Salsa state
35initialize nbRounds key nonce
36 | not (kLen `elem` [16,32]) = error "Salsa: key length should be 128 or 256 bits"
37 | not (nonceLen `elem` [8,12]) = error "Salsa: nonce length should be 64 or 96 bits"
38 | not (nbRounds `elem` [8,12,20]) = error "Salsa: rounds should be 8, 12 or 20"
39 | otherwise = unsafeDoIO $ do
40 stPtr <- B.alloc 132 $ \stPtr ->
41 B.withByteArray nonce $ \noncePtr ->
42 B.withByteArray key $ \keyPtr ->
43 ccryptonite_salsa_init stPtr (fromIntegral nbRounds) kLen keyPtr nonceLen noncePtr
44 return $ State stPtr
45 where kLen = B.length key
46 nonceLen = B.length nonce
47
48-- | Combine the salsa output and an arbitrary message with a xor,
49-- and return the combined output and the new state.
50combine :: ByteArray ba
51 => State -- ^ the current Salsa state
52 -> ba -- ^ the source to xor with the generator
53 -> (ba, State)
54combine prevSt@(State prevStMem) src
55 | B.null src = (B.empty, prevSt)
56 | otherwise = unsafeDoIO $ do
57 (out, st) <- B.copyRet prevStMem $ \ctx ->
58 B.alloc (B.length src) $ \dstPtr ->
59 B.withByteArray src $ \srcPtr -> do
60 ccryptonite_salsa_combine dstPtr ctx srcPtr (fromIntegral $ B.length src)
61 return (out, State st)
62
63-- | Generate a number of bytes from the Salsa output directly
64generate :: ByteArray ba
65 => State -- ^ the current Salsa state
66 -> Int -- ^ the length of data to generate
67 -> (ba, State)
68generate prevSt@(State prevStMem) len
69 | len <= 0 = (B.empty, prevSt)
70 | otherwise = unsafeDoIO $ do
71 (out, st) <- B.copyRet prevStMem $ \ctx ->
72 B.alloc len $ \dstPtr ->
73 ccryptonite_salsa_generate dstPtr ctx (fromIntegral len)
74 return (out, State st)
75
76foreign import ccall "cryptonite_salsa_init"
77 ccryptonite_salsa_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()
78
79foreign import ccall "cryptonite_salsa_combine"
80 ccryptonite_salsa_combine :: Ptr Word8 -> Ptr State -> Ptr Word8 -> CUInt -> IO ()
81
82foreign import ccall "cryptonite_salsa_generate"
83 ccryptonite_salsa_generate :: Ptr Word8 -> Ptr State -> CUInt -> IO ()
diff --git a/dht/cryptonite-backport/Crypto/Cipher/XSalsa.hs b/dht/cryptonite-backport/Crypto/Cipher/XSalsa.hs
new file mode 100644
index 00000000..494760e2
--- /dev/null
+++ b/dht/cryptonite-backport/Crypto/Cipher/XSalsa.hs
@@ -0,0 +1,50 @@
1-- |
2-- Module : Crypto.Cipher.XSalsa
3-- License : BSD-style
4-- Maintainer : Brandon Hamilton <brandon.hamilton@gmail.com>
5-- Stability : stable
6-- Portability : good
7--
8-- Implementation of XSalsa20 algorithm
9-- <https://cr.yp.to/snuffle/xsalsa-20081128.pdf>
10-- Based on the Salsa20 algorithm with 256 bit key extended with 192 bit nonce
11
12{-# LANGUAGE ForeignFunctionInterface #-}
13module Crypto.Cipher.XSalsa
14 ( initialize
15 , combine
16 , generate
17 , State
18 ) where
19
20import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes)
21import qualified Crypto.Internal.ByteArray as B
22import Crypto.Internal.Compat
23import Crypto.Internal.Imports
24import Foreign.Ptr
25import Foreign.Storable
26import Foreign.C.Types
27import Crypto.Cipher.Salsa hiding (initialize)
28
29-- | Initialize a new XSalsa context with the number of rounds,
30-- the key and the nonce associated.
31initialize :: (ByteArrayAccess key, ByteArrayAccess nonce)
32 => Int -- ^ number of rounds (8,12,20)
33 -> key -- ^ the key (256 bits)
34 -> nonce -- ^ the nonce (192 bits)
35 -> State -- ^ the initial XSalsa state
36initialize nbRounds key nonce
37 | kLen /= 32 = error "XSalsa: key length should be 256 bits"
38 | nonceLen /= 24 = error "XSalsa: nonce length should be 192 bits"
39 | not (nbRounds `elem` [8,12,20]) = error "XSalsa: rounds should be 8, 12 or 20"
40 | otherwise = unsafeDoIO $ do
41 stPtr <- B.alloc 132 $ \stPtr ->
42 B.withByteArray nonce $ \noncePtr ->
43 B.withByteArray key $ \keyPtr ->
44 ccryptonite_xsalsa_init stPtr (fromIntegral nbRounds) kLen keyPtr nonceLen noncePtr
45 return $ State stPtr
46 where kLen = B.length key
47 nonceLen = B.length nonce
48
49foreign import ccall "cryptonite_xsalsa_init"
50 ccryptonite_xsalsa_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()
diff --git a/dht/cryptonite-backport/Crypto/ECC/Class.hs b/dht/cryptonite-backport/Crypto/ECC/Class.hs
new file mode 100644
index 00000000..16b2cc15
--- /dev/null
+++ b/dht/cryptonite-backport/Crypto/ECC/Class.hs
@@ -0,0 +1,127 @@
1-- |
2-- Module : Crypto.ECC.Class
3-- License : BSD-style
4-- Stability : experimental
5-- Portability : unknown
6--
7-- Elliptic Curve Cryptography
8--
9{-# LANGUAGE GeneralizedNewtypeDeriving #-}
10{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE ScopedTypeVariables #-}
12module Crypto.ECC.Class
13 ( Curve_X25519(..)
14 , EllipticCurve(..)
15 , EllipticCurveDH(..)
16 , EllipticCurveArith(..)
17 , KeyPair(..)
18 , SharedSecret(..)
19 ) where
20
21import qualified Crypto.ECC.Simple.Types as Simple
22import qualified Crypto.ECC.Simple.Prim as Simple
23import Crypto.Random
24-- import Crypto.Error
25import Crypto.Error.Types
26-- import Crypto.Internal.Proxy
27import Data.Typeable
28import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)
29import qualified Crypto.Internal.ByteArray as B
30import Crypto.Number.Serialize (i2ospOf_, os2ip)
31import qualified Crypto.PubKey.Curve25519 as X25519
32import Data.ByteArray (convert)
33
34-- | An elliptic curve key pair composed of the private part (a scalar), and
35-- the associated point.
36data KeyPair curve = KeyPair
37 { keypairGetPublic :: !(Point curve)
38 , keypairGetPrivate :: !(Scalar curve)
39 }
40
41newtype SharedSecret = SharedSecret ScrubbedBytes
42 deriving (Eq, ByteArrayAccess)
43
44class EllipticCurve curve where
45 -- | Point on an Elliptic Curve
46 type Point curve :: *
47
48 -- | Scalar in the Elliptic Curve domain
49 type Scalar curve :: *
50
51 -- | Generate a new random scalar on the curve.
52 -- The scalar will represent a number between 1 and the order of the curve non included
53 curveGenerateScalar :: MonadRandom randomly => proxy curve -> randomly (Scalar curve)
54
55 -- | Generate a new random keypair
56 curveGenerateKeyPair :: MonadRandom randomly => proxy curve -> randomly (KeyPair curve)
57
58 -- | Get the curve size in bits
59 curveSizeBits :: proxy curve -> Int
60
61 -- | Encode a elliptic curve point into binary form
62 encodePoint :: ByteArray bs => proxy curve -> Point curve -> bs
63
64 -- | Try to decode the binary form of an elliptic curve point
65 decodePoint :: ByteArray bs => proxy curve -> bs -> CryptoFailable (Point curve)
66
67class EllipticCurve curve => EllipticCurveDH curve where
68 -- | Generate a Diffie hellman secret value.
69 --
70 -- This is generally just the .x coordinate of the resulting point, that
71 -- is not hashed.
72 --
73 -- use `pointSmul` to keep the result in Point format.
74 ecdh :: proxy curve -> Scalar curve -> Point curve -> SharedSecret
75
76class EllipticCurve curve => EllipticCurveArith curve where
77 -- | Add points on a curve
78 pointAdd :: proxy curve -> Point curve -> Point curve -> Point curve
79
80 -- | Scalar Multiplication on a curve
81 pointSmul :: proxy curve -> Scalar curve -> Point curve -> Point curve
82
83-- -- | Scalar Inverse
84-- scalarInverse :: Scalar curve -> Scalar curve
85
86data Curve_X25519 = Curve_X25519
87
88instance EllipticCurve Curve_X25519 where
89 type Point Curve_X25519 = X25519.PublicKey
90 type Scalar Curve_X25519 = X25519.SecretKey
91 curveSizeBits _ = 255
92 curveGenerateScalar _ = X25519.generateSecretKey
93 curveGenerateKeyPair _ = do
94 s <- X25519.generateSecretKey
95 return $ KeyPair (X25519.toPublic s) s
96 encodePoint _ p = B.convert p
97 decodePoint _ bs = X25519.publicKey bs
98
99instance EllipticCurveDH Curve_X25519 where
100 ecdh _ s p = SharedSecret $ convert secret
101 where secret = X25519.dh p s
102
103encodeECPoint :: forall curve bs . (Simple.Curve curve, ByteArray bs) => Simple.Point curve -> bs
104encodeECPoint Simple.PointO = error "encodeECPoint: cannot serialize point at infinity"
105encodeECPoint (Simple.Point x y) = B.concat [uncompressed,xb,yb]
106 where
107 size = Simple.curveSizeBytes (Proxy :: Proxy curve)
108 uncompressed, xb, yb :: bs
109 uncompressed = B.singleton 4
110 xb = i2ospOf_ size x
111 yb = i2ospOf_ size y
112
113decodeECPoint :: (Simple.Curve curve, ByteArray bs) => bs -> CryptoFailable (Simple.Point curve)
114decodeECPoint mxy = case B.uncons mxy of
115 Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid
116 Just (m,xy)
117 -- uncompressed
118 | m == 4 ->
119 let siz = B.length xy `div` 2
120 (xb,yb) = B.splitAt siz xy
121 x = os2ip xb
122 y = os2ip yb
123 in Simple.pointFromIntegers (x,y)
124 | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid
125
126curveSizeBytes :: EllipticCurve c => Proxy c -> Int
127curveSizeBytes proxy = (curveSizeBits proxy + 7) `div` 8
diff --git a/dht/cryptonite-backport/Crypto/ECC/Simple/Prim.hs b/dht/cryptonite-backport/Crypto/ECC/Simple/Prim.hs
new file mode 100644
index 00000000..117988f2
--- /dev/null
+++ b/dht/cryptonite-backport/Crypto/ECC/Simple/Prim.hs
@@ -0,0 +1,208 @@
1-- | Elliptic Curve Arithmetic.
2--
3-- /WARNING:/ These functions are vulnerable to timing attacks.
4{-# LANGUAGE ScopedTypeVariables #-}
5module Crypto.ECC.Simple.Prim
6 ( scalarGenerate
7 , scalarFromInteger
8 , pointAdd
9 , pointDouble
10 , pointBaseMul
11 , pointMul
12 , pointAddTwoMuls
13 , pointFromIntegers
14 , isPointAtInfinity
15 , isPointValid
16 ) where
17
18import Data.Maybe
19import Data.Typeable
20import Crypto.Internal.Imports
21import Crypto.Number.ModArithmetic
22import Crypto.Number.F2m
23import Crypto.Number.Generate (generateBetween)
24import Crypto.ECC.Simple.Types
25-- import Crypto.Error
26import Crypto.Error.Types
27import Crypto.Random
28
29-- | Generate a valid scalar for a specific Curve
30scalarGenerate :: forall randomly curve . (MonadRandom randomly, Curve curve) => randomly (Scalar curve)
31scalarGenerate =
32 Scalar <$> generateBetween 1 (n - 1)
33 where
34 n = curveEccN $ curveParameters (Proxy :: Proxy curve)
35
36scalarFromInteger :: forall curve . Curve curve => Integer -> CryptoFailable (Scalar curve)
37scalarFromInteger n
38 | n < 0 || n >= mx = CryptoFailed $ CryptoError_EcScalarOutOfBounds
39 | otherwise = CryptoPassed $ Scalar n
40 where
41 mx = case curveType (Proxy :: Proxy curve) of
42 CurveBinary (CurveBinaryParam b) -> b
43 CurvePrime (CurvePrimeParam p) -> p
44
45--TODO: Extract helper function for `fromMaybe PointO...`
46
47-- | Elliptic Curve point negation:
48-- @pointNegate p@ returns point @q@ such that @pointAdd p q == PointO@.
49pointNegate :: Curve curve => Point curve -> Point curve
50pointNegate PointO = PointO
51pointNegate point@(Point x y) =
52 case curveType point of
53 CurvePrime {} -> Point x (-y)
54 CurveBinary {} -> Point x (x `addF2m` y)
55
56-- | Elliptic Curve point addition.
57--
58-- /WARNING:/ Vulnerable to timing attacks.
59pointAdd :: Curve curve => Point curve -> Point curve -> Point curve
60pointAdd PointO PointO = PointO
61pointAdd PointO q = q
62pointAdd p PointO = p
63pointAdd p q
64 | p == q = pointDouble p
65 | p == pointNegate q = PointO
66pointAdd point@(Point xp yp) (Point xq yq) =
67 case ty of
68 CurvePrime (CurvePrimeParam pr) -> fromMaybe PointO $ do
69 s <- divmod (yp - yq) (xp - xq) pr
70 let xr = (s ^ (2::Int) - xp - xq) `mod` pr
71 yr = (s * (xp - xr) - yp) `mod` pr
72 return $ Point xr yr
73 CurveBinary (CurveBinaryParam fx) -> fromMaybe PointO $ do
74 s <- divF2m fx (yp `addF2m` yq) (xp `addF2m` xq)
75 let xr = mulF2m fx s s `addF2m` s `addF2m` xp `addF2m` xq `addF2m` a
76 yr = mulF2m fx s (xp `addF2m` xr) `addF2m` xr `addF2m` yp
77 return $ Point xr yr
78 where
79 ty = curveType point
80 cc = curveParameters point
81 a = curveEccA cc
82
83-- | Elliptic Curve point doubling.
84--
85-- /WARNING:/ Vulnerable to timing attacks.
86--
87-- This perform the following calculation:
88-- > lambda = (3 * xp ^ 2 + a) / 2 yp
89-- > xr = lambda ^ 2 - 2 xp
90-- > yr = lambda (xp - xr) - yp
91--
92-- With binary curve:
93-- > xp == 0 => P = O
94-- > otherwise =>
95-- > s = xp + (yp / xp)
96-- > xr = s ^ 2 + s + a
97-- > yr = xp ^ 2 + (s+1) * xr
98--
99pointDouble :: Curve curve => Point curve -> Point curve
100pointDouble PointO = PointO
101pointDouble point@(Point xp yp) =
102 case ty of
103 CurvePrime (CurvePrimeParam pr) -> fromMaybe PointO $ do
104 lambda <- divmod (3 * xp ^ (2::Int) + a) (2 * yp) pr
105 let xr = (lambda ^ (2::Int) - 2 * xp) `mod` pr
106 yr = (lambda * (xp - xr) - yp) `mod` pr
107 return $ Point xr yr
108 CurveBinary (CurveBinaryParam fx)
109 | xp == 0 -> PointO
110 | otherwise -> fromMaybe PointO $ do
111 s <- return . addF2m xp =<< divF2m fx yp xp
112 let xr = mulF2m fx s s `addF2m` s `addF2m` a
113 yr = mulF2m fx xp xp `addF2m` mulF2m fx xr (s `addF2m` 1)
114 return $ Point xr yr
115 where
116 ty = curveType point
117 cc = curveParameters point
118 a = curveEccA cc
119
120-- | Elliptic curve point multiplication using the base
121--
122-- /WARNING:/ Vulnerable to timing attacks.
123pointBaseMul :: Curve curve => Scalar curve -> Point curve
124pointBaseMul n = pointMul n (curveEccG $ curveParameters (Proxy :: Proxy curve))
125
126-- | Elliptic curve point multiplication (double and add algorithm).
127--
128-- /WARNING:/ Vulnerable to timing attacks.
129pointMul :: Curve curve => Scalar curve -> Point curve -> Point curve
130pointMul _ PointO = PointO
131pointMul (Scalar n) p
132 | n == 0 = PointO
133 | n == 1 = p
134 | odd n = pointAdd p (pointMul (Scalar (n - 1)) p)
135 | otherwise = pointMul (Scalar (n `div` 2)) (pointDouble p)
136
137-- | Elliptic curve double-scalar multiplication (uses Shamir's trick).
138--
139-- > pointAddTwoMuls n1 p1 n2 p2 == pointAdd (pointMul n1 p1)
140-- > (pointMul n2 p2)
141--
142-- /WARNING:/ Vulnerable to timing attacks.
143pointAddTwoMuls :: Curve curve => Scalar curve -> Point curve -> Scalar curve -> Point curve -> Point curve
144pointAddTwoMuls _ PointO _ PointO = PointO
145pointAddTwoMuls _ PointO n2 p2 = pointMul n2 p2
146pointAddTwoMuls n1 p1 _ PointO = pointMul n1 p1
147pointAddTwoMuls (Scalar n1) p1 (Scalar n2) p2 = go (n1, n2)
148 where
149 p0 = pointAdd p1 p2
150
151 go (0, 0 ) = PointO
152 go (k1, k2) =
153 let q = pointDouble $ go (k1 `div` 2, k2 `div` 2)
154 in case (odd k1, odd k2) of
155 (True , True ) -> pointAdd p0 q
156 (True , False ) -> pointAdd p1 q
157 (False , True ) -> pointAdd p2 q
158 (False , False ) -> q
159
160-- | Check if a point is the point at infinity.
161isPointAtInfinity :: Point curve -> Bool
162isPointAtInfinity PointO = True
163isPointAtInfinity _ = False
164
165-- | Make a point on a curve from integer (x,y) coordinate
166--
167-- if the point is not valid related to the curve then an error is
168-- returned instead of a point
169pointFromIntegers :: forall curve . Curve curve => (Integer, Integer) -> CryptoFailable (Point curve)
170pointFromIntegers (x,y)
171 | isPointValid (Proxy :: Proxy curve) x y = CryptoPassed $ Point x y
172 | otherwise = CryptoFailed $ CryptoError_PointCoordinatesInvalid
173
174-- | check if a point is on specific curve
175--
176-- This perform three checks:
177--
178-- * x is not out of range
179-- * y is not out of range
180-- * the equation @y^2 = x^3 + a*x + b (mod p)@ holds
181isPointValid :: Curve curve => proxy curve -> Integer -> Integer -> Bool
182isPointValid proxy x y =
183 case ty of
184 CurvePrime (CurvePrimeParam p) ->
185 let a = curveEccA cc
186 b = curveEccB cc
187 eqModP z1 z2 = (z1 `mod` p) == (z2 `mod` p)
188 isValid e = e >= 0 && e < p
189 in isValid x && isValid y && (y ^ (2 :: Int)) `eqModP` (x ^ (3 :: Int) + a * x + b)
190 CurveBinary (CurveBinaryParam fx) ->
191 let a = curveEccA cc
192 b = curveEccB cc
193 add = addF2m
194 mul = mulF2m fx
195 isValid e = modF2m fx e == e
196 in and [ isValid x
197 , isValid y
198 , ((((x `add` a) `mul` x `add` y) `mul` x) `add` b `add` (squareF2m fx y)) == 0
199 ]
200 where
201 ty = curveType proxy
202 cc = curveParameters proxy
203
204-- | div and mod
205divmod :: Integer -> Integer -> Integer -> Maybe Integer
206divmod y x m = do
207 i <- inverse (x `mod` m) m
208 return $ y * i `mod` m
diff --git a/dht/cryptonite-backport/Crypto/ECC/Simple/Types.hs b/dht/cryptonite-backport/Crypto/ECC/Simple/Types.hs
new file mode 100644
index 00000000..c97daa29
--- /dev/null
+++ b/dht/cryptonite-backport/Crypto/ECC/Simple/Types.hs
@@ -0,0 +1,615 @@
1{-# LANGUAGE DeriveDataTypeable #-}
2-- |
3-- Module : Crypto.ECC.Simple.Types
4-- License : BSD-style
5-- Maintainer : Vincent Hanquez <vincent@snarc.org>
6-- Stability : Experimental
7-- Portability : Excellent
8--
9-- references:
10-- <https://tools.ietf.org/html/rfc5915>
11--
12{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
13module Crypto.ECC.Simple.Types
14 ( Curve(..)
15 , Point(..)
16 , Scalar(..)
17 , CurveType(..)
18 , CurveBinaryParam(..)
19 , CurvePrimeParam(..)
20 , curveSizeBits
21 , curveSizeBytes
22 , CurveParameters(..)
23 -- * specific curves definition
24 , SEC_p112r1(..)
25 , SEC_p112r2(..)
26 , SEC_p128r1(..)
27 , SEC_p128r2(..)
28 , SEC_p160k1(..)
29 , SEC_p160r1(..)
30 , SEC_p160r2(..)
31 , SEC_p192k1(..)
32 , SEC_p192r1(..) -- aka prime192v1
33 , SEC_p224k1(..)
34 , SEC_p224r1(..)
35 , SEC_p256k1(..)
36 , SEC_p256r1(..) -- aka prime256v1
37 , SEC_p384r1(..)
38 , SEC_p521r1(..)
39 , SEC_t113r1(..)
40 , SEC_t113r2(..)
41 , SEC_t131r1(..)
42 , SEC_t131r2(..)
43 , SEC_t163k1(..)
44 , SEC_t163r1(..)
45 , SEC_t163r2(..)
46 , SEC_t193r1(..)
47 , SEC_t193r2(..)
48 , SEC_t233k1(..) -- aka NIST K-233
49 , SEC_t233r1(..)
50 , SEC_t239k1(..)
51 , SEC_t283k1(..)
52 , SEC_t283r1(..)
53 , SEC_t409k1(..)
54 , SEC_t409r1(..)
55 , SEC_t571k1(..)
56 , SEC_t571r1(..)
57 ) where
58
59import Data.Data
60import Crypto.Internal.Imports
61import Crypto.Number.Basic (numBits)
62
63class Curve curve where
64 curveParameters :: proxy curve -> CurveParameters curve
65 curveType :: proxy curve -> CurveType
66
67-- | get the size of the curve in bits
68curveSizeBits :: Curve curve => proxy curve -> Int
69curveSizeBits proxy =
70 case curveType proxy of
71 CurvePrime (CurvePrimeParam p) -> numBits p
72 CurveBinary (CurveBinaryParam c) -> numBits c - 1
73
74-- | get the size of the curve in bytes
75curveSizeBytes :: Curve curve => proxy curve -> Int
76curveSizeBytes proxy = (curveSizeBits proxy + 7) `div` 8
77
78-- | Define common parameters in a curve definition
79-- of the form: y^2 = x^3 + ax + b.
80data CurveParameters curve = CurveParameters
81 { curveEccA :: Integer -- ^ curve parameter a
82 , curveEccB :: Integer -- ^ curve parameter b
83 , curveEccG :: Point curve -- ^ base point
84 , curveEccN :: Integer -- ^ order of G
85 , curveEccH :: Integer -- ^ cofactor
86 } deriving (Show,Eq,Data,Typeable)
87
88newtype CurveBinaryParam = CurveBinaryParam Integer
89 deriving (Show,Read,Eq,Data,Typeable)
90
91newtype CurvePrimeParam = CurvePrimeParam Integer
92 deriving (Show,Read,Eq,Data,Typeable)
93
94data CurveType =
95 CurveBinary CurveBinaryParam
96 | CurvePrime CurvePrimeParam
97 deriving (Show,Read,Eq,Data,Typeable)
98
99-- | ECC Private Number
100newtype Scalar curve = Scalar Integer
101 deriving (Show,Read,Eq,Data,Typeable)
102
103-- | Define a point on a curve.
104data Point curve =
105 Point Integer Integer
106 | PointO -- ^ Point at Infinity
107 deriving (Show,Read,Eq,Data,Typeable)
108
109instance NFData (Point curve) where
110 rnf (Point x y) = x `seq` y `seq` ()
111 rnf PointO = ()
112
113data SEC_p112r1 = SEC_p112r1 deriving (Show,Read,Eq)
114data SEC_p112r2 = SEC_p112r2 deriving (Show,Read,Eq)
115data SEC_p128r1 = SEC_p128r1 deriving (Show,Read,Eq)
116data SEC_p128r2 = SEC_p128r2 deriving (Show,Read,Eq)
117data SEC_p160k1 = SEC_p160k1 deriving (Show,Read,Eq)
118data SEC_p160r1 = SEC_p160r1 deriving (Show,Read,Eq)
119data SEC_p160r2 = SEC_p160r2 deriving (Show,Read,Eq)
120data SEC_p192k1 = SEC_p192k1 deriving (Show,Read,Eq)
121data SEC_p192r1 = SEC_p192r1 deriving (Show,Read,Eq)
122data SEC_p224k1 = SEC_p224k1 deriving (Show,Read,Eq)
123data SEC_p224r1 = SEC_p224r1 deriving (Show,Read,Eq)
124data SEC_p256k1 = SEC_p256k1 deriving (Show,Read,Eq)
125data SEC_p256r1 = SEC_p256r1 deriving (Show,Read,Eq)
126data SEC_p384r1 = SEC_p384r1 deriving (Show,Read,Eq)
127data SEC_p521r1 = SEC_p521r1 deriving (Show,Read,Eq)
128data SEC_t113r1 = SEC_t113r1 deriving (Show,Read,Eq)
129data SEC_t113r2 = SEC_t113r2 deriving (Show,Read,Eq)
130data SEC_t131r1 = SEC_t131r1 deriving (Show,Read,Eq)
131data SEC_t131r2 = SEC_t131r2 deriving (Show,Read,Eq)
132data SEC_t163k1 = SEC_t163k1 deriving (Show,Read,Eq)
133data SEC_t163r1 = SEC_t163r1 deriving (Show,Read,Eq)
134data SEC_t163r2 = SEC_t163r2 deriving (Show,Read,Eq)
135data SEC_t193r1 = SEC_t193r1 deriving (Show,Read,Eq)
136data SEC_t193r2 = SEC_t193r2 deriving (Show,Read,Eq)
137data SEC_t233k1 = SEC_t233k1 deriving (Show,Read,Eq)
138data SEC_t233r1 = SEC_t233r1 deriving (Show,Read,Eq)
139data SEC_t239k1 = SEC_t239k1 deriving (Show,Read,Eq)
140data SEC_t283k1 = SEC_t283k1 deriving (Show,Read,Eq)
141data SEC_t283r1 = SEC_t283r1 deriving (Show,Read,Eq)
142data SEC_t409k1 = SEC_t409k1 deriving (Show,Read,Eq)
143data SEC_t409r1 = SEC_t409r1 deriving (Show,Read,Eq)
144data SEC_t571k1 = SEC_t571k1 deriving (Show,Read,Eq)
145data SEC_t571r1 = SEC_t571r1 deriving (Show,Read,Eq)
146
147-- | Define names for known recommended curves.
148instance Curve SEC_p112r1 where
149 curveType _ = typeSEC_p112r1
150 curveParameters _ = paramSEC_p112r1
151
152instance Curve SEC_p112r2 where
153 curveType _ = typeSEC_p112r2
154 curveParameters _ = paramSEC_p112r2
155
156instance Curve SEC_p128r1 where
157 curveType _ = typeSEC_p128r1
158 curveParameters _ = paramSEC_p128r1
159
160instance Curve SEC_p128r2 where
161 curveType _ = typeSEC_p128r2
162 curveParameters _ = paramSEC_p128r2
163
164instance Curve SEC_p160k1 where
165 curveType _ = typeSEC_p160k1
166 curveParameters _ = paramSEC_p160k1
167
168instance Curve SEC_p160r1 where
169 curveType _ = typeSEC_p160r1
170 curveParameters _ = paramSEC_p160r1
171
172instance Curve SEC_p160r2 where
173 curveType _ = typeSEC_p160r2
174 curveParameters _ = paramSEC_p160r2
175
176instance Curve SEC_p192k1 where
177 curveType _ = typeSEC_p192k1
178 curveParameters _ = paramSEC_p192k1
179
180instance Curve SEC_p192r1 where
181 curveType _ = typeSEC_p192r1
182 curveParameters _ = paramSEC_p192r1
183
184instance Curve SEC_p224k1 where
185 curveType _ = typeSEC_p224k1
186 curveParameters _ = paramSEC_p224k1
187
188instance Curve SEC_p224r1 where
189 curveType _ = typeSEC_p224r1
190 curveParameters _ = paramSEC_p224r1
191
192instance Curve SEC_p256k1 where
193 curveType _ = typeSEC_p256k1
194 curveParameters _ = paramSEC_p256k1
195
196instance Curve SEC_p256r1 where
197 curveType _ = typeSEC_p256r1
198 curveParameters _ = paramSEC_p256r1
199
200instance Curve SEC_p384r1 where
201 curveType _ = typeSEC_p384r1
202 curveParameters _ = paramSEC_p384r1
203
204instance Curve SEC_p521r1 where
205 curveType _ = typeSEC_p521r1
206 curveParameters _ = paramSEC_p521r1
207
208instance Curve SEC_t113r1 where
209 curveType _ = typeSEC_t113r1
210 curveParameters _ = paramSEC_t113r1
211
212instance Curve SEC_t113r2 where
213 curveType _ = typeSEC_t113r2
214 curveParameters _ = paramSEC_t113r2
215
216instance Curve SEC_t131r1 where
217 curveType _ = typeSEC_t131r1
218 curveParameters _ = paramSEC_t131r1
219
220instance Curve SEC_t131r2 where
221 curveType _ = typeSEC_t131r2
222 curveParameters _ = paramSEC_t131r2
223
224instance Curve SEC_t163k1 where
225 curveType _ = typeSEC_t163k1
226 curveParameters _ = paramSEC_t163k1
227
228instance Curve SEC_t163r1 where
229 curveType _ = typeSEC_t163r1
230 curveParameters _ = paramSEC_t163r1
231
232instance Curve SEC_t163r2 where
233 curveType _ = typeSEC_t163r2
234 curveParameters _ = paramSEC_t163r2
235
236instance Curve SEC_t193r1 where
237 curveType _ = typeSEC_t193r1
238 curveParameters _ = paramSEC_t193r1
239
240instance Curve SEC_t193r2 where
241 curveType _ = typeSEC_t193r2
242 curveParameters _ = paramSEC_t193r2
243
244instance Curve SEC_t233k1 where
245 curveType _ = typeSEC_t233k1
246 curveParameters _ = paramSEC_t233k1
247
248instance Curve SEC_t233r1 where
249 curveType _ = typeSEC_t233r1
250 curveParameters _ = paramSEC_t233r1
251
252instance Curve SEC_t239k1 where
253 curveType _ = typeSEC_t239k1
254 curveParameters _ = paramSEC_t239k1
255
256instance Curve SEC_t283k1 where
257 curveType _ = typeSEC_t283k1
258 curveParameters _ = paramSEC_t283k1
259
260instance Curve SEC_t283r1 where
261 curveType _ = typeSEC_t283r1
262 curveParameters _ = paramSEC_t283r1
263
264instance Curve SEC_t409k1 where
265 curveType _ = typeSEC_t409k1
266 curveParameters _ = paramSEC_t409k1
267
268instance Curve SEC_t409r1 where
269 curveType _ = typeSEC_t409r1
270 curveParameters _ = paramSEC_t409r1
271
272instance Curve SEC_t571k1 where
273 curveType _ = typeSEC_t571k1
274 curveParameters _ = paramSEC_t571k1
275
276instance Curve SEC_t571r1 where
277 curveType _ = typeSEC_t571r1
278 curveParameters _ = paramSEC_t571r1
279
280{-
281curvesOIDs :: [ (CurveName, [Integer]) ]
282curvesOIDs =
283 [ (SEC_p112r1, [1,3,132,0,6])
284 , (SEC_p112r2, [1,3,132,0,7])
285 , (SEC_p128r1, [1,3,132,0,28])
286 , (SEC_p128r2, [1,3,132,0,29])
287 , (SEC_p160k1, [1,3,132,0,9])
288 , (SEC_p160r1, [1,3,132,0,8])
289 , (SEC_p160r2, [1,3,132,0,30])
290 , (SEC_p192k1, [1,3,132,0,31])
291 , (SEC_p192r1, [1,2,840,10045,3,1,1])
292 , (SEC_p224k1, [1,3,132,0,32])
293 , (SEC_p224r1, [1,3,132,0,33])
294 , (SEC_p256k1, [1,3,132,0,10])
295 , (SEC_p256r1, [1,2,840,10045,3,1,7])
296 , (SEC_p384r1, [1,3,132,0,34])
297 , (SEC_p521r1, [1,3,132,0,35])
298 , (SEC_t113r1, [1,3,132,0,4])
299 , (SEC_t113r2, [1,3,132,0,5])
300 , (SEC_t131r1, [1,3,132,0,22])
301 , (SEC_t131r2, [1,3,132,0,23])
302 , (SEC_t163k1, [1,3,132,0,1])
303 , (SEC_t163r1, [1,3,132,0,2])
304 , (SEC_t163r2, [1,3,132,0,15])
305 , (SEC_t193r1, [1,3,132,0,24])
306 , (SEC_t193r2, [1,3,132,0,25])
307 , (SEC_t233k1, [1,3,132,0,26])
308 , (SEC_t233r1, [1,3,132,0,27])
309 , (SEC_t239k1, [1,3,132,0,3])
310 , (SEC_t283k1, [1,3,132,0,16])
311 , (SEC_t283r1, [1,3,132,0,17])
312 , (SEC_t409k1, [1,3,132,0,36])
313 , (SEC_t409r1, [1,3,132,0,37])
314 , (SEC_t571k1, [1,3,132,0,38])
315 , (SEC_t571r1, [1,3,132,0,39])
316 ]
317-}
318
319typeSEC_p112r1 = CurvePrime $ CurvePrimeParam 0xdb7c2abf62e35e668076bead208b
320paramSEC_p112r1 = CurveParameters
321 { curveEccA = 0xdb7c2abf62e35e668076bead2088
322 , curveEccB = 0x659ef8ba043916eede8911702b22
323 , curveEccG = Point 0x09487239995a5ee76b55f9c2f098
324 0xa89ce5af8724c0a23e0e0ff77500
325 , curveEccN = 0xdb7c2abf62e35e7628dfac6561c5
326 , curveEccH = 1
327 }
328typeSEC_p112r2 = CurvePrime $ CurvePrimeParam 0xdb7c2abf62e35e668076bead208b
329paramSEC_p112r2 = CurveParameters
330 { curveEccA = 0x6127c24c05f38a0aaaf65c0ef02c
331 , curveEccB = 0x51def1815db5ed74fcc34c85d709
332 , curveEccG = Point 0x4ba30ab5e892b4e1649dd0928643
333 0xadcd46f5882e3747def36e956e97
334 , curveEccN = 0x36df0aafd8b8d7597ca10520d04b
335 , curveEccH = 4
336 }
337typeSEC_p128r1 = CurvePrime $ CurvePrimeParam 0xfffffffdffffffffffffffffffffffff
338paramSEC_p128r1 = CurveParameters
339 { curveEccA = 0xfffffffdfffffffffffffffffffffffc
340 , curveEccB = 0xe87579c11079f43dd824993c2cee5ed3
341 , curveEccG = Point 0x161ff7528b899b2d0c28607ca52c5b86
342 0xcf5ac8395bafeb13c02da292dded7a83
343 , curveEccN = 0xfffffffe0000000075a30d1b9038a115
344 , curveEccH = 1
345 }
346typeSEC_p128r2 = CurvePrime $ CurvePrimeParam 0xfffffffdffffffffffffffffffffffff
347paramSEC_p128r2 = CurveParameters
348 { curveEccA = 0xd6031998d1b3bbfebf59cc9bbff9aee1
349 , curveEccB = 0x5eeefca380d02919dc2c6558bb6d8a5d
350 , curveEccG = Point 0x7b6aa5d85e572983e6fb32a7cdebc140
351 0x27b6916a894d3aee7106fe805fc34b44
352 , curveEccN = 0x3fffffff7fffffffbe0024720613b5a3
353 , curveEccH = 4
354 }
355typeSEC_p160k1 = CurvePrime $ CurvePrimeParam 0x00fffffffffffffffffffffffffffffffeffffac73
356paramSEC_p160k1 = CurveParameters
357 { curveEccA = 0x000000000000000000000000000000000000000000
358 , curveEccB = 0x000000000000000000000000000000000000000007
359 , curveEccG = Point 0x003b4c382ce37aa192a4019e763036f4f5dd4d7ebb
360 0x00938cf935318fdced6bc28286531733c3f03c4fee
361 , curveEccN = 0x0100000000000000000001b8fa16dfab9aca16b6b3
362 , curveEccH = 1
363 }
364typeSEC_p160r1 = CurvePrime $ CurvePrimeParam 0x00ffffffffffffffffffffffffffffffff7fffffff
365paramSEC_p160r1 = CurveParameters
366 { curveEccA = 0x00ffffffffffffffffffffffffffffffff7ffffffc
367 , curveEccB = 0x001c97befc54bd7a8b65acf89f81d4d4adc565fa45
368 , curveEccG = Point 0x004a96b5688ef573284664698968c38bb913cbfc82
369 0x0023a628553168947d59dcc912042351377ac5fb32
370 , curveEccN = 0x0100000000000000000001f4c8f927aed3ca752257
371 , curveEccH = 1
372 }
373typeSEC_p160r2 = CurvePrime $ CurvePrimeParam 0x00fffffffffffffffffffffffffffffffeffffac73
374paramSEC_p160r2 = CurveParameters
375 { curveEccA = 0x00fffffffffffffffffffffffffffffffeffffac70
376 , curveEccB = 0x00b4e134d3fb59eb8bab57274904664d5af50388ba
377 , curveEccG = Point 0x0052dcb034293a117e1f4ff11b30f7199d3144ce6d
378 0x00feaffef2e331f296e071fa0df9982cfea7d43f2e
379 , curveEccN = 0x0100000000000000000000351ee786a818f3a1a16b
380 , curveEccH = 1
381 }
382typeSEC_p192k1 = CurvePrime $ CurvePrimeParam 0xfffffffffffffffffffffffffffffffffffffffeffffee37
383paramSEC_p192k1 = CurveParameters
384 { curveEccA = 0x000000000000000000000000000000000000000000000000
385 , curveEccB = 0x000000000000000000000000000000000000000000000003
386 , curveEccG = Point 0xdb4ff10ec057e9ae26b07d0280b7f4341da5d1b1eae06c7d
387 0x9b2f2f6d9c5628a7844163d015be86344082aa88d95e2f9d
388 , curveEccN = 0xfffffffffffffffffffffffe26f2fc170f69466a74defd8d
389 , curveEccH = 1
390 }
391typeSEC_p192r1 = CurvePrime $ CurvePrimeParam 0xfffffffffffffffffffffffffffffffeffffffffffffffff
392paramSEC_p192r1 = CurveParameters
393 { curveEccA = 0xfffffffffffffffffffffffffffffffefffffffffffffffc
394 , curveEccB = 0x64210519e59c80e70fa7e9ab72243049feb8deecc146b9b1
395 , curveEccG = Point 0x188da80eb03090f67cbf20eb43a18800f4ff0afd82ff1012
396 0x07192b95ffc8da78631011ed6b24cdd573f977a11e794811
397 , curveEccN = 0xffffffffffffffffffffffff99def836146bc9b1b4d22831
398 , curveEccH = 1
399 }
400typeSEC_p224k1 = CurvePrime $ CurvePrimeParam 0x00fffffffffffffffffffffffffffffffffffffffffffffffeffffe56d
401paramSEC_p224k1 = CurveParameters
402 { curveEccA = 0x0000000000000000000000000000000000000000000000000000000000
403 , curveEccB = 0x0000000000000000000000000000000000000000000000000000000005
404 , curveEccG = Point 0x00a1455b334df099df30fc28a169a467e9e47075a90f7e650eb6b7a45c
405 0x007e089fed7fba344282cafbd6f7e319f7c0b0bd59e2ca4bdb556d61a5
406 , curveEccN = 0x010000000000000000000000000001dce8d2ec6184caf0a971769fb1f7
407 , curveEccH = 1
408 }
409typeSEC_p224r1 = CurvePrime $ CurvePrimeParam 0xffffffffffffffffffffffffffffffff000000000000000000000001
410paramSEC_p224r1 = CurveParameters
411 { curveEccA = 0xfffffffffffffffffffffffffffffffefffffffffffffffffffffffe
412 , curveEccB = 0xb4050a850c04b3abf54132565044b0b7d7bfd8ba270b39432355ffb4
413 , curveEccG = Point 0xb70e0cbd6bb4bf7f321390b94a03c1d356c21122343280d6115c1d21
414 0xbd376388b5f723fb4c22dfe6cd4375a05a07476444d5819985007e34
415 , curveEccN = 0xffffffffffffffffffffffffffff16a2e0b8f03e13dd29455c5c2a3d
416 , curveEccH = 1
417 }
418typeSEC_p256k1 = CurvePrime $ CurvePrimeParam 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f
419paramSEC_p256k1 = CurveParameters
420 { curveEccA = 0x0000000000000000000000000000000000000000000000000000000000000000
421 , curveEccB = 0x0000000000000000000000000000000000000000000000000000000000000007
422 , curveEccG = Point 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798
423 0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8
424 , curveEccN = 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141
425 , curveEccH = 1
426 }
427typeSEC_p256r1 = CurvePrime $ CurvePrimeParam 0xffffffff00000001000000000000000000000000ffffffffffffffffffffffff
428paramSEC_p256r1 = CurveParameters
429 { curveEccA = 0xffffffff00000001000000000000000000000000fffffffffffffffffffffffc
430 , curveEccB = 0x5ac635d8aa3a93e7b3ebbd55769886bc651d06b0cc53b0f63bce3c3e27d2604b
431 , curveEccG = Point 0x6b17d1f2e12c4247f8bce6e563a440f277037d812deb33a0f4a13945d898c296
432 0x4fe342e2fe1a7f9b8ee7eb4a7c0f9e162bce33576b315ececbb6406837bf51f5
433 , curveEccN = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551
434 , curveEccH = 1
435 }
436typeSEC_p384r1 = CurvePrime $ CurvePrimeParam 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffeffffffff0000000000000000ffffffff
437paramSEC_p384r1 = CurveParameters
438 { curveEccA = 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffeffffffff0000000000000000fffffffc
439 , curveEccB = 0xb3312fa7e23ee7e4988e056be3f82d19181d9c6efe8141120314088f5013875ac656398d8a2ed19d2a85c8edd3ec2aef
440 , curveEccG = Point 0xaa87ca22be8b05378eb1c71ef320ad746e1d3b628ba79b9859f741e082542a385502f25dbf55296c3a545e3872760ab7
441 0x3617de4a96262c6f5d9e98bf9292dc29f8f41dbd289a147ce9da3113b5f0b8c00a60b1ce1d7e819d7a431d7c90ea0e5f
442 , curveEccN = 0xffffffffffffffffffffffffffffffffffffffffffffffffc7634d81f4372ddf581a0db248b0a77aecec196accc52973
443 , curveEccH = 1
444 }
445typeSEC_p521r1 = CurvePrime $ CurvePrimeParam 0x01ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
446paramSEC_p521r1 = CurveParameters
447 { curveEccA = 0x01fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffc
448 , curveEccB = 0x0051953eb9618e1c9a1f929a21a0b68540eea2da725b99b315f3b8b489918ef109e156193951ec7e937b1652c0bd3bb1bf073573df883d2c34f1ef451fd46b503f00
449 , curveEccG = Point 0x00c6858e06b70404e9cd9e3ecb662395b4429c648139053fb521f828af606b4d3dbaa14b5e77efe75928fe1dc127a2ffa8de3348b3c1856a429bf97e7e31c2e5bd66
450 0x011839296a789a3bc0045c8a5fb42c7d1bd998f54449579b446817afbd17273e662c97ee72995ef42640c550b9013fad0761353c7086a272c24088be94769fd16650
451 , curveEccN = 0x01fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffa51868783bf2f966b7fcc0148f709a5d03bb5c9b8899c47aebb6fb71e91386409
452 , curveEccH = 1
453 }
454typeSEC_t113r1 = CurveBinary $ CurveBinaryParam 0x020000000000000000000000000201
455paramSEC_t113r1 = CurveParameters
456 { curveEccA = 0x003088250ca6e7c7fe649ce85820f7
457 , curveEccB = 0x00e8bee4d3e2260744188be0e9c723
458 , curveEccG = Point 0x009d73616f35f4ab1407d73562c10f
459 0x00a52830277958ee84d1315ed31886
460 , curveEccN = 0x0100000000000000d9ccec8a39e56f
461 , curveEccH = 2
462 }
463typeSEC_t113r2 = CurveBinary $ CurveBinaryParam 0x020000000000000000000000000201
464paramSEC_t113r2 = CurveParameters
465 { curveEccA = 0x00689918dbec7e5a0dd6dfc0aa55c7
466 , curveEccB = 0x0095e9a9ec9b297bd4bf36e059184f
467 , curveEccG = Point 0x01a57a6a7b26ca5ef52fcdb8164797
468 0x00b3adc94ed1fe674c06e695baba1d
469 , curveEccN = 0x010000000000000108789b2496af93
470 , curveEccH = 2
471 }
472typeSEC_t131r1 = CurveBinary $ CurveBinaryParam 0x080000000000000000000000000000010d
473paramSEC_t131r1 = CurveParameters
474 { curveEccA = 0x07a11b09a76b562144418ff3ff8c2570b8
475 , curveEccB = 0x0217c05610884b63b9c6c7291678f9d341
476 , curveEccG = Point 0x0081baf91fdf9833c40f9c181343638399
477 0x078c6e7ea38c001f73c8134b1b4ef9e150
478 , curveEccN = 0x0400000000000000023123953a9464b54d
479 , curveEccH = 2
480 }
481typeSEC_t131r2 = CurveBinary $ CurveBinaryParam 0x080000000000000000000000000000010d
482paramSEC_t131r2 = CurveParameters
483 { curveEccA = 0x03e5a88919d7cafcbf415f07c2176573b2
484 , curveEccB = 0x04b8266a46c55657ac734ce38f018f2192
485 , curveEccG = Point 0x0356dcd8f2f95031ad652d23951bb366a8
486 0x0648f06d867940a5366d9e265de9eb240f
487 , curveEccN = 0x0400000000000000016954a233049ba98f
488 , curveEccH = 2
489 }
490typeSEC_t163k1 = CurveBinary $ CurveBinaryParam 0x0800000000000000000000000000000000000000c9
491paramSEC_t163k1 = CurveParameters
492 { curveEccA = 0x000000000000000000000000000000000000000001
493 , curveEccB = 0x000000000000000000000000000000000000000001
494 , curveEccG = Point 0x02fe13c0537bbc11acaa07d793de4e6d5e5c94eee8
495 0x0289070fb05d38ff58321f2e800536d538ccdaa3d9
496 , curveEccN = 0x04000000000000000000020108a2e0cc0d99f8a5ef
497 , curveEccH = 2
498 }
499typeSEC_t163r1 = CurveBinary $ CurveBinaryParam 0x0800000000000000000000000000000000000000c9
500paramSEC_t163r1 = CurveParameters
501 { curveEccA = 0x07b6882caaefa84f9554ff8428bd88e246d2782ae2
502 , curveEccB = 0x0713612dcddcb40aab946bda29ca91f73af958afd9
503 , curveEccG = Point 0x0369979697ab43897789566789567f787a7876a654
504 0x00435edb42efafb2989d51fefce3c80988f41ff883
505 , curveEccN = 0x03ffffffffffffffffffff48aab689c29ca710279b
506 , curveEccH = 2
507 }
508typeSEC_t163r2 = CurveBinary $ CurveBinaryParam 0x0800000000000000000000000000000000000000c9
509paramSEC_t163r2 = CurveParameters
510 { curveEccA = 0x000000000000000000000000000000000000000001
511 , curveEccB = 0x020a601907b8c953ca1481eb10512f78744a3205fd
512 , curveEccG = Point 0x03f0eba16286a2d57ea0991168d4994637e8343e36
513 0x00d51fbc6c71a0094fa2cdd545b11c5c0c797324f1
514 , curveEccN = 0x040000000000000000000292fe77e70c12a4234c33
515 , curveEccH = 2
516 }
517typeSEC_t193r1 = CurveBinary $ CurveBinaryParam 0x02000000000000000000000000000000000000000000008001
518paramSEC_t193r1 = CurveParameters
519 { curveEccA = 0x0017858feb7a98975169e171f77b4087de098ac8a911df7b01
520 , curveEccB = 0x00fdfb49bfe6c3a89facadaa7a1e5bbc7cc1c2e5d831478814
521 , curveEccG = Point 0x01f481bc5f0ff84a74ad6cdf6fdef4bf6179625372d8c0c5e1
522 0x0025e399f2903712ccf3ea9e3a1ad17fb0b3201b6af7ce1b05
523 , curveEccN = 0x01000000000000000000000000c7f34a778f443acc920eba49
524 , curveEccH = 2
525 }
526typeSEC_t193r2 = CurveBinary $ CurveBinaryParam 0x02000000000000000000000000000000000000000000008001
527paramSEC_t193r2 = CurveParameters
528 { curveEccA = 0x0163f35a5137c2ce3ea6ed8667190b0bc43ecd69977702709b
529 , curveEccB = 0x00c9bb9e8927d4d64c377e2ab2856a5b16e3efb7f61d4316ae
530 , curveEccG = Point 0x00d9b67d192e0367c803f39e1a7e82ca14a651350aae617e8f
531 0x01ce94335607c304ac29e7defbd9ca01f596f927224cdecf6c
532 , curveEccN = 0x010000000000000000000000015aab561b005413ccd4ee99d5
533 , curveEccH = 2
534 }
535typeSEC_t233k1 = CurveBinary $ CurveBinaryParam 0x020000000000000000000000000000000000000004000000000000000001
536paramSEC_t233k1 = CurveParameters
537 { curveEccA = 0x000000000000000000000000000000000000000000000000000000000000
538 , curveEccB = 0x000000000000000000000000000000000000000000000000000000000001
539 , curveEccG = Point 0x017232ba853a7e731af129f22ff4149563a419c26bf50a4c9d6eefad6126
540 0x01db537dece819b7f70f555a67c427a8cd9bf18aeb9b56e0c11056fae6a3
541 , curveEccN = 0x008000000000000000000000000000069d5bb915bcd46efb1ad5f173abdf
542 , curveEccH = 4
543 }
544typeSEC_t233r1 = CurveBinary $ CurveBinaryParam 0x020000000000000000000000000000000000000004000000000000000001
545paramSEC_t233r1 = CurveParameters
546 { curveEccA = 0x000000000000000000000000000000000000000000000000000000000001
547 , curveEccB = 0x0066647ede6c332c7f8c0923bb58213b333b20e9ce4281fe115f7d8f90ad
548 , curveEccG = Point 0x00fac9dfcbac8313bb2139f1bb755fef65bc391f8b36f8f8eb7371fd558b
549 0x01006a08a41903350678e58528bebf8a0beff867a7ca36716f7e01f81052
550 , curveEccN = 0x01000000000000000000000000000013e974e72f8a6922031d2603cfe0d7
551 , curveEccH = 2
552 }
553typeSEC_t239k1 = CurveBinary $ CurveBinaryParam 0x800000000000000000004000000000000000000000000000000000000001
554paramSEC_t239k1 = CurveParameters
555 { curveEccA = 0x000000000000000000000000000000000000000000000000000000000000
556 , curveEccB = 0x000000000000000000000000000000000000000000000000000000000001
557 , curveEccG = Point 0x29a0b6a887a983e9730988a68727a8b2d126c44cc2cc7b2a6555193035dc
558 0x76310804f12e549bdb011c103089e73510acb275fc312a5dc6b76553f0ca
559 , curveEccN = 0x2000000000000000000000000000005a79fec67cb6e91f1c1da800e478a5
560 , curveEccH = 4
561 }
562typeSEC_t283k1 = CurveBinary $ CurveBinaryParam 0x0800000000000000000000000000000000000000000000000000000000000000000010a1
563paramSEC_t283k1 = CurveParameters
564 { curveEccA = 0x000000000000000000000000000000000000000000000000000000000000000000000000
565 , curveEccB = 0x000000000000000000000000000000000000000000000000000000000000000000000001
566 , curveEccG = Point 0x0503213f78ca44883f1a3b8162f188e553cd265f23c1567a16876913b0c2ac2458492836
567 0x01ccda380f1c9e318d90f95d07e5426fe87e45c0e8184698e45962364e34116177dd2259
568 , curveEccN = 0x01ffffffffffffffffffffffffffffffffffe9ae2ed07577265dff7f94451e061e163c61
569 , curveEccH = 4
570 }
571typeSEC_t283r1 = CurveBinary $ CurveBinaryParam 0x0800000000000000000000000000000000000000000000000000000000000000000010a1
572paramSEC_t283r1 = CurveParameters
573 { curveEccA = 0x000000000000000000000000000000000000000000000000000000000000000000000001
574 , curveEccB = 0x027b680ac8b8596da5a4af8a19a0303fca97fd7645309fa2a581485af6263e313b79a2f5
575 , curveEccG = Point 0x05f939258db7dd90e1934f8c70b0dfec2eed25b8557eac9c80e2e198f8cdbecd86b12053
576 0x03676854fe24141cb98fe6d4b20d02b4516ff702350eddb0826779c813f0df45be8112f4
577 , curveEccN = 0x03ffffffffffffffffffffffffffffffffffef90399660fc938a90165b042a7cefadb307
578 , curveEccH = 2
579 }
580typeSEC_t409k1 = CurveBinary $ CurveBinaryParam 0x02000000000000000000000000000000000000000000000000000000000000000000000000000000008000000000000000000001
581paramSEC_t409k1 = CurveParameters
582 { curveEccA = 0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
583 , curveEccB = 0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001
584 , curveEccG = Point 0x0060f05f658f49c1ad3ab1890f7184210efd0987e307c84c27accfb8f9f67cc2c460189eb5aaaa62ee222eb1b35540cfe9023746
585 0x01e369050b7c4e42acba1dacbf04299c3460782f918ea427e6325165e9ea10e3da5f6c42e9c55215aa9ca27a5863ec48d8e0286b
586 , curveEccN = 0x007ffffffffffffffffffffffffffffffffffffffffffffffffffe5f83b2d4ea20400ec4557d5ed3e3e7ca5b4b5c83b8e01e5fcf
587 , curveEccH = 4
588 }
589typeSEC_t409r1 = CurveBinary $ CurveBinaryParam 0x02000000000000000000000000000000000000000000000000000000000000000000000000000000008000000000000000000001
590paramSEC_t409r1 = CurveParameters
591 { curveEccA = 0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001
592 , curveEccB = 0x0021a5c2c8ee9feb5c4b9a753b7b476b7fd6422ef1f3dd674761fa99d6ac27c8a9a197b272822f6cd57a55aa4f50ae317b13545f
593 , curveEccG = Point 0x015d4860d088ddb3496b0c6064756260441cde4af1771d4db01ffe5b34e59703dc255a868a1180515603aeab60794e54bb7996a7
594 0x0061b1cfab6be5f32bbfa78324ed106a7636b9c5a7bd198d0158aa4f5488d08f38514f1fdf4b4f40d2181b3681c364ba0273c706
595 , curveEccN = 0x010000000000000000000000000000000000000000000000000001e2aad6a612f33307be5fa47c3c9e052f838164cd37d9a21173
596 , curveEccH = 2
597 }
598typeSEC_t571k1 = CurveBinary $ CurveBinaryParam 0x080000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425
599paramSEC_t571k1 = CurveParameters
600 { curveEccA = 0x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
601 , curveEccB = 0x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001
602 , curveEccG = Point 0x026eb7a859923fbc82189631f8103fe4ac9ca2970012d5d46024804801841ca44370958493b205e647da304db4ceb08cbbd1ba39494776fb988b47174dca88c7e2945283a01c8972
603 0x0349dc807f4fbf374f4aeade3bca95314dd58cec9f307a54ffc61efc006d8a2c9d4979c0ac44aea74fbebbb9f772aedcb620b01a7ba7af1b320430c8591984f601cd4c143ef1c7a3
604 , curveEccN = 0x020000000000000000000000000000000000000000000000000000000000000000000000131850e1f19a63e4b391a8db917f4138b630d84be5d639381e91deb45cfe778f637c1001
605 , curveEccH = 4
606 }
607typeSEC_t571r1 = CurveBinary $ CurveBinaryParam 0x080000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425
608paramSEC_t571r1 = CurveParameters
609 { curveEccA = 0x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001
610 , curveEccB = 0x02f40e7e2221f295de297117b7f3d62f5c6a97ffcb8ceff1cd6ba8ce4a9a18ad84ffabbd8efa59332be7ad6756a66e294afd185a78ff12aa520e4de739baca0c7ffeff7f2955727a
611 , curveEccG = Point 0x0303001d34b856296c16c0d40d3cd7750a93d1d2955fa80aa5f40fc8db7b2abdbde53950f4c0d293cdd711a35b67fb1499ae60038614f1394abfa3b4c850d927e1e7769c8eec2d19
612 0x037bf27342da639b6dccfffeb73d69d78c6c27a6009cbbca1980f8533921e8a684423e43bab08a576291af8f461bb2a8b3531d2f0485c19b16e2f1516e23dd3c1a4827af1b8ac15b
613 , curveEccN = 0x03ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffe661ce18ff55987308059b186823851ec7dd9ca1161de93d5174d66e8382e9bb2fe84e47
614 , curveEccH = 2
615 }
diff --git a/dht/cryptonite-backport/Crypto/Error/Types.hs b/dht/cryptonite-backport/Crypto/Error/Types.hs
new file mode 100644
index 00000000..4aaf4e04
--- /dev/null
+++ b/dht/cryptonite-backport/Crypto/Error/Types.hs
@@ -0,0 +1,106 @@
1-- |
2-- Module : Crypto.Error.Types
3-- License : BSD-style
4-- Maintainer : Vincent Hanquez <vincent@snarc.org>
5-- Stability : stable
6-- Portability : Good
7--
8-- Cryptographic Error enumeration and handling
9--
10{-# LANGUAGE DeriveDataTypeable #-}
11module Crypto.Error.Types
12 ( CryptoError(..)
13 , CryptoFailable(..)
14 , throwCryptoErrorIO
15 , throwCryptoError
16 , onCryptoFailure
17 , eitherCryptoError
18 , maybeCryptoError
19 ) where
20
21import qualified Control.Exception as E
22import Data.Data
23
24import Crypto.Internal.Imports
25
26-- | Enumeration of all possible errors that can be found in this library
27data CryptoError =
28 -- symmetric cipher errors
29 CryptoError_KeySizeInvalid
30 | CryptoError_IvSizeInvalid
31 | CryptoError_AEADModeNotSupported
32 -- public key cryptography error
33 | CryptoError_SecretKeySizeInvalid
34 | CryptoError_SecretKeyStructureInvalid
35 | CryptoError_PublicKeySizeInvalid
36 | CryptoError_SharedSecretSizeInvalid
37 -- elliptic cryptography error
38 | CryptoError_EcScalarOutOfBounds
39 | CryptoError_PointSizeInvalid
40 | CryptoError_PointFormatInvalid
41 | CryptoError_PointFormatUnsupported
42 | CryptoError_PointCoordinatesInvalid
43 -- Message authentification error
44 | CryptoError_MacKeyInvalid
45 | CryptoError_AuthenticationTagSizeInvalid
46 deriving (Show,Eq,Enum,Data,Typeable)
47
48instance E.Exception CryptoError
49
50-- | A simple Either like type to represent a computation that can fail
51--
52-- 2 possibles values are:
53--
54-- * 'CryptoPassed' : The computation succeeded, and contains the result of the computation
55--
56-- * 'CryptoFailed' : The computation failed, and contains the cryptographic error associated
57--
58data CryptoFailable a =
59 CryptoPassed a
60 | CryptoFailed CryptoError
61 deriving (Show)
62
63instance Eq a => Eq (CryptoFailable a) where
64 (==) (CryptoPassed a) (CryptoPassed b) = a == b
65 (==) (CryptoFailed e1) (CryptoFailed e2) = e1 == e2
66 (==) _ _ = False
67
68instance Functor CryptoFailable where
69 fmap f (CryptoPassed a) = CryptoPassed (f a)
70 fmap _ (CryptoFailed r) = CryptoFailed r
71
72instance Applicative CryptoFailable where
73 pure a = CryptoPassed a
74 (<*>) fm m = fm >>= \p -> m >>= \r2 -> return (p r2)
75instance Monad CryptoFailable where
76 return a = CryptoPassed a
77 (>>=) m1 m2 = do
78 case m1 of
79 CryptoPassed a -> m2 a
80 CryptoFailed e -> CryptoFailed e
81
82-- | Throw an CryptoError as exception on CryptoFailed result,
83-- otherwise return the computed value
84throwCryptoErrorIO :: CryptoFailable a -> IO a
85throwCryptoErrorIO (CryptoFailed e) = E.throwIO e
86throwCryptoErrorIO (CryptoPassed r) = return r
87
88-- | Same as 'throwCryptoErrorIO' but throw the error asynchronously.
89throwCryptoError :: CryptoFailable a -> a
90throwCryptoError (CryptoFailed e) = E.throw e
91throwCryptoError (CryptoPassed r) = r
92
93-- | Simple 'either' like combinator for CryptoFailable type
94onCryptoFailure :: (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
95onCryptoFailure onError _ (CryptoFailed e) = onError e
96onCryptoFailure _ onSuccess (CryptoPassed r) = onSuccess r
97
98-- | Transform a CryptoFailable to an Either
99eitherCryptoError :: CryptoFailable a -> Either CryptoError a
100eitherCryptoError (CryptoFailed e) = Left e
101eitherCryptoError (CryptoPassed a) = Right a
102
103-- | Transform a CryptoFailable to a Maybe
104maybeCryptoError :: CryptoFailable a -> Maybe a
105maybeCryptoError (CryptoFailed _) = Nothing
106maybeCryptoError (CryptoPassed r) = Just r
diff --git a/dht/cryptonite-backport/Crypto/Internal/ByteArray.hs b/dht/cryptonite-backport/Crypto/Internal/ByteArray.hs
new file mode 100644
index 00000000..3a23152d
--- /dev/null
+++ b/dht/cryptonite-backport/Crypto/Internal/ByteArray.hs
@@ -0,0 +1,19 @@
1-- |
2-- Module : Crypto.Internal.ByteArray
3-- License : BSD-style
4-- Maintainer : Vincent Hanquez <vincent@snarc.org>
5-- Stability : stable
6-- Portability : Good
7--
8-- Simple and efficient byte array types
9--
10{-# OPTIONS_HADDOCK hide #-}
11module Crypto.Internal.ByteArray
12 ( module Data.ByteArray
13 , module Data.ByteArray.Mapping
14 , module Data.ByteArray.Encoding
15 ) where
16
17import Data.ByteArray
18import Data.ByteArray.Mapping
19import Data.ByteArray.Encoding
diff --git a/dht/cryptonite-backport/Crypto/Internal/Compat.hs b/dht/cryptonite-backport/Crypto/Internal/Compat.hs
new file mode 100644
index 00000000..a3712a7c
--- /dev/null
+++ b/dht/cryptonite-backport/Crypto/Internal/Compat.hs
@@ -0,0 +1,48 @@
1-- |
2-- Module : Crypto.Internal.Compat
3-- License : BSD-style
4-- Maintainer : Vincent Hanquez <vincent@snarc.org>
5-- Stability : stable
6-- Portability : Good
7--
8-- This module try to keep all the difference between versions of base
9-- or other needed packages, so that modules don't need to use CPP
10--
11{-# LANGUAGE CPP #-}
12module Crypto.Internal.Compat
13 ( unsafeDoIO
14 , popCount
15 , byteSwap64
16 ) where
17
18import System.IO.Unsafe
19import Data.Word
20import Data.Bits
21
22-- | perform io for hashes that do allocation and ffi.
23-- unsafeDupablePerformIO is used when possible as the
24-- computation is pure and the output is directly linked
25-- to the input. we also do not modify anything after it has
26-- been returned to the user.
27unsafeDoIO :: IO a -> a
28#if __GLASGOW_HASKELL__ > 704
29unsafeDoIO = unsafeDupablePerformIO
30#else
31unsafeDoIO = unsafePerformIO
32#endif
33
34#if !(MIN_VERSION_base(4,5,0))
35popCount :: Word64 -> Int
36popCount n = loop 0 n
37 where loop c 0 = c
38 loop c i = loop (c + if testBit c 0 then 1 else 0) (i `shiftR` 1)
39#endif
40
41#if !(MIN_VERSION_base(4,7,0))
42byteSwap64 :: Word64 -> Word64
43byteSwap64 w =
44 (w `shiftR` 56) .|. (w `shiftL` 56)
45 .|. ((w `shiftR` 40) .&. 0xff00) .|. ((w .&. 0xff00) `shiftL` 40)
46 .|. ((w `shiftR` 24) .&. 0xff0000) .|. ((w .&. 0xff0000) `shiftL` 24)
47 .|. ((w `shiftR` 8) .&. 0xff000000) .|. ((w .&. 0xff000000) `shiftL` 8)
48#endif
diff --git a/dht/cryptonite-backport/Crypto/Internal/DeepSeq.hs b/dht/cryptonite-backport/Crypto/Internal/DeepSeq.hs
new file mode 100644
index 00000000..9da79881
--- /dev/null
+++ b/dht/cryptonite-backport/Crypto/Internal/DeepSeq.hs
@@ -0,0 +1,33 @@
1-- |
2-- Module : Crypto.Internal.DeepSeq
3-- License : BSD-style
4-- Maintainer : Vincent Hanquez <vincent@snarc.org>
5-- Stability : experimental
6-- Portability : unknown
7--
8-- Simple abstraction module to allow compilation without deepseq
9-- by defining our own NFData class if not compiling with deepseq
10-- support.
11--
12{-# LANGUAGE CPP #-}
13module Crypto.Internal.DeepSeq
14 ( NFData(..)
15 ) where
16
17#ifdef WITH_DEEPSEQ_SUPPORT
18import Control.DeepSeq
19#else
20import Data.Word
21import Data.ByteArray
22
23class NFData a where rnf :: a -> ()
24
25instance NFData Word8 where rnf w = w `seq` ()
26instance NFData Word16 where rnf w = w `seq` ()
27instance NFData Word32 where rnf w = w `seq` ()
28instance NFData Word64 where rnf w = w `seq` ()
29
30instance NFData Bytes where rnf b = b `seq` ()
31instance NFData ScrubbedBytes where rnf b = b `seq` ()
32
33#endif
diff --git a/dht/cryptonite-backport/Crypto/Internal/Imports.hs b/dht/cryptonite-backport/Crypto/Internal/Imports.hs
new file mode 100644
index 00000000..4ed44e16
--- /dev/null
+++ b/dht/cryptonite-backport/Crypto/Internal/Imports.hs
@@ -0,0 +1,16 @@
1-- |
2-- Module : Crypto.Internal.Imports
3-- License : BSD-style
4-- Maintainer : Vincent Hanquez <vincent@snarc.org>
5-- Stability : experimental
6-- Portability : unknown
7--
8module Crypto.Internal.Imports
9 ( module X
10 ) where
11
12import Data.Word as X
13import Control.Applicative as X
14import Control.Monad as X (forM, forM_, void)
15import Control.Arrow as X (first, second)
16import Crypto.Internal.DeepSeq as X
diff --git a/dht/cryptonite-backport/Crypto/PubKey/Curve25519.hs b/dht/cryptonite-backport/Crypto/PubKey/Curve25519.hs
new file mode 100644
index 00000000..42878691
--- /dev/null
+++ b/dht/cryptonite-backport/Crypto/PubKey/Curve25519.hs
@@ -0,0 +1,131 @@
1-- |
2-- Module : Crypto.PubKey.Curve25519
3-- License : BSD-style
4-- Maintainer : Vincent Hanquez <vincent@snarc.org>
5-- Stability : experimental
6-- Portability : unknown
7--
8-- Curve25519 support
9--
10{-# LANGUAGE GeneralizedNewtypeDeriving #-}
11{-# LANGUAGE MagicHash #-}
12{-# LANGUAGE ScopedTypeVariables #-}
13module Crypto.PubKey.Curve25519
14 ( SecretKey
15 , PublicKey
16 , DhSecret
17 -- * Smart constructors
18 , dhSecret
19 , publicKey
20 , secretKey
21 -- * methods
22 , dh
23 , toPublic
24 , generateSecretKey
25 ) where
26
27import Data.Bits
28import Data.Word
29import Foreign.Ptr
30import Foreign.Storable
31import GHC.Ptr
32
33-- import Crypto.Error
34import Crypto.Error.Types
35import Crypto.Internal.Compat
36import Crypto.Internal.Imports
37import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes, Bytes, withByteArray)
38import qualified Crypto.Internal.ByteArray as B
39-- import Crypto.Error (CryptoFailable(..))
40import Crypto.Random
41
42-- | A Curve25519 Secret key
43newtype SecretKey = SecretKey ScrubbedBytes
44 deriving (Show,Eq,ByteArrayAccess,NFData)
45
46-- | A Curve25519 public key
47newtype PublicKey = PublicKey Bytes
48 deriving (Show,Eq,ByteArrayAccess,NFData)
49
50-- | A Curve25519 Diffie Hellman secret related to a
51-- public key and a secret key.
52newtype DhSecret = DhSecret ScrubbedBytes
53 deriving (Show,Eq,ByteArrayAccess,NFData)
54
55-- | Try to build a public key from a bytearray
56publicKey :: ByteArrayAccess bs => bs -> CryptoFailable PublicKey
57publicKey bs
58 | B.length bs == 32 = CryptoPassed $ PublicKey $ B.copyAndFreeze bs (\_ -> return ())
59 | otherwise = CryptoFailed CryptoError_PublicKeySizeInvalid
60
61-- | Try to build a secret key from a bytearray
62secretKey :: ByteArrayAccess bs => bs -> CryptoFailable SecretKey
63secretKey bs
64 | B.length bs == 32 = unsafeDoIO $ do
65 withByteArray bs $ \inp -> do
66 valid <- isValidPtr inp
67 if valid
68 then (CryptoPassed . SecretKey) <$> B.copy bs (\_ -> return ())
69 else return $ CryptoFailed CryptoError_SecretKeyStructureInvalid
70 | otherwise = CryptoFailed CryptoError_SecretKeySizeInvalid
71 where
72 -- e[0] &= 0xf8;
73 -- e[31] &= 0x7f;
74 -- e[31] |= 40;
75 isValidPtr :: Ptr Word8 -> IO Bool
76 isValidPtr _ = do
77 --b0 <- peekElemOff inp 0
78 --b31 <- peekElemOff inp 31
79 return True
80{-
81 return $ and [ testBit b0 0 == False
82 , testBit b0 1 == False
83 , testBit b0 2 == False
84 , testBit b31 7 == False
85 , testBit b31 6 == True
86 ]
87-}
88{-# NOINLINE secretKey #-}
89
90-- | Create a DhSecret from a bytearray object
91dhSecret :: ByteArrayAccess b => b -> CryptoFailable DhSecret
92dhSecret bs
93 | B.length bs == 32 = CryptoPassed $ DhSecret $ B.copyAndFreeze bs (\_ -> return ())
94 | otherwise = CryptoFailed CryptoError_SharedSecretSizeInvalid
95
96-- | Compute the Diffie Hellman secret from a public key and a secret key
97dh :: PublicKey -> SecretKey -> DhSecret
98dh (PublicKey pub) (SecretKey sec) = DhSecret <$>
99 B.allocAndFreeze 32 $ \result ->
100 withByteArray sec $ \psec ->
101 withByteArray pub $ \ppub ->
102 ccryptonite_curve25519 result psec ppub
103{-# NOINLINE dh #-}
104
105-- | Create a public key from a secret key
106toPublic :: SecretKey -> PublicKey
107toPublic (SecretKey sec) = PublicKey <$>
108 B.allocAndFreeze 32 $ \result ->
109 withByteArray sec $ \psec ->
110 ccryptonite_curve25519 result psec basePoint
111 where
112 basePoint = Ptr "\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
113{-# NOINLINE toPublic #-}
114
115-- | Generate a secret key.
116generateSecretKey :: MonadRandom m => m SecretKey
117generateSecretKey = tweakToSecretKey <$> getRandomBytes 32
118 where
119 tweakToSecretKey :: ScrubbedBytes -> SecretKey
120 tweakToSecretKey bin = SecretKey $ B.copyAndFreeze bin $ \inp -> do
121 modifyByte inp 0 (\e0 -> e0 .&. 0xf8)
122 modifyByte inp 31 (\e31 -> (e31 .&. 0x7f) .|. 0x40)
123
124 modifyByte :: Ptr Word8 -> Int -> (Word8 -> Word8) -> IO ()
125 modifyByte p n f = peekByteOff p n >>= pokeByteOff p n . f
126
127foreign import ccall "cryptonite_curve25519_donna"
128 ccryptonite_curve25519 :: Ptr Word8 -- ^ public
129 -> Ptr Word8 -- ^ secret
130 -> Ptr Word8 -- ^ basepoint
131 -> IO ()
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 07:40:20 +0000