1-- |
2-- Module      : Crypto.Number.Compat
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : Good
7--
8{-# LANGUAGE CPP           #-}
9{-# LANGUAGE MagicHash     #-}
10{-# LANGUAGE BangPatterns  #-}
11{-# LANGUAGE UnboxedTuples #-}
12module Crypto.Number.Compat
13    ( GmpSupported(..)
14    , onGmpUnsupported
15    , gmpGcde
16    , gmpLog2
17    , gmpPowModSecInteger
18    , gmpPowModInteger
19    , gmpInverse
20    , gmpNextPrime
21    , gmpTestPrimeMillerRabin
22    , gmpSizeInBytes
23    , gmpSizeInBits
24    , gmpExportInteger
25    , gmpExportIntegerLE
26    , gmpImportInteger
27    , gmpImportIntegerLE
28    ) where
29
30#ifndef MIN_VERSION_integer_gmp
31#define MIN_VERSION_integer_gmp(a,b,c) 0
32#endif
33
34#if MIN_VERSION_integer_gmp(0,5,1)
35import GHC.Integer.GMP.Internals
36import GHC.Base
37import GHC.Integer.Logarithms (integerLog2#)
38#endif
39import Data.Word
40import GHC.Ptr (Ptr(..))
41
42-- | GMP Supported / Unsupported
43data GmpSupported a = GmpSupported a
44                    | GmpUnsupported
45                    deriving (Show,Eq)
46
47-- | Simple combinator in case the operation is not supported through GMP
48onGmpUnsupported :: GmpSupported a -> a -> a
49onGmpUnsupported (GmpSupported a) _ = a
50onGmpUnsupported GmpUnsupported   f = f
51
52-- | Compute the GCDE of a two integer through GMP
53gmpGcde :: Integer -> Integer -> GmpSupported (Integer, Integer, Integer)
54#if MIN_VERSION_integer_gmp(0,5,1)
55gmpGcde a b =
56    GmpSupported (s, t, g)
57  where (# g, s #) = gcdExtInteger a b
58        t = (g - s * a) `div` b
59#else
60gmpGcde _ _ = GmpUnsupported
61#endif
62
63-- | Compute the binary logarithm of an integer through GMP
64gmpLog2 :: Integer -> GmpSupported Int
65#if MIN_VERSION_integer_gmp(0,5,1)
66gmpLog2 0 = GmpSupported 0
67gmpLog2 x = GmpSupported (I# (integerLog2# x))
68#else
69gmpLog2 _ = GmpUnsupported
70#endif
71
72-- | Compute the power modulus using extra security to remain constant
73-- time wise through GMP
74gmpPowModSecInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
75#if MIN_VERSION_integer_gmp(1,1,0)
76gmpPowModSecInteger _ _ _ = GmpUnsupported
77#elif MIN_VERSION_integer_gmp(1,0,2)
78gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m)
79#elif MIN_VERSION_integer_gmp(1,0,0)
80gmpPowModSecInteger _ _ _ = GmpUnsupported
81#elif MIN_VERSION_integer_gmp(0,5,1)
82gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m)
83#else
84gmpPowModSecInteger _ _ _ = GmpUnsupported
85#endif
86
87-- | Compute the power modulus through GMP
88gmpPowModInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
89#if MIN_VERSION_integer_gmp(0,5,1)
90gmpPowModInteger b e m = GmpSupported (powModInteger b e m)
91#else
92gmpPowModInteger _ _ _ = GmpUnsupported
93#endif
94
95-- | Inverse modulus of a number through GMP
96gmpInverse :: Integer -> Integer -> GmpSupported (Maybe Integer)
97#if MIN_VERSION_integer_gmp(0,5,1)
98gmpInverse g m
99    | r == 0    = GmpSupported Nothing
100    | otherwise = GmpSupported (Just r)
101  where r = recipModInteger g m
102#else
103gmpInverse _ _ = GmpUnsupported
104#endif
105
106-- | Get the next prime from a specific value through GMP
107gmpNextPrime :: Integer -> GmpSupported Integer
108#if MIN_VERSION_integer_gmp(1,1,0)
109gmpNextPrime _ = GmpUnsupported
110#elif MIN_VERSION_integer_gmp(0,5,1)
111gmpNextPrime n = GmpSupported (nextPrimeInteger n)
112#else
113gmpNextPrime _ = GmpUnsupported
114#endif
115
116-- | Test if a number is prime using Miller Rabin
117gmpTestPrimeMillerRabin :: Int -> Integer -> GmpSupported Bool
118#if MIN_VERSION_integer_gmp(1,1,0)
119gmpTestPrimeMillerRabin _ _ = GmpUnsupported
120#elif MIN_VERSION_integer_gmp(0,5,1)
121gmpTestPrimeMillerRabin (I# tries) !n = GmpSupported $
122    case testPrimeInteger n tries of
123        0# -> False
124        _  -> True
125#else
126gmpTestPrimeMillerRabin _ _ = GmpUnsupported
127#endif
128
129-- | Return the size in bytes of an integer
130gmpSizeInBytes :: Integer -> GmpSupported Int
131#if MIN_VERSION_integer_gmp(0,5,1)
132gmpSizeInBytes n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 256#)))
133#else
134gmpSizeInBytes _ = GmpUnsupported
135#endif
136
137-- | Return the size in bits of an integer
138gmpSizeInBits :: Integer -> GmpSupported Int
139#if MIN_VERSION_integer_gmp(0,5,1)
140gmpSizeInBits n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 2#)))
141#else
142gmpSizeInBits _ = GmpUnsupported
143#endif
144
145-- | Export an integer to a memory (big-endian)
146gmpExportInteger :: Integer -> Ptr Word8 -> GmpSupported (IO ())
147#if MIN_VERSION_integer_gmp(1,0,0)
148gmpExportInteger n (Ptr addr) = GmpSupported $ do
149    _ <- exportIntegerToAddr n addr 1#
150    return ()
151#elif MIN_VERSION_integer_gmp(0,5,1)
152gmpExportInteger n (Ptr addr) = GmpSupported $ IO $ \s ->
153    case exportIntegerToAddr n addr 1# s of
154        (# s2, _ #) -> (# s2, () #)
155#else
156gmpExportInteger _ _ = GmpUnsupported
157#endif
158
159-- | Export an integer to a memory (little-endian)
160gmpExportIntegerLE :: Integer -> Ptr Word8 -> GmpSupported (IO ())
161#if MIN_VERSION_integer_gmp(1,0,0)
162gmpExportIntegerLE n (Ptr addr) = GmpSupported $ do
163    _ <- exportIntegerToAddr n addr 0#
164    return ()
165#elif MIN_VERSION_integer_gmp(0,5,1)
166gmpExportIntegerLE n (Ptr addr) = GmpSupported $ IO $ \s ->
167    case exportIntegerToAddr n addr 0# s of
168        (# s2, _ #) -> (# s2, () #)
169#else
170gmpExportIntegerLE _ _ = GmpUnsupported
171#endif
172
173-- | Import an integer from a memory (big-endian)
174gmpImportInteger :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
175#if MIN_VERSION_integer_gmp(1,0,0)
176gmpImportInteger (I# n) (Ptr addr) = GmpSupported $
177    importIntegerFromAddr addr (int2Word# n) 1#
178#elif MIN_VERSION_integer_gmp(0,5,1)
179gmpImportInteger (I# n) (Ptr addr) = GmpSupported $ IO $ \s ->
180    importIntegerFromAddr addr (int2Word# n) 1# s
181#else
182gmpImportInteger _ _ = GmpUnsupported
183#endif
184
185-- | Import an integer from a memory (little-endian)
186gmpImportIntegerLE :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
187#if MIN_VERSION_integer_gmp(1,0,0)
188gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $
189    importIntegerFromAddr addr (int2Word# n) 0#
190#elif MIN_VERSION_integer_gmp(0,5,1)
191gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $ IO $ \s ->
192    importIntegerFromAddr addr (int2Word# n) 0# s
193#else
194gmpImportIntegerLE _ _ = GmpUnsupported
195#endif
196