packages feed

crypto-numbers 0.2.3 → 0.2.4

raw patch · 6 files changed

+80/−56 lines, 6 filesdep +tastydep +tasty-hunitdep +tasty-quickcheckdep −HUnitdep −QuickCheckdep −test-framework

Dependencies added: tasty, tasty-hunit, tasty-quickcheck

Dependencies removed: HUnit, QuickCheck, test-framework, test-framework-hunit, test-framework-quickcheck2

Files

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,7 @@  import Control.Applicative ((<$>)) import Data.Bits ((.&.),(.|.),xor,shift,testBit)--#ifdef VERSION_integer_gmp-import GHC.Exts-import GHC.Integer.Logarithms (integerLog2#)-#endif+import Crypto.Number.Basic  -- | Addition over F₂m. This is just a synonym of  'xor'. addF2m :: Integer -> Integer -> Integer@@ -90,12 +83,10 @@ invF2m fx n = 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 == 0    = Nothing+          | 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 #-}@@ -108,18 +99,3 @@        -> 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/Generate.hs view
@@ -11,20 +11,31 @@     , generateOfSize     ) where +import Crypto.Number.Basic import Crypto.Number.Serialize import Crypto.Random.API import qualified Data.ByteString as B-import Data.Bits ((.|.))+import Data.Bits ((.|.), (.&.), shiftL) --- | generate a positive integer x, s.t. 0 <= x < m------ Note that depending on m value, the number distribution--- generated by this function is not necessarily uniform.+-- | generate a positive integer x, s.t. 0 <= x < m, uniformly at random generateMax :: CPRG g => g -> Integer -> (Integer, g)-generateMax rng m = withRandomBytes rng (lengthBytes m) $ \bs ->-    os2ip bs `mod` m+generateMax rng m+    | m < 1 = error "generateMax: m must be >= 1"+    | m == 1 = (0,rng)+    | otherwise =+        let (tentativeResult, rng') =+                withRandomBytes rng (lengthBytes m) $ \bs ->+                    let lengthBits = (log2 (m-1) + 1)+                        mask = if lengthBits `mod` 8 == 0+                               then 0xff+                               else (1 `shiftL` (lengthBits `mod` 8)) - 1 in+                    os2ip $ snd $ B.mapAccumL (\acc w -> (0xff, w .&. acc))+                                      mask bs in+        if tentativeResult < m+            then (tentativeResult, rng')+            else generateMax rng' m --- | generate a number between the inclusive bound [low,high].+-- | generate a number between the inclusive bound [low,high] uniformly at random. generateBetween :: CPRG g => g -> Integer -> Integer -> (Integer, g) generateBetween rng low high = (low + v, rng')     where (v, rng') = generateMax rng (high - low + 1)
Crypto/Number/Serialize.hs view
@@ -23,6 +23,7 @@  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)@@ -32,7 +33,6 @@ import System.IO.Unsafe import Foreign.ForeignPtr #else-import qualified Data.ByteString as B import Foreign.Storable import Data.Bits #endif@@ -48,7 +48,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 +63,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) = 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 +116,22 @@             | len < isz  = error "cannot compute i2ospOf_ with integer larger than output bytes"             | len == isz =                 let !(Ptr srcAddr) = ptr in+#if __GLASGOW_HASKELL__ >= 710+                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+                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 1" (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.4 Description:         Cryptographic numbers: functions and algorithms License:             BSD3 License-file:        LICENSE@@ -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 >= 0.10.0.1+                   , tasty-quickcheck+                   , tasty-hunit   ghc-options:       -Wall -O2  Benchmark bench-crypto-numbers