diff --git a/Crypto/Number/Basic.hs b/Crypto/Number/Basic.hs --- a/Crypto/Number/Basic.hs +++ b/Crypto/Number/Basic.hs @@ -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 #-} diff --git a/Crypto/Number/F2m.hs b/Crypto/Number/F2m.hs --- a/Crypto/Number/F2m.hs +++ b/Crypto/Number/F2m.hs @@ -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 #-} diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -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 diff --git a/Crypto/Number/Serialize.hs b/Crypto/Number/Serialize.hs --- a/Crypto/Number/Serialize.hs +++ b/Crypto/Number/Serialize.hs @@ -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 diff --git a/Tests/Tests.hs b/Tests/Tests.hs --- a/Tests/Tests.hs +++ b/Tests/Tests.hs @@ -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 ] ] diff --git a/crypto-numbers.cabal b/crypto-numbers.cabal --- a/crypto-numbers.cabal +++ b/crypto-numbers.cabal @@ -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