la_ancapo/stellar-veritas
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Initial commit

Browse source
This commit is contained in:
La Ancapo 2026-01-25 02:27:22 +01:00
commit c101616e62
309 changed files with 53937 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

116
bundled/Crypto/Number/Basic.hs Normal file
View file

@ -0,0 +1,116 @@
-- |
-- Module : Crypto.Number.Basic
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Basic
( sqrti
, gcde
, areEven
, log2
, numBits
, numBytes
, asPowerOf2AndOdd
) where
import Data.Bits
import Crypto.Number.Compat
-- | @sqrti@ returns two integers @(l,b)@ so that @l <= sqrt i <= b@.
-- The implementation is quite naive, use an approximation for the first number
-- and use a dichotomy algorithm to compute the bound relatively efficiently.
sqrti :: Integer -> (Integer, Integer)
sqrti i
| i < 0 = error "cannot compute negative square root"
| i == 0 = (0,0)
| i == 1 = (1,1)
| i == 2 = (1,2)
| otherwise = loop x0
where
nbdigits = length $ show i
x0n = (if even nbdigits then nbdigits - 2 else nbdigits - 1) `div` 2
x0 = if even nbdigits then 2 * 10 ^ x0n else 6 * 10 ^ x0n
loop x = case compare (sq x) i of
LT -> iterUp x
EQ -> (x, x)
GT -> iterDown x
iterUp lb = if sq ub >= i then iter lb ub else iterUp ub
where ub = lb * 2
iterDown ub = if sq lb >= i then iterDown lb else iter lb ub
where lb = ub `div` 2
iter lb ub
| lb == ub = (lb, ub)
| lb+1 == ub = (lb, ub)
| otherwise =
let d = (ub - lb) `div` 2 in
if sq (lb + d) >= i
then iter lb (ub-d)
else iter (lb+d) ub
sq a = a * a
-- | Get the extended GCD of two integer using integer divMod
--
-- gcde 'a' 'b' find (x,y,gcd(a,b)) where ax + by = d
--
gcde :: Integer -> Integer -> (Integer, Integer, Integer)
gcde a b = onGmpUnsupported (gmpGcde a b) $
if d < 0 then (-x,-y,-d) else (x,y,d)
where
(d, x, y) = f (a,1,0) (b,0,1)
f t (0, _, _) = t
f (a', sa, ta) t@(b', sb, tb) =
let (q, r) = a' `divMod` b' in
f t (r, sa - (q * sb), ta - (q * tb))
-- | Check if a list of integer are all even
areEven :: [Integer] -> Bool
areEven = and . map even
-- | Compute the binary logarithm of a integer
log2 :: Integer -> Int
log2 n = onGmpUnsupported (gmpLog2 n) $ imLog 2 n
where
-- http://www.haskell.org/pipermail/haskell-cafe/2008-February/039465.html
imLog b x = if x < b then 0 else (x `div` b^l) `doDiv` l
where
l = 2 * imLog (b * b) x
doDiv x' l' = if x' < b then l' else (x' `div` b) `doDiv` (l' + 1)
{-# INLINE log2 #-}
-- | Compute the number of bits for an integer
numBits :: Integer -> Int
numBits n = gmpSizeInBits n `onGmpUnsupported` (if n == 0 then 1 else computeBits 0 n)
where computeBits !acc i
| q == 0 =
if r >= 0x80 then acc+8
else if r >= 0x40 then acc+7
else if r >= 0x20 then acc+6
else if r >= 0x10 then acc+5
else if r >= 0x08 then acc+4
else if r >= 0x04 then acc+3
else if r >= 0x02 then acc+2
else if r >= 0x01 then acc+1
else acc -- should be catch by previous loop
| otherwise = computeBits (acc+8) q
where (q,r) = i `divMod` 256
-- | Compute the number of bytes for an integer
numBytes :: Integer -> Int
numBytes n = gmpSizeInBytes n `onGmpUnsupported` ((numBits n + 7) `div` 8)
-- | Express an integer as an odd number and a power of 2
asPowerOf2AndOdd :: Integer -> (Int, Integer)
asPowerOf2AndOdd a
| a == 0 = (0, 0)
| odd a = (0, a)
| a < 0 = let (e, a1) = asPowerOf2AndOdd $ abs a in (e, -a1)
| isPowerOf2 a = (log2 a, 1)
| otherwise = loop a 0
where
isPowerOf2 n = (n /= 0) && ((n .&. (n - 1)) == 0)
loop n pw = if n `mod` 2 == 0 then loop (n `div` 2) (pw + 1)
else (pw, n)

195
bundled/Crypto/Number/Compat.hs Normal file
View file

@ -0,0 +1,195 @@
-- |
-- Module : Crypto.Number.Compat
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE UnboxedTuples #-}
module Crypto.Number.Compat
( GmpSupported(..)
, onGmpUnsupported
, gmpGcde
, gmpLog2
, gmpPowModSecInteger
, gmpPowModInteger
, gmpInverse
, gmpNextPrime
, gmpTestPrimeMillerRabin
, gmpSizeInBytes
, gmpSizeInBits
, gmpExportInteger
, gmpExportIntegerLE
, gmpImportInteger
, gmpImportIntegerLE
) where
#ifndef MIN_VERSION_integer_gmp
#define MIN_VERSION_integer_gmp(a,b,c) 0
#endif
#if MIN_VERSION_integer_gmp(0,5,1)
import GHC.Integer.GMP.Internals
import GHC.Base
import GHC.Integer.Logarithms (integerLog2#)
#endif
import Data.Word
import GHC.Ptr (Ptr(..))
-- | GMP Supported / Unsupported
data GmpSupported a = GmpSupported a
| GmpUnsupported
deriving (Show,Eq)
-- | Simple combinator in case the operation is not supported through GMP
onGmpUnsupported :: GmpSupported a -> a -> a
onGmpUnsupported (GmpSupported a) _ = a
onGmpUnsupported GmpUnsupported f = f
-- | Compute the GCDE of a two integer through GMP
gmpGcde :: Integer -> Integer -> GmpSupported (Integer, Integer, Integer)
#if MIN_VERSION_integer_gmp(0,5,1)
gmpGcde a b =
GmpSupported (s, t, g)
where (# g, s #) = gcdExtInteger a b
t = (g - s * a) `div` b
#else
gmpGcde _ _ = GmpUnsupported
#endif
-- | Compute the binary logarithm of an integer through GMP
gmpLog2 :: Integer -> GmpSupported Int
#if MIN_VERSION_integer_gmp(0,5,1)
gmpLog2 0 = GmpSupported 0
gmpLog2 x = GmpSupported (I# (integerLog2# x))
#else
gmpLog2 _ = GmpUnsupported
#endif
-- | Compute the power modulus using extra security to remain constant
-- time wise through GMP
gmpPowModSecInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
#if MIN_VERSION_integer_gmp(1,1,0)
gmpPowModSecInteger _ _ _ = GmpUnsupported
#elif MIN_VERSION_integer_gmp(1,0,2)
gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m)
#elif MIN_VERSION_integer_gmp(1,0,0)
gmpPowModSecInteger _ _ _ = GmpUnsupported
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpPowModSecInteger b e m = GmpSupported (powModSecInteger b e m)
#else
gmpPowModSecInteger _ _ _ = GmpUnsupported
#endif
-- | Compute the power modulus through GMP
gmpPowModInteger :: Integer -> Integer -> Integer -> GmpSupported Integer
#if MIN_VERSION_integer_gmp(0,5,1)
gmpPowModInteger b e m = GmpSupported (powModInteger b e m)
#else
gmpPowModInteger _ _ _ = GmpUnsupported
#endif
-- | Inverse modulus of a number through GMP
gmpInverse :: Integer -> Integer -> GmpSupported (Maybe Integer)
#if MIN_VERSION_integer_gmp(0,5,1)
gmpInverse g m
| r == 0 = GmpSupported Nothing
| otherwise = GmpSupported (Just r)
where r = recipModInteger g m
#else
gmpInverse _ _ = GmpUnsupported
#endif
-- | Get the next prime from a specific value through GMP
gmpNextPrime :: Integer -> GmpSupported Integer
#if MIN_VERSION_integer_gmp(1,1,0)
gmpNextPrime _ = GmpUnsupported
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpNextPrime n = GmpSupported (nextPrimeInteger n)
#else
gmpNextPrime _ = GmpUnsupported
#endif
-- | Test if a number is prime using Miller Rabin
gmpTestPrimeMillerRabin :: Int -> Integer -> GmpSupported Bool
#if MIN_VERSION_integer_gmp(1,1,0)
gmpTestPrimeMillerRabin _ _ = GmpUnsupported
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpTestPrimeMillerRabin (I# tries) !n = GmpSupported $
case testPrimeInteger n tries of
0# -> False
_ -> True
#else
gmpTestPrimeMillerRabin _ _ = GmpUnsupported
#endif
-- | Return the size in bytes of an integer
gmpSizeInBytes :: Integer -> GmpSupported Int
#if MIN_VERSION_integer_gmp(0,5,1)
gmpSizeInBytes n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 256#)))
#else
gmpSizeInBytes _ = GmpUnsupported
#endif
-- | Return the size in bits of an integer
gmpSizeInBits :: Integer -> GmpSupported Int
#if MIN_VERSION_integer_gmp(0,5,1)
gmpSizeInBits n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 2#)))
#else
gmpSizeInBits _ = GmpUnsupported
#endif
-- | Export an integer to a memory (big-endian)
gmpExportInteger :: Integer -> Ptr Word8 -> GmpSupported (IO ())
#if MIN_VERSION_integer_gmp(1,0,0)
gmpExportInteger n (Ptr addr) = GmpSupported $ do
_ <- exportIntegerToAddr n addr 1#
return ()
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpExportInteger n (Ptr addr) = GmpSupported $ IO $ \s ->
case exportIntegerToAddr n addr 1# s of
(# s2, _ #) -> (# s2, () #)
#else
gmpExportInteger _ _ = GmpUnsupported
#endif
-- | Export an integer to a memory (little-endian)
gmpExportIntegerLE :: Integer -> Ptr Word8 -> GmpSupported (IO ())
#if MIN_VERSION_integer_gmp(1,0,0)
gmpExportIntegerLE n (Ptr addr) = GmpSupported $ do
_ <- exportIntegerToAddr n addr 0#
return ()
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpExportIntegerLE n (Ptr addr) = GmpSupported $ IO $ \s ->
case exportIntegerToAddr n addr 0# s of
(# s2, _ #) -> (# s2, () #)
#else
gmpExportIntegerLE _ _ = GmpUnsupported
#endif
-- | Import an integer from a memory (big-endian)
gmpImportInteger :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
#if MIN_VERSION_integer_gmp(1,0,0)
gmpImportInteger (I# n) (Ptr addr) = GmpSupported $
importIntegerFromAddr addr (int2Word# n) 1#
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpImportInteger (I# n) (Ptr addr) = GmpSupported $ IO $ \s ->
importIntegerFromAddr addr (int2Word# n) 1# s
#else
gmpImportInteger _ _ = GmpUnsupported
#endif
-- | Import an integer from a memory (little-endian)
gmpImportIntegerLE :: Int -> Ptr Word8 -> GmpSupported (IO Integer)
#if MIN_VERSION_integer_gmp(1,0,0)
gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $
importIntegerFromAddr addr (int2Word# n) 0#
#elif MIN_VERSION_integer_gmp(0,5,1)
gmpImportIntegerLE (I# n) (Ptr addr) = GmpSupported $ IO $ \s ->
importIntegerFromAddr addr (int2Word# n) 0# s
#else
gmpImportIntegerLE _ _ = GmpUnsupported
#endif

169
bundled/Crypto/Number/F2m.hs Normal file
View file

@ -0,0 +1,169 @@
-- |
-- Module : Crypto.Math.F2m
-- License : BSD-style
-- Maintainer : Danny Navarro <j@dannynavarro.net>
-- Stability : experimental
-- Portability : Good
--
-- This module provides basic arithmetic operations over F₂m. Performance is
-- not optimal and it doesn't provide protection against timing
-- attacks. The 'm' parameter is implicitly derived from the irreducible
-- polynomial where applicable.
module Crypto.Number.F2m
( BinaryPolynomial
, addF2m
, mulF2m
, squareF2m'
, squareF2m
, powF2m
, modF2m
, sqrtF2m
, invF2m
, divF2m
) where
import Data.Bits (xor, shift, testBit, setBit)
import Data.List
import Crypto.Number.Basic
-- | Binary Polynomial represented by an integer
type BinaryPolynomial = Integer
-- | Addition over F₂m. This is just a synonym of 'xor'.
addF2m :: Integer
-> Integer
-> Integer
addF2m = xor
{-# INLINE addF2m #-}
-- | Reduction by modulo over F₂m.
--
-- This function is undefined for negative arguments, because their bit
-- representation is platform-dependent. Zero modulus is also prohibited.
modF2m :: BinaryPolynomial -- ^ Modulus
-> Integer
-> Integer
modF2m fx i
| fx < 0 || i < 0 = error "modF2m: negative number represent no binary polynomial"
| fx == 0 = error "modF2m: cannot divide by zero polynomial"
| fx == 1 = 0
| otherwise = go i
where
lfx = log2 fx
go n | s == 0 = n `addF2m` fx
| s < 0 = n
| otherwise = go $ n `addF2m` shift fx s
where s = log2 n - lfx
{-# INLINE modF2m #-}
-- | Multiplication over F₂m.
--
-- This function is undefined for negative arguments, because their bit
-- representation is platform-dependent. Zero modulus is also prohibited.
mulF2m :: BinaryPolynomial -- ^ Modulus
-> Integer
-> Integer
-> Integer
mulF2m fx n1 n2
| fx < 0
|| n1 < 0
|| n2 < 0 = error "mulF2m: negative number represent no binary polynomial"
| fx == 0 = error "mulF2m: cannot multiply modulo zero polynomial"
| otherwise = modF2m fx $ go (if n2 `mod` 2 == 1 then n1 else 0) (log2 n2)
where
go n s | s == 0 = n
| otherwise = if testBit n2 s
then go (n `addF2m` shift n1 s) (s - 1)
else go n (s - 1)
{-# INLINABLE mulF2m #-}
-- | Squaring over F₂m.
--
-- This function is undefined for negative arguments, because their bit
-- representation is platform-dependent. Zero modulus is also prohibited.
squareF2m :: BinaryPolynomial -- ^ Modulus
-> Integer
-> Integer
squareF2m fx = modF2m fx . squareF2m'
{-# INLINE squareF2m #-}
-- | Squaring over F₂m without reduction by modulo.
--
-- The implementation utilizes the fact that for binary polynomial S(x) we have
-- S(x)^2 = S(x^2). In other words, insert a zero bit between every bits of argument: 1101 -> 1010001.
--
-- This function is undefined for negative arguments, because their bit
-- representation is platform-dependent.
squareF2m' :: Integer
-> Integer
squareF2m' n
| n < 0 = error "mulF2m: negative number represent no binary polynomial"
| otherwise = foldl' (\acc s -> if testBit n s then setBit acc (2 * s) else acc) 0 [0 .. log2 n]
{-# INLINE squareF2m' #-}
-- | Exponentiation in F₂m by computing @a^b mod fx@.
--
-- This implements an exponentiation by squaring based solution. It inherits the
-- same restrictions as 'squareF2m'. Negative exponents are disallowed.
powF2m :: BinaryPolynomial -- ^Modulus
-> Integer -- ^a
-> Integer -- ^b
-> Integer
powF2m fx a b
| b < 0 = error "powF2m: negative exponents disallowed"
| b == 0 = if fx > 1 then 1 else 0
| even b = squareF2m fx x
| otherwise = mulF2m fx a (squareF2m' x)
where x = powF2m fx a (b `div` 2)
-- | Square rooot in F₂m.
--
-- We exploit the fact that @a^(2^m) = a@, or in particular, @a^(2^m - 1) = 1@
-- from a classical result by Lagrange. Thus the square root is simply @a^(2^(m
-- - 1))@.
sqrtF2m :: BinaryPolynomial -- ^Modulus
-> Integer -- ^a
-> Integer
sqrtF2m fx a = go (log2 fx - 1) a
where go 0 x = x
go n x = go (n - 1) (squareF2m fx x)
-- | Extended GCD algorithm for polynomials. For @a@ and @b@ returns @(g, u, v)@ such that @a * u + b * v == g@.
--
-- Reference: https://en.wikipedia.org/wiki/Polynomial_greatest_common_divisor#B.C3.A9zout.27s_identity_and_extended_GCD_algorithm
gcdF2m :: Integer
-> Integer
-> (Integer, Integer, Integer)
gcdF2m a b = go (a, b, 1, 0, 0, 1)
where
go (g, 0, u, _, v, _)
= (g, u, v)
go (r0, r1, s0, s1, t0, t1)
= go (r1, r0 `addF2m` shift r1 j, s1, s0 `addF2m` shift s1 j, t1, t0 `addF2m` shift t1 j)
where j = max 0 (log2 r0 - log2 r1)
-- | Modular inversion over F₂m.
-- If @n@ doesn't have an inverse, 'Nothing' is returned.
--
-- This function is undefined for negative arguments, because their bit
-- representation is platform-dependent. Zero modulus is also prohibited.
invF2m :: BinaryPolynomial -- ^ Modulus
-> Integer
-> Maybe Integer
invF2m fx n = if g == 1 then Just (modF2m fx u) else Nothing
where
(g, u, _) = gcdF2m n fx
{-# INLINABLE invF2m #-}
-- | Division over F₂m. If the dividend doesn't have an inverse it returns
-- 'Nothing'.
--
-- This function is undefined for negative arguments, because their bit
-- representation is platform-dependent. Zero modulus is also prohibited.
divF2m :: BinaryPolynomial -- ^ Modulus
-> Integer -- ^ Dividend
-> Integer -- ^ Divisor
-> Maybe Integer -- ^ Quotient
divF2m fx n1 n2 = mulF2m fx n1 <$> invF2m fx n2
{-# INLINE divF2m #-}

123
bundled/Crypto/Number/Generate.hs Normal file
View file

@ -0,0 +1,123 @@
-- |
-- Module : Crypto.Number.Generate
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
module Crypto.Number.Generate
( GenTopPolicy(..)
, generateParams
, generateMax
, generateBetween
) where
import Crypto.Internal.Imports
import Crypto.Number.Basic
import Crypto.Number.Serialize
import Crypto.Random.Types
import Control.Monad (when)
import Foreign.Ptr
import Foreign.Storable
import Data.Bits ((.|.), (.&.), shiftL, complement, testBit)
import Crypto.Internal.ByteArray (ScrubbedBytes)
import qualified Crypto.Internal.ByteArray as B
-- | Top bits policy when generating a number
data GenTopPolicy =
SetHighest -- ^ set the highest bit
| SetTwoHighest -- ^ set the two highest bit
deriving (Show,Eq)
-- | Generate a number for a specific size of bits,
-- and optionaly set bottom and top bits
--
-- If the top bit policy is 'Nothing', then nothing is
-- done on the highest bit (it's whatever the random generator set).
--
-- If @generateOdd is set to 'True', then the number generated
-- is guaranteed to be odd. Otherwise it will be whatever is generated
--
generateParams :: MonadRandom m
=> Int -- ^ number of bits
-> Maybe GenTopPolicy -- ^ top bit policy
-> Bool -- ^ force the number to be odd
-> m Integer
generateParams bits genTopPolicy generateOdd
| bits <= 0 = return 0
| otherwise = os2ip . tweak <$> getRandomBytes bytes
where
tweak :: ScrubbedBytes -> ScrubbedBytes
tweak orig = B.copyAndFreeze orig $ \p0 -> do
let p1 = p0 `plusPtr` 1
pEnd = p0 `plusPtr` (bytes - 1)
case genTopPolicy of
Nothing -> return ()
Just SetHighest -> p0 |= (1 `shiftL` bit)
Just SetTwoHighest
| bit == 0 -> do p0 $= 0x1
p1 |= 0x80
| otherwise -> p0 |= (0x3 `shiftL` (bit - 1))
p0 &= (complement $ mask)
when generateOdd (pEnd |= 0x1)
($=) :: Ptr Word8 -> Word8 -> IO ()
($=) p w = poke p w
(|=) :: Ptr Word8 -> Word8 -> IO ()
(|=) p w = peek p >>= \v -> poke p (v .|. w)
(&=) :: Ptr Word8 -> Word8 -> IO ()
(&=) p w = peek p >>= \v -> poke p (v .&. w)
bytes = (bits + 7) `div` 8;
bit = (bits - 1) `mod` 8;
mask = 0xff `shiftL` (bit + 1);
-- | Generate a positive integer x, s.t. 0 <= x < range
generateMax :: MonadRandom m
=> Integer -- ^ range
-> m Integer
generateMax range
| range <= 1 = return 0
| range < 127 = generateSimple
| canOverGenerate = loopGenerateOver tries
| otherwise = loopGenerate tries
where
-- this "generator" is mostly for quickcheck benefits. it'll be biased if
-- range is not a multiple of 2, but overall, no security should be
-- assumed for a number between 0 and 127.
generateSimple = flip mod range `fmap` generateParams bits Nothing False
loopGenerate count
| count == 0 = error $ "internal: generateMax(" ++ show range ++ " bits=" ++ show bits ++ ") (normal) doesn't seems to work properly"
| otherwise = do
r <- generateParams bits Nothing False
if isValid r then return r else loopGenerate (count-1)
loopGenerateOver count
| count == 0 = error $ "internal: generateMax(" ++ show range ++ " bits=" ++ show bits ++ ") (over) doesn't seems to work properly"
| otherwise = do
r <- generateParams (bits+1) Nothing False
let r2 = r - range
r3 = r2 - range
if isValid r
then return r
else if isValid r2
then return r2
else if isValid r3
then return r3
else loopGenerateOver (count-1)
bits = numBits range
canOverGenerate = bits > 3 && not (range `testBit` (bits-2)) && not (range `testBit` (bits-3))
isValid n = n < range
tries :: Int
tries = 100
-- | generate a number between the inclusive bound [low,high].
generateBetween :: MonadRandom m => Integer -> Integer -> m Integer
generateBetween low high = (low +) <$> generateMax (high - low + 1)

217
bundled/Crypto/Number/ModArithmetic.hs Normal file
View file

@ -0,0 +1,217 @@
{-# LANGUAGE BangPatterns #-}
-- |
-- Module : Crypto.Number.ModArithmetic
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
module Crypto.Number.ModArithmetic
(
-- * Exponentiation
expSafe
, expFast
-- * Inverse computing
, inverse
, inverseCoprimes
, inverseFermat
-- * Squares
, jacobi
, squareRoot
) where
import Control.Exception (throw, Exception)
import Crypto.Number.Basic
import Crypto.Number.Compat
-- | Raised when two numbers are supposed to be coprimes but are not.
data CoprimesAssertionError = CoprimesAssertionError
deriving (Show)
instance Exception CoprimesAssertionError
-- | Compute the modular exponentiation of base^exponent using
-- algorithms design to avoid side channels and timing measurement
--
-- Modulo need to be odd otherwise the normal fast modular exponentiation
-- is used.
--
-- When used with integer-simple, this function is not different
-- from expFast, and thus provide the same unstudied and dubious
-- timing and side channels claims.
--
-- Before GHC 8.4.2, powModSecInteger is missing from integer-gmp,
-- so expSafe has the same security as expFast.
expSafe :: Integer -- ^ base
-> Integer -- ^ exponent
-> Integer -- ^ modulo
-> Integer -- ^ result
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
-- | Compute the modular exponentiation of base^exponent using
-- the fastest algorithm without any consideration for
-- hiding parameters.
--
-- Use this function when all the parameters are public,
-- otherwise 'expSafe' should be preferred.
expFast :: Integer -- ^ base
-> Integer -- ^ exponent
-> Integer -- ^ modulo
-> Integer -- ^ result
expFast b e m = gmpPowModInteger b e m `onGmpUnsupported` exponentiation b e m
-- | @exponentiation@ computes modular exponentiation as /b^e mod m/
-- using repetitive squaring.
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@ computes the modular inverse as in /g^(-1) 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
-- | Compute the modular inverse of two coprime numbers.
-- This is equivalent to inverse except that the result
-- is known to exists.
--
-- If the numbers are not defined as coprime, this function
-- will raise a 'CoprimesAssertionError'.
inverseCoprimes :: Integer -> Integer -> Integer
inverseCoprimes g m =
case inverse g m of
Nothing -> throw CoprimesAssertionError
Just i -> i
-- | Computes the Jacobi symbol (a/n).
-- 0 ≤ a < n; n ≥ 3 and odd.
--
-- The Legendre and Jacobi symbols are indistinguishable exactly when the
-- lower argument is an odd prime, in which case they have the same value.
--
-- See algorithm 2.149 in "Handbook of Applied Cryptography" by Alfred J. Menezes et al.
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)
-- | Modular inverse using Fermat's little theorem. This works only when
-- the modulus is prime but avoids side channels like in 'expSafe'.
inverseFermat :: Integer -> Integer -> Integer
inverseFermat g p = expSafe g (p - 2) p
-- | Raised when the assumption about the modulus is invalid.
data ModulusAssertionError = ModulusAssertionError
deriving (Show)
instance Exception ModulusAssertionError
-- | Modular square root of @g@ modulo a prime @p@.
--
-- If the modulus is found not to be prime, the function will raise a
-- 'ModulusAssertionError'.
--
-- This implementation is variable time and should be used with public
-- parameters only.
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
-- p == 4u + 3 and u' == u + 1
method1 u' g =
let y = expFast g u' p
in validate g y
-- p == 8u + 5
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
-- find a quadratic non-residue
findN i
| expFast i p2 p == p1 = i
| otherwise = findN (i + 1)
-- find m such that b^(2^m) == 1 (mod p)
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'

63
bundled/Crypto/Number/Nat.hs Normal file
View file

@ -0,0 +1,63 @@
-- |
-- Module : Crypto.Number.Nat
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- Numbers at type level.
--
-- This module provides extensions to "GHC.TypeLits" and "GHC.TypeNats" useful
-- to work with cryptographic algorithms parameterized with a variable bit
-- length. Constraints like @'IsDivisibleBy8' n@ ensure that the type-level
-- parameter is applicable to the algorithm.
--
-- Functions are also provided to test whether constraints are satisfied from
-- values known at runtime. The following example shows how to discharge
-- 'IsDivisibleBy8' in a computation @fn@ requiring this constraint:
--
-- > withDivisibleBy8 :: Integer
-- > -> (forall proxy n . (KnownNat n, IsDivisibleBy8 n) => proxy n -> a)
-- > -> Maybe a
-- > withDivisibleBy8 len fn = do
-- > SomeNat p <- someNatVal len
-- > Refl <- isDivisibleBy8 p
-- > pure (fn p)
--
-- Function @withDivisibleBy8@ above returns 'Nothing' when the argument @len@
-- is negative or not divisible by 8.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Crypto.Number.Nat
( type IsDivisibleBy8
, type IsAtMost, type IsAtLeast
, isDivisibleBy8
, isAtMost
, isAtLeast
) where
import Data.Type.Equality
import GHC.TypeLits
import Unsafe.Coerce (unsafeCoerce)
import Crypto.Internal.Nat
-- | get a runtime proof that the constraint @'IsDivisibleBy8' n@ is satified
isDivisibleBy8 :: KnownNat n => proxy n -> Maybe (IsDiv8 n n :~: 'True)
isDivisibleBy8 n
| mod (natVal n) 8 == 0 = Just (unsafeCoerce Refl)
| otherwise = Nothing
-- | get a runtime proof that the constraint @'IsAtMost' value bound@ is
-- satified
isAtMost :: (KnownNat value, KnownNat bound)
=> proxy value -> proxy' bound -> Maybe ((value <=? bound) :~: 'True)
isAtMost x y
| natVal x <= natVal y = Just (unsafeCoerce Refl)
| otherwise = Nothing
-- | get a runtime proof that the constraint @'IsAtLeast' value bound@ is
-- satified
isAtLeast :: (KnownNat value, KnownNat bound)
=> proxy value -> proxy' bound -> Maybe ((bound <=? value) :~: 'True)
isAtLeast = flip isAtMost

235
bundled/Crypto/Number/Prime.hs Normal file
View file

@ -0,0 +1,235 @@
-- |
-- Module : Crypto.Number.Prime
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Prime
(
generatePrime
, generateSafePrime
, isProbablyPrime
, findPrimeFrom
, findPrimeFromWith
, primalityTestMillerRabin
, primalityTestNaive
, primalityTestFermat
, isCoprime
) where
import Crypto.Number.Compat
import Crypto.Number.Generate
import Crypto.Number.Basic (sqrti, gcde)
import Crypto.Number.ModArithmetic (expSafe)
import Crypto.Random.Types
import Crypto.Random.Probabilistic
import Crypto.Error
import Data.Bits
-- | Returns if the number is probably prime.
-- First a list of small primes are implicitely tested for divisibility,
-- then a fermat primality test is used with arbitrary numbers and
-- then the Miller Rabin algorithm is used with an accuracy of 30 recursions.
isProbablyPrime :: Integer -> Bool
isProbablyPrime !n
| any (\p -> p `divides` n) (filter (< n) firstPrimes) = False
| n >= 2 && n <= 2903 = True
| primalityTestFermat 50 (n `div` 2) n = primalityTestMillerRabin 30 n
| otherwise = False
-- | Generate a prime number of the required bitsize (i.e. in the range
-- [2^(b-1)+2^(b-2), 2^b)).
--
-- May throw a 'CryptoError_PrimeSizeInvalid' if the requested size is less
-- than 5 bits, as the smallest prime meeting these conditions is 29.
-- This function requires that the two highest bits are set, so that when
-- multiplied with another prime to create a key, it is guaranteed to be of
-- the proper size.
generatePrime :: MonadRandom m => Int -> m Integer
generatePrime bits = do
if bits < 5 then
throwCryptoError $ CryptoFailed $ CryptoError_PrimeSizeInvalid
else do
sp <- generateParams bits (Just SetTwoHighest) True
let prime = findPrimeFrom sp
if prime < 1 `shiftL` bits then
return $ prime
else generatePrime bits
-- | Generate a prime number of the form 2p+1 where p is also prime.
-- it is also knowed as a Sophie Germaine prime or safe prime.
--
-- The number of safe prime is significantly smaller to the number of prime,
-- as such it shouldn't be used if this number is supposed to be kept safe.
--
-- May throw a 'CryptoError_PrimeSizeInvalid' if the requested size is less than
-- 6 bits, as the smallest safe prime with the two highest bits set is 59.
generateSafePrime :: MonadRandom m => Int -> m Integer
generateSafePrime bits = do
if bits < 6 then
throwCryptoError $ CryptoFailed $ CryptoError_PrimeSizeInvalid
else do
sp <- generateParams bits (Just SetTwoHighest) True
let p = findPrimeFromWith (\i -> isProbablyPrime (2*i+1)) (sp `div` 2)
let val = 2 * p + 1
if val < 1 `shiftL` bits then
return $ val
else generateSafePrime bits
-- | Find a prime from a starting point where the property hold.
findPrimeFromWith :: (Integer -> Bool) -> Integer -> Integer
findPrimeFromWith prop !n
| even n = findPrimeFromWith prop (n+1)
| otherwise =
if not (isProbablyPrime n)
then findPrimeFromWith prop (n+2)
else
if prop n
then n
else findPrimeFromWith prop (n+2)
-- | Find a prime from a starting point with no specific property.
findPrimeFrom :: Integer -> Integer
findPrimeFrom n =
case gmpNextPrime n of
GmpSupported p -> p
GmpUnsupported -> findPrimeFromWith (\_ -> True) n
-- | Miller Rabin algorithm return if the number is probably prime or composite.
-- the tries parameter is the number of recursion, that determines the accuracy of the test.
primalityTestMillerRabin :: Int -> Integer -> Bool
primalityTestMillerRabin tries !n =
case gmpTestPrimeMillerRabin tries n of
GmpSupported b -> b
GmpUnsupported -> probabilistic run
where
run
| n <= 3 = error "Miller-Rabin requires tested value to be > 3"
| even n = return False
| tries <= 0 = error "Miller-Rabin tries need to be > 0"
| otherwise = loop <$> generateTries tries
!nm1 = n-1
!nm2 = n-2
(!s,!d) = (factorise 0 nm1)
generateTries 0 = return []
generateTries t = do
v <- generateBetween 2 nm2
vs <- generateTries (t-1)
return (v:vs)
-- factorise n-1 into the form 2^s*d
factorise :: Integer -> Integer -> (Integer, Integer)
factorise !si !vi
| vi `testBit` 0 = (si, vi)
| otherwise = factorise (si+1) (vi `shiftR` 1) -- probably faster to not shift v continuously, but just once.
expmod = expSafe
-- when iteration reach zero, we have a probable prime
loop [] = True
loop (w:ws) = let x = expmod w d n
in if x == (1 :: Integer) || x == nm1
then loop ws
else loop' ws ((x*x) `mod` n) 1
-- loop from 1 to s-1. if we reach the end then it's composite
loop' ws !x2 !r
| r == s = False
| x2 == 1 = False
| x2 /= nm1 = loop' ws ((x2*x2) `mod` n) (r+1)
| otherwise = loop ws
{-
n < z -> witness to test
1373653 [2,3]
9080191 [31,73]
4759123141 [2,7,61]
2152302898747 [2,3,5,7,11]
3474749660383 [2,3,5,7,11,13]
341550071728321 [2,3,5,7,11,13,17]
-}
-- | Probabilitic Test using Fermat primility test.
-- Beware of Carmichael numbers that are Fermat liars, i.e. this test
-- is useless for them. always combines with some other test.
primalityTestFermat :: Int -- ^ number of iterations of the algorithm
-> Integer -- ^ starting a
-> Integer -- ^ number to test for primality
-> Bool
primalityTestFermat n a p = and $ map expTest [a..(a+fromIntegral n)]
where !pm1 = p-1
expTest i = expSafe i pm1 p == 1
-- | Test naively is integer is prime.
-- while naive, we skip even number and stop iteration at i > sqrt(n)
primalityTestNaive :: Integer -> Bool
primalityTestNaive n
| n <= 1 = False
| n == 2 = True
| even n = False
| otherwise = search 3
where !ubound = snd $ sqrti n
search !i
| i > ubound = True
| i `divides` n = False
| otherwise = search (i+2)
-- | Test is two integer are coprime to each other
isCoprime :: Integer -> Integer -> Bool
isCoprime m n = case gcde m n of (_,_,d) -> d == 1
-- | List of the first primes till 2903.
firstPrimes :: [Integer]
firstPrimes =
[ 2 , 3 , 5 , 7 , 11 , 13 , 17 , 19 , 23 , 29
, 31 , 37 , 41 , 43 , 47 , 53 , 59 , 61 , 67 , 71
, 73 , 79 , 83 , 89 , 97 , 101 , 103 , 107 , 109 , 113
, 127 , 131 , 137 , 139 , 149 , 151 , 157 , 163 , 167 , 173
, 179 , 181 , 191 , 193 , 197 , 199 , 211 , 223 , 227 , 229
, 233 , 239 , 241 , 251 , 257 , 263 , 269 , 271 , 277 , 281
, 283 , 293 , 307 , 311 , 313 , 317 , 331 , 337 , 347 , 349
, 353 , 359 , 367 , 373 , 379 , 383 , 389 , 397 , 401 , 409
, 419 , 421 , 431 , 433 , 439 , 443 , 449 , 457 , 461 , 463
, 467 , 479 , 487 , 491 , 499 , 503 , 509 , 521 , 523 , 541
, 547 , 557 , 563 , 569 , 571 , 577 , 587 , 593 , 599 , 601
, 607 , 613 , 617 , 619 , 631 , 641 , 643 , 647 , 653 , 659
, 661 , 673 , 677 , 683 , 691 , 701 , 709 , 719 , 727 , 733
, 739 , 743 , 751 , 757 , 761 , 769 , 773 , 787 , 797 , 809
, 811 , 821 , 823 , 827 , 829 , 839 , 853 , 857 , 859 , 863
, 877 , 881 , 883 , 887 , 907 , 911 , 919 , 929 , 937 , 941
, 947 , 953 , 967 , 971 , 977 , 983 , 991 , 997 , 1009 , 1013
, 1019 , 1021 , 1031 , 1033 , 1039 , 1049 , 1051 , 1061 , 1063 , 1069
, 1087 , 1091 , 1093 , 1097 , 1103 , 1109 , 1117 , 1123 , 1129 , 1151
, 1153 , 1163 , 1171 , 1181 , 1187 , 1193 , 1201 , 1213 , 1217 , 1223
, 1229 , 1231 , 1237 , 1249 , 1259 , 1277 , 1279 , 1283 , 1289 , 1291
, 1297 , 1301 , 1303 , 1307 , 1319 , 1321 , 1327 , 1361 , 1367 , 1373
, 1381 , 1399 , 1409 , 1423 , 1427 , 1429 , 1433 , 1439 , 1447 , 1451
, 1453 , 1459 , 1471 , 1481 , 1483 , 1487 , 1489 , 1493 , 1499 , 1511
, 1523 , 1531 , 1543 , 1549 , 1553 , 1559 , 1567 , 1571 , 1579 , 1583
, 1597 , 1601 , 1607 , 1609 , 1613 , 1619 , 1621 , 1627 , 1637 , 1657
, 1663 , 1667 , 1669 , 1693 , 1697 , 1699 , 1709 , 1721 , 1723 , 1733
, 1741 , 1747 , 1753 , 1759 , 1777 , 1783 , 1787 , 1789 , 1801 , 1811
, 1823 , 1831 , 1847 , 1861 , 1867 , 1871 , 1873 , 1877 , 1879 , 1889
, 1901 , 1907 , 1913 , 1931 , 1933 , 1949 , 1951 , 1973 , 1979 , 1987
, 1993 , 1997 , 1999 , 2003 , 2011 , 2017 , 2027 , 2029 , 2039 , 2053
, 2063 , 2069 , 2081 , 2083 , 2087 , 2089 , 2099 , 2111 , 2113 , 2129
, 2131 , 2137 , 2141 , 2143 , 2153 , 2161 , 2179 , 2203 , 2207 , 2213
, 2221 , 2237 , 2239 , 2243 , 2251 , 2267 , 2269 , 2273 , 2281 , 2287
, 2293 , 2297 , 2309 , 2311 , 2333 , 2339 , 2341 , 2347 , 2351 , 2357
, 2371 , 2377 , 2381 , 2383 , 2389 , 2393 , 2399 , 2411 , 2417 , 2423
, 2437 , 2441 , 2447 , 2459 , 2467 , 2473 , 2477 , 2503 , 2521 , 2531
, 2539 , 2543 , 2549 , 2551 , 2557 , 2579 , 2591 , 2593 , 2609 , 2617
, 2621 , 2633 , 2647 , 2657 , 2659 , 2663 , 2671 , 2677 , 2683 , 2687
, 2689 , 2693 , 2699 , 2707 , 2711 , 2713 , 2719 , 2729 , 2731 , 2741
, 2749 , 2753 , 2767 , 2777 , 2789 , 2791 , 2797 , 2801 , 2803 , 2819
, 2833 , 2837 , 2843 , 2851 , 2857 , 2861 , 2879 , 2887 , 2897 , 2903
]
{-# INLINE divides #-}
divides :: Integer -> Integer -> Bool
divides i n = n `mod` i == 0

54
bundled/Crypto/Number/Serialize.hs Normal file
View file

@ -0,0 +1,54 @@
-- |
-- Module : Crypto.Number.Serialize
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- Fast serialization primitives for integer
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Serialize
( i2osp
, os2ip
, i2ospOf
, i2ospOf_
) where
import Crypto.Number.Basic
import Crypto.Internal.Compat (unsafeDoIO)
import qualified Crypto.Internal.ByteArray as B
import qualified Crypto.Number.Serialize.Internal as Internal
-- | @os2ip@ converts a byte string into a positive integer.
os2ip :: B.ByteArrayAccess ba => ba -> Integer
os2ip bs = unsafeDoIO $ B.withByteArray bs (\p -> Internal.os2ip p (B.length bs))
-- | @i2osp@ converts a positive integer into a byte string.
--
-- The first byte is MSB (most significant byte); the last byte is the LSB (least significant byte)
i2osp :: B.ByteArray ba => Integer -> ba
i2osp 0 = B.allocAndFreeze 1 (\p -> Internal.i2osp 0 p 1 >> return ())
i2osp m = B.allocAndFreeze sz (\p -> Internal.i2osp m p sz >> return ())
where
!sz = numBytes m
-- | Just like 'i2osp', but takes an extra parameter for size.
-- If the number is too big to fit in @len@ bytes, 'Nothing' is returned
-- otherwise the number is padded with 0 to fit the @len@ required.
{-# INLINABLE i2ospOf #-}
i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba
i2ospOf len m
| len <= 0 = Nothing
| m < 0 = Nothing
| sz > len = Nothing
| otherwise = Just $ B.unsafeCreate len (\p -> Internal.i2ospOf m p len >> return ())
where
!sz = numBytes m
-- | Just like 'i2ospOf' except that it doesn't expect a failure: i.e.
-- an integer larger than the number of output bytes requested.
--
-- For example if you just took a modulo of the number that represent
-- the size (example the RSA modulo n).
i2ospOf_ :: B.ByteArray ba => Int -> Integer -> ba
i2ospOf_ len = maybe (error "i2ospOf_: integer is larger than expected") id . i2ospOf len

76
bundled/Crypto/Number/Serialize/Internal.hs Normal file
View file

@ -0,0 +1,76 @@
-- |
-- Module : Crypto.Number.Serialize.Internal
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- Fast serialization primitives for integer using raw pointers
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Serialize.Internal
( i2osp
, i2ospOf
, os2ip
) where
import Crypto.Number.Compat
import Crypto.Number.Basic
import Data.Bits
import Data.Memory.PtrMethods
import Data.Word (Word8)
import Foreign.Ptr
import Foreign.Storable
-- | Fill a pointer with the big endian binary representation of an integer
--
-- If the room available @ptrSz@ is less than the number of bytes needed,
-- 0 is returned. Likewise if a parameter is invalid, 0 is returned.
--
-- Returns the number of bytes written
i2osp :: Integer -> Ptr Word8 -> Int -> IO Int
i2osp m ptr ptrSz
| ptrSz <= 0 = return 0
| m < 0 = return 0
| m == 0 = pokeByteOff ptr 0 (0 :: Word8) >> return 1
| ptrSz < sz = return 0
| otherwise = fillPtr ptr sz m >> return sz
where
!sz = numBytes m
-- | Similar to 'i2osp', except it will pad any remaining space with zero.
i2ospOf :: Integer -> Ptr Word8 -> Int -> IO Int
i2ospOf m ptr ptrSz
| ptrSz <= 0 = return 0
| m < 0 = return 0
| ptrSz < sz = return 0
| otherwise = do
memSet ptr 0 ptrSz
fillPtr (ptr `plusPtr` padSz) sz m
return ptrSz
where
!sz = numBytes m
!padSz = ptrSz - sz
fillPtr :: Ptr Word8 -> Int -> Integer -> IO ()
fillPtr p sz m = gmpExportInteger m p `onGmpUnsupported` export (sz-1) m
where
export ofs i
| ofs == 0 = pokeByteOff p ofs (fromIntegral i :: Word8)
| otherwise = do
let (i', b) = i `divMod` 256
pokeByteOff p ofs (fromIntegral b :: Word8)
export (ofs-1) i'
-- | Transform a big endian binary integer representation pointed by a pointer and a size
-- into an integer
os2ip :: Ptr Word8 -> Int -> IO Integer
os2ip ptr ptrSz
| ptrSz <= 0 = return 0
| otherwise = gmpImportInteger ptrSz ptr `onGmpUnsupported` loop 0 0 ptr
where
loop :: Integer -> Int -> Ptr Word8 -> IO Integer
loop !acc i !p
| i == ptrSz = return acc
| otherwise = do
w <- peekByteOff p i :: IO Word8
loop ((acc `shiftL` 8) .|. fromIntegral w) (i+1) p

75
bundled/Crypto/Number/Serialize/Internal/LE.hs Normal file
View file

@ -0,0 +1,75 @@
-- |
-- Module : Crypto.Number.Serialize.Internal.LE
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- Fast serialization primitives for integer using raw pointers (little endian)
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Serialize.Internal.LE
( i2osp
, i2ospOf
, os2ip
) where
import Crypto.Number.Compat
import Crypto.Number.Basic
import Data.Bits
import Data.Memory.PtrMethods
import Data.Word (Word8)
import Foreign.Ptr
import Foreign.Storable
-- | Fill a pointer with the little endian binary representation of an integer
--
-- If the room available @ptrSz@ is less than the number of bytes needed,
-- 0 is returned. Likewise if a parameter is invalid, 0 is returned.
--
-- Returns the number of bytes written
i2osp :: Integer -> Ptr Word8 -> Int -> IO Int
i2osp m ptr ptrSz
| ptrSz <= 0 = return 0
| m < 0 = return 0
| m == 0 = pokeByteOff ptr 0 (0 :: Word8) >> return 1
| ptrSz < sz = return 0
| otherwise = fillPtr ptr sz m >> return sz
where
!sz = numBytes m
-- | Similar to 'i2osp', except it will pad any remaining space with zero.
i2ospOf :: Integer -> Ptr Word8 -> Int -> IO Int
i2ospOf m ptr ptrSz
| ptrSz <= 0 = return 0
| m < 0 = return 0
| ptrSz < sz = return 0
| otherwise = do
memSet ptr 0 ptrSz
fillPtr ptr sz m
return ptrSz
where
!sz = numBytes m
fillPtr :: Ptr Word8 -> Int -> Integer -> IO ()
fillPtr p sz m = gmpExportIntegerLE m p `onGmpUnsupported` export 0 m
where
export ofs i
| ofs >= sz = return ()
| otherwise = do
let (i', b) = i `divMod` 256
pokeByteOff p ofs (fromIntegral b :: Word8)
export (ofs+1) i'
-- | Transform a little endian binary integer representation pointed by a
-- pointer and a size into an integer
os2ip :: Ptr Word8 -> Int -> IO Integer
os2ip ptr ptrSz
| ptrSz <= 0 = return 0
| otherwise = gmpImportIntegerLE ptrSz ptr `onGmpUnsupported` loop 0 (ptrSz-1) ptr
where
loop :: Integer -> Int -> Ptr Word8 -> IO Integer
loop !acc i !p
| i < 0 = return acc
| otherwise = do
w <- peekByteOff p i :: IO Word8
loop ((acc `shiftL` 8) .|. fromIntegral w) (i-1) p

54
bundled/Crypto/Number/Serialize/LE.hs Normal file
View file

@ -0,0 +1,54 @@
-- |
-- Module : Crypto.Number.Serialize.LE
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- Fast serialization primitives for integer (little endian)
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Serialize.LE
( i2osp
, os2ip
, i2ospOf
, i2ospOf_
) where
import Crypto.Number.Basic
import Crypto.Internal.Compat (unsafeDoIO)
import qualified Crypto.Internal.ByteArray as B
import qualified Crypto.Number.Serialize.Internal.LE as Internal
-- | @os2ip@ converts a byte string into a positive integer.
os2ip :: B.ByteArrayAccess ba => ba -> Integer
os2ip bs = unsafeDoIO $ B.withByteArray bs (\p -> Internal.os2ip p (B.length bs))
-- | @i2osp@ converts a positive integer into a byte string.
--
-- The first byte is LSB (least significant byte); the last byte is the MSB (most significant byte)
i2osp :: B.ByteArray ba => Integer -> ba
i2osp 0 = B.allocAndFreeze 1 (\p -> Internal.i2osp 0 p 1 >> return ())
i2osp m = B.allocAndFreeze sz (\p -> Internal.i2osp m p sz >> return ())
where
!sz = numBytes m
-- | Just like 'i2osp', but takes an extra parameter for size.
-- If the number is too big to fit in @len@ bytes, 'Nothing' is returned
-- otherwise the number is padded with 0 to fit the @len@ required.
{-# INLINABLE i2ospOf #-}
i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba
i2ospOf len m
| len <= 0 = Nothing
| m < 0 = Nothing
| sz > len = Nothing
| otherwise = Just $ B.unsafeCreate len (\p -> Internal.i2ospOf m p len >> return ())
where
!sz = numBytes m
-- | Just like 'i2ospOf' except that it doesn't expect a failure: i.e.
-- an integer larger than the number of output bytes requested.
--
-- For example if you just took a modulo of the number that represent
-- the size (example the RSA modulo n).
i2ospOf_ :: B.ByteArray ba => Int -> Integer -> ba
i2ospOf_ len = maybe (error "i2ospOf_: integer is larger than expected") id . i2ospOf len