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,0,2)
76gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m)
77#elif MIN_VERSION_integer_gmp(1,0,0)
78gmpPowModSecInteger _ _ _ = GmpUnsupported
79#elif MIN_VERSION_integer_gmp(0,5,1)
80gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m)
81#else
82gmpPowModSecInteger _ _ _ = GmpUnsupported
83#endif
84
85-- | Compute the power modulus through GMP
86gmpPowModInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
87#if MIN_VERSION_integer_gmp(0,5,1)
88gmpPowModInteger b e m = GmpSupported (powModInteger b e m)
89#else
90gmpPowModInteger _ _ _ = GmpUnsupported
91#endif
92
93-- | Inverse modulus of a number through GMP
94gmpInverse :: Integer -> Integer -> GmpSupported (Maybe Integer)
95#if MIN_VERSION_integer_gmp(0,5,1)
96gmpInverse g m
97    | r == 0    = GmpSupported Nothing
98    | otherwise = GmpSupported (Just r)
99  where r = recipModInteger g m
100#else
101gmpInverse _ _ = GmpUnsupported
102#endif
103
104-- | Get the next prime from a specific value through GMP
105gmpNextPrime :: Integer -> GmpSupported Integer
106#if MIN_VERSION_integer_gmp(0,5,1)
107gmpNextPrime n = GmpSupported (nextPrimeInteger n)
108#else
109gmpNextPrime _ = GmpUnsupported
110#endif
111
112-- | Test if a number is prime using Miller Rabin
113gmpTestPrimeMillerRabin :: Int -> Integer -> GmpSupported Bool
114#if MIN_VERSION_integer_gmp(0,5,1)
115gmpTestPrimeMillerRabin (I# tries) !n = GmpSupported $
116    case testPrimeInteger n tries of
117        0# -> False
118        _  -> True
119#else
120gmpTestPrimeMillerRabin _ _ = GmpUnsupported
121#endif
122
123-- | Return the size in bytes of an integer
124gmpSizeInBytes :: Integer -> GmpSupported Int
125#if MIN_VERSION_integer_gmp(0,5,1)
126gmpSizeInBytes n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 256#)))
127#else
128gmpSizeInBytes _ = GmpUnsupported
129#endif
130
131-- | Return the size in bits of an integer
132gmpSizeInBits :: Integer -> GmpSupported Int
133#if MIN_VERSION_integer_gmp(0,5,1)
134gmpSizeInBits n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 2#)))
135#else
136gmpSizeInBits _ = GmpUnsupported
137#endif
138
139-- | Export an integer to a memory (big-endian)
140gmpExportInteger :: Integer -> Ptr Word8 -> GmpSupported (IO ())
141#if MIN_VERSION_integer_gmp(1,0,0)
142gmpExportInteger n (Ptr addr) = GmpSupported $ do
143    _ <- exportIntegerToAddr n addr 1#
144    return ()
145#elif MIN_VERSION_integer_gmp(0,5,1)
146gmpExportInteger n (Ptr addr) = GmpSupported $ IO $ \s ->
147    case exportIntegerToAddr n addr 1# s of
148        (# s2, _ #) -> (# s2, () #)
149#else
150gmpExportInteger _ _ = GmpUnsupported
151#endif
152
153-- | Export an integer to a memory (little-endian)
154gmpExportIntegerLE :: Integer -> Ptr Word8 -> GmpSupported (IO ())
155#if MIN_VERSION_integer_gmp(1,0,0)
156gmpExportIntegerLE n (Ptr addr) = GmpSupported $ do
157    _ <- exportIntegerToAddr n addr 0#
158    return ()
159#elif MIN_VERSION_integer_gmp(0,5,1)
160gmpExportIntegerLE n (Ptr addr) = GmpSupported $ IO $ \s ->
161    case exportIntegerToAddr n addr 0# s of
162        (# s2, _ #) -> (# s2, () #)
163#else
164gmpExportIntegerLE _ _ = GmpUnsupported
165#endif
166
167-- | Import an integer from a memory (big-endian)
168gmpImportInteger :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
169#if MIN_VERSION_integer_gmp(1,0,0)
170gmpImportInteger (I# n) (Ptr addr) = GmpSupported $
171    importIntegerFromAddr addr (int2Word# n) 1#
172#elif MIN_VERSION_integer_gmp(0,5,1)
173gmpImportInteger (I# n) (Ptr addr) = GmpSupported $ IO $ \s ->
174    importIntegerFromAddr addr (int2Word# n) 1# s
175#else
176gmpImportInteger _ _ = GmpUnsupported
177#endif
178
179-- | Import an integer from a memory (little-endian)
180gmpImportIntegerLE :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
181#if MIN_VERSION_integer_gmp(1,0,0)
182gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $
183    importIntegerFromAddr addr (int2Word# n) 0#
184#elif MIN_VERSION_integer_gmp(0,5,1)
185gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $ IO $ \s ->
186    importIntegerFromAddr addr (int2Word# n) 0# s
187#else
188gmpImportIntegerLE _ _ = GmpUnsupported
189#endif
190