crypto-numbers 0.2.3 → 0.2.7
raw patch · 6 files changed
Files
- Crypto/Number/Basic.hs +23/−0
- Crypto/Number/F2m.hs +19/−34
- Crypto/Number/ModArithmetic.hs +6/−0
- Crypto/Number/Serialize.hs +21/−1
- Tests/Tests.hs +11/−12
- crypto-numbers.cabal +6/−8
Crypto/Number/Basic.hs view
@@ -6,6 +6,9 @@ #if MIN_VERSION_integer_gmp(0,5,1) {-# LANGUAGE UnboxedTuples #-} #endif+#ifdef VERSION_integer_gmp+{-# LANGUAGE MagicHash #-}+#endif -- | -- Module : Crypto.Number.Basic -- License : BSD-style@@ -18,6 +21,7 @@ , gcde , gcde_binary , areEven+ , log2 ) where #if MIN_VERSION_integer_gmp(0,5,1)@@ -25,6 +29,10 @@ #else import Data.Bits #endif+#ifdef VERSION_integer_gmp+import GHC.Exts+import GHC.Integer.Logarithms (integerLog2#)+#endif -- | sqrti returns two integer (l,b) so that l <= sqrt i <= b -- the implementation is quite naive, use an approximation for the first number@@ -110,3 +118,18 @@ -- | check if a list of integer are all even areEven :: [Integer] -> Bool areEven = and . map even++log2 :: Integer -> Int+#ifdef VERSION_integer_gmp+log2 0 = 0+log2 x = I# (integerLog2# x)+#else+-- http://www.haskell.org/pipermail/haskell-cafe/2008-February/039465.html+log2 = imLog 2+ where+ 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)+#endif+{-# INLINE log2 #-}
Crypto/Number/F2m.hs view
@@ -2,9 +2,6 @@ #ifndef MIN_VERSION_integer_gmp #define MIN_VERSION_integer_gmp(a,b,c) 0 #endif-#ifdef VERSION_integer_gmp-{-# LANGUAGE MagicHash #-}-#endif -- | -- Module : Crypto.Number.F2m -- License : BSD-style@@ -27,11 +24,9 @@ import Control.Applicative ((<$>)) import Data.Bits ((.&.),(.|.),xor,shift,testBit)+import Crypto.Number.Basic -#ifdef VERSION_integer_gmp-import GHC.Exts-import GHC.Integer.Logarithms (integerLog2#)-#endif+type BinaryPolynomial = Integer -- | Addition over F₂m. This is just a synonym of 'xor'. addF2m :: Integer -> Integer -> Integer@@ -52,7 +47,9 @@ {-# INLINE modF2m #-} -- | Multiplication over F₂m.-mulF2m :: Integer -- ^ Irreducible binary polynomial+--+-- n1 * n2 (in F(2^m))+mulF2m :: BinaryPolynomial -- ^ Irreducible binary polynomial -> Integer -> Integer -> Integer mulF2m fx n1 n2 = modF2m fx $ go (if n2 `mod` 2 == 1 then n1 else 0) (log2 n2)@@ -67,7 +64,7 @@ -- TODO: This is still slower than @mulF2m@. -- Multiplication table? C?-squareF2m :: Integer -- ^ Irreducible binary polynomial+squareF2m :: BinaryPolynomial -- ^ Irreducible binary polynomial -> Integer -> Integer squareF2m fx = modF2m fx . square {-# INLINE squareF2m #-}@@ -83,43 +80,31 @@ y = n .&. (shift 1 (2 * (ln1 - s) + 1) - 1) {-# INLINE square #-} --- | Inversion over F₂m using extended Euclidean algorithm.-invF2m :: Integer -- ^ Irreducible binary polynomial+-- | Inversion of @n over F₂m using extended Euclidean algorithm.+--+-- If @n doesn't have an inverse, Nothing is returned.+invF2m :: BinaryPolynomial -- ^ Irreducible binary polynomial -> Integer -> Maybe Integer invF2m _ 0 = Nothing-invF2m fx n = go n fx 1 0+invF2m fx n+ | n >= fx = Nothing+ | otherwise = go n fx 1 0 where go u v g1 g2- | u == 1 = Just $ modF2m fx g1- | otherwise = if j < 0- then go u (v `xor` shift u (-j))- g1 (g2 `xor` shift g1 (-j))- else go (u `xor` shift v j) v- (g1 `xor` shift g2 j) g2+ | u == 1 = Just $ modF2m fx g1+ | j < 0 = go u (v `xor` shift u (-j)) g1 (g2 `xor` shift g1 (-j))+ | otherwise = go (u `xor` shift v j) v (g1 `xor` shift g2 j) g2 where j = log2 u - log2 v {-# INLINABLE invF2m #-} -- | Division over F₂m. If the dividend doesn't have an inverse it returns -- 'Nothing'.-divF2m :: Integer -- ^ Irreducible binary polynomial+--+-- Compute n1 / n2+divF2m :: BinaryPolynomial -- ^ Irreducible binary polynomial -> Integer -- ^ Dividend -> Integer -- ^ Quotient -> Maybe Integer divF2m fx n1 n2 = mulF2m fx n1 <$> invF2m fx n2 {-# INLINE divF2m #-}--log2 :: Integer -> Int-#if defined(VERSION_integer_gmp)-log2 0 = 0-log2 x = I# (integerLog2# x)-#else--- http://www.haskell.org/pipermail/haskell-cafe/2008-February/039465.html-log2 = imLog 2- where- 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)-#endif-{-# INLINE log2 #-}
Crypto/Number/ModArithmetic.hs view
@@ -51,13 +51,19 @@ -- 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.+--+-- with GHC 7.10, the powModSecInteger is missing from integer-gmp+-- (which is now integer-gmp2), so is has the same security as old+-- ghc version. expSafe :: Integer -- ^ base -> Integer -- ^ exponant -> Integer -- ^ modulo -> Integer -- ^ result #if MIN_VERSION_integer_gmp(0,5,1) expSafe b e m+#if !(MIN_VERSION_integer_gmp(1,0,0)) | odd m = powModSecInteger b e m+#endif | otherwise = powModInteger b e m #else expSafe = exponentiation
Crypto/Number/Serialize.hs view
@@ -23,16 +23,19 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Internal as B+import qualified Data.ByteString as B import Foreign.Ptr #if MIN_VERSION_integer_gmp(0,5,1)+#if __GLASGOW_HASKELL__ >= 710+import Control.Monad (void)+#endif import GHC.Integer.GMP.Internals import GHC.Base import GHC.Ptr import System.IO.Unsafe import Foreign.ForeignPtr #else-import qualified Data.ByteString as B import Foreign.Storable import Data.Bits #endif@@ -48,7 +51,11 @@ #if MIN_VERSION_integer_gmp(0,5,1) os2ip bs = unsafePerformIO $ withForeignPtr fptr $ \ptr -> let !(Ptr ad) = (ptr `plusPtr` ofs)+#if __GLASGOW_HASKELL__ >= 710+ in importIntegerFromAddr ad (int2Word# n) 1#+#else in IO $ \s -> importIntegerFromAddr ad (int2Word# n) 1# s+#endif where !(fptr, ofs, !(I# n)) = B.toForeignPtr bs {-# NOINLINE os2ip #-} #else@@ -59,10 +66,15 @@ -- | i2osp converts a positive integer into a byte string i2osp :: Integer -> ByteString #if MIN_VERSION_integer_gmp(0,5,1)+i2osp 0 = B.singleton 0 i2osp m = B.unsafeCreate (I# (word2Int# sz)) fillPtr where !sz = sizeInBaseInteger m 256#+#if __GLASGOW_HASKELL__ >= 710+ fillPtr (Ptr srcAddr) = void $ exportIntegerToAddr m srcAddr 1#+#else fillPtr (Ptr srcAddr) = IO $ \s -> case exportIntegerToAddr m srcAddr 1# s of (# s2, _ #) -> (# s2, () #)+#endif {-# NOINLINE i2osp #-} #else i2osp m@@ -107,14 +119,22 @@ | len < isz = error "cannot compute i2ospOf_ with integer larger than output bytes" | len == isz = let !(Ptr srcAddr) = ptr in+#if __GLASGOW_HASKELL__ >= 710+ void (exportIntegerToAddr m srcAddr 1#)+#else IO $ \s -> case exportIntegerToAddr m srcAddr 1# s of (# s2, _ #) -> (# s2, () #)+#endif | otherwise = do let z = len-isz _ <- B.memset ptr 0 (fromIntegral len) let !(Ptr addr) = ptr `plusPtr` z+#if __GLASGOW_HASKELL__ >= 710+ void (exportIntegerToAddr m addr 1#)+#else IO $ \s -> case exportIntegerToAddr m addr 1# s of (# s2, _ #) -> (# s2, () #)+#endif {-# NOINLINE i2ospOf_ #-} #else i2ospOf_ len m = B.unsafeCreate len fillPtr
Tests/Tests.hs view
@@ -1,12 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} -import Test.Framework (defaultMain, testGroup, Test)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.Framework.Providers.HUnit (testCase)--import Test.QuickCheck-import Test.HUnit ((@?=))---import Test.QuickCheck.Test+import Test.Tasty+import Test.Tasty.QuickCheck+import Test.Tasty.HUnit import Control.Applicative ((<$>)) @@ -68,7 +64,8 @@ in (v >= 0 && v < h) prop_invF2m_valid :: Fx -> PositiveLarge -> Bool-prop_invF2m_valid (Fx fx) (PositiveLarge a) = maybe True ((1 ==) . mulF2m fx a) (invF2m fx a)+prop_invF2m_valid (Fx fx) (PositiveLarge a) =+ maybe True ((1 ==) . mulF2m fx a) (invF2m fx a) prop_squareF2m_valid :: Fx -> PositiveLarge -> Bool prop_squareF2m_valid (Fx fx) (PositiveLarge a) = mulF2m fx a a == squareF2m fx a@@ -123,7 +120,7 @@ instance Arbitrary Seed where arbitrary = arbitrary >>= \(Positive i) -> return (Seed i) -serializationKATTests :: [Test]+serializationKATTests :: [TestTree] serializationKATTests = concatMap f vectors where f (v, bs) = [ testCase ("i2osp " ++ show v) (i2osp v @?= bs) , testCase ("os2ip " ++ show v) (os2ip bs @?= v)@@ -136,7 +133,7 @@ , (0x7521908421feabd21490, "u!\144\132!\254\171\210\DC4\144") ] -serializationOfKATTests :: [Test]+serializationOfKATTests :: [TestTree] serializationOfKATTests = concatMap f vectors where f (elen, v, bs) = [ testCase ("i2osp " ++ show v) (i2ospOf elen v @?= Just bs) , testCase ("os2ip " ++ show v) (os2ip bs @?= v)@@ -150,7 +147,7 @@ ] main :: IO ()-main = defaultMain+main = defaultMain $ testGroup "crypto-numbers" [ testGroup "serialization" [ testProperty "unbinary.binary==id" (\(Positive i) -> os2ip (i2osp i) == i) , testProperty "length integer" (\(Positive i) -> B.length (i2osp i) == lengthBytes i)@@ -178,7 +175,9 @@ [ testProperty "miller-rabin" prop_miller_rabin_valid ] , testGroup "F2m"- [ testProperty "invF2m" prop_invF2m_valid+ [ testCase "inv2Fm 1" (invF2m 283 566 @?= Nothing)+ , testCase "inv2Fm 2" (invF2m 283 64800122153546929198091027632453789752394810192663929321789113225485980298851325347397170296259938610151214285229944494947456450203170796566256526607878773803495973593989422 @?= Nothing)+ , testProperty "invF2m" prop_invF2m_valid , testProperty "squareF2m" prop_squareF2m_valid ] ]
crypto-numbers.cabal view
@@ -1,5 +1,5 @@ Name: crypto-numbers-Version: 0.2.3+Version: 0.2.7 Description: Cryptographic numbers: functions and algorithms License: BSD3 License-file: LICENSE@@ -9,7 +9,7 @@ Synopsis: Cryptographic numbers: functions and algorithms Category: Cryptography Build-Type: Simple-Homepage: http://github.com/vincenthz/hs-crypto-numbers+Homepage: https://github.com/vincenthz/hs-crypto-numbers Cabal-Version: >=1.8 Extra-Source-Files: Tests/*.hs @@ -44,11 +44,9 @@ , bytestring , byteable , vector- , QuickCheck >= 2- , HUnit- , test-framework >= 0.3.3- , test-framework-quickcheck2 >= 0.2.9- , test-framework-hunit+ , tasty+ , tasty-quickcheck+ , tasty-hunit ghc-options: -Wall -O2 Benchmark bench-crypto-numbers@@ -63,4 +61,4 @@ source-repository head type: git- location: git://github.com/vincenthz/hs-crypto-numbers+ location: https://github.com/vincenthz/hs-crypto-numbers