{-# LANGUAGE BangPatterns #-}
module Crypto.Number.ModArithmetic
(
expSafe
, expFast
, inverse
, inverseCoprimes
, inverseFermat
, jacobi
, squareRoot
) where
import Control.Exception (throw, Exception)
import Crypto.Number.Basic
import Crypto.Number.Compat
data CoprimesAssertionError = CoprimesAssertionError
deriving (Show)
instance Exception CoprimesAssertionError
expSafe :: Integer
-> Integer
-> Integer
-> Integer
expSafe b e m
| odd m = gmpPowModSecInteger b e m `onGmpUnsupported`
(gmpPowModInteger b e m `onGmpUnsupported`
exponentiation b e m)
| otherwise = gmpPowModInteger b e m `onGmpUnsupported`
exponentiation b e m
expFast :: Integer
-> Integer
-> Integer
-> Integer
expFast b e m = gmpPowModInteger b e m `onGmpUnsupported` exponentiation b e m
exponentiation :: Integer -> Integer -> Integer -> Integer
exponentiation b e m
| b == 1 = b
| e == 0 = 1
| e == 1 = b `mod` m
| even e = let p = exponentiation b (e `div` 2) m `mod` m
in (p^(2::Integer)) `mod` m
| otherwise = (b * exponentiation b (e-1) m) `mod` m
inverse :: Integer -> Integer -> Maybe Integer
inverse g m = gmpInverse g m `onGmpUnsupported` v
where
v
| d > 1 = Nothing
| otherwise = Just (x `mod` m)
(x,_,d) = gcde g m
inverseCoprimes :: Integer -> Integer -> Integer
inverseCoprimes g m =
case inverse g m of
Nothing -> throw CoprimesAssertionError
Just i -> i
jacobi :: Integer -> Integer -> Maybe Integer
jacobi a n
| n < 3 || even n = Nothing
| a == 0 || a == 1 = Just a
| n <= a = jacobi (a `mod` n) n
| a < 0 =
let b = if n `mod` 4 == 1 then 1 else -1
in fmap (*b) (jacobi (-a) n)
| otherwise =
let (e, a1) = asPowerOf2AndOdd a
nMod8 = n `mod` 8
nMod4 = n `mod` 4
a1Mod4 = a1 `mod` 4
s' = if even e || nMod8 == 1 || nMod8 == 7 then 1 else -1
s = if nMod4 == 3 && a1Mod4 == 3 then -s' else s'
n1 = n `mod` a1
in if a1 == 1 then Just s
else fmap (*s) (jacobi n1 a1)
inverseFermat :: Integer -> Integer -> Integer
inverseFermat g p = expSafe g (p - 2) p
data ModulusAssertionError = ModulusAssertionError
deriving (Show)
instance Exception ModulusAssertionError
squareRoot :: Integer -> Integer -> Maybe Integer
squareRoot p
| p < 2 = throw ModulusAssertionError
| otherwise =
case p `divMod` 8 of
(v, 3) -> method1 (2 * v + 1)
(v, 7) -> method1 (2 * v + 2)
(u, 5) -> method2 u
(_, 1) -> tonelliShanks p
(0, 2) -> \a -> Just (if even a then 0 else 1)
_ -> throw ModulusAssertionError
where
x `eqMod` y = (x - y) `mod` p == 0
validate g y | (y * y) `eqMod` g = Just y
| otherwise = Nothing
method1 u' g =
let y = expFast g u' p
in validate g y
method2 u g =
let gamma = expFast (2 * g) u p
g_gamma = g * gamma
i = (2 * g_gamma * gamma) `mod` p
y = (g_gamma * (i - 1)) `mod` p
in validate g y
tonelliShanks :: Integer -> Integer -> Maybe Integer
tonelliShanks p a
| aa == 0 = Just 0
| otherwise =
case expFast aa p2 p of
b | b == p1 -> Nothing
| b == 1 -> Just $ go (expFast aa ((s + 1) `div` 2) p)
(expFast aa s p)
(expFast n s p)
e
| otherwise -> throw ModulusAssertionError
where
aa = a `mod` p
p1 = p - 1
p2 = p1 `div` 2
n = findN 2
x `mul` y = (x * y) `mod` p
pow2m 0 x = x
pow2m i x = pow2m (i - 1) (x `mul` x)
(e, s) = asPowerOf2AndOdd p1
findN i
| expFast i p2 p == p1 = i
| otherwise = findN (i + 1)
findM b i
| b == 1 = i
| otherwise = findM (b `mul` b) (i + 1)
go !x b g !r
| b == 1 = x
| otherwise =
let r' = findM b 0
z = pow2m (r - r' - 1) g
x' = x `mul` z
b' = b `mul` g'
g' = z `mul` z
in go x' b' g' r'