integer-gmp 1.0.1.0 → 1.0.2.0
raw patch · 6 files changed
+213/−23 lines, 6 filesdep ~ghc-prim
Dependency ranges changed: ghc-prim
Files
- cbits/wrappers.c +61/−2
- changelog.md +7/−0
- include/HsIntegerGmp.h.in +3/−3
- integer-gmp.cabal +3/−3
- src/GHC/Integer/GMP/Internals.hs +4/−0
- src/GHC/Integer/Type.hs +135/−15
cbits/wrappers.c view
@@ -11,6 +11,7 @@ #include "HsFFI.h" #include "MachDeps.h"+#include "HsIntegerGmp.h" #include <assert.h> #include <stdbool.h>@@ -312,7 +313,7 @@ const mp_size_t ssn = s[0]._mp_size; const mp_size_t sn = mp_size_abs(ssn);- assert(sn <= xn);+ assert(sn <= mp_size_abs(xn)); memcpy(s0, s[0]._mp_d, sn*sizeof(mp_limb_t)); mpz_clear (s); @@ -626,7 +627,7 @@ } const mpz_t b = CONST_MPZ_INIT(bp, mp_limb_zero_p(bp,bn) ? 0 : bn);- const mpz_t e = CONST_MPZ_INIT(ep, mp_limb_zero_p(ep,en) ? 0 : en);+ const mpz_t e = CONST_MPZ_INIT(ep, en); const mpz_t m = CONST_MPZ_INIT(mp, mn); mpz_t r;@@ -685,6 +686,64 @@ const mp_limb_t m0) // mod { return integer_gmp_powm1(&b0, !!b0, &e0, !!e0, m0);+}++/* version of integer_gmp_powm() based on mpz_powm_sec+ *+ * With GMP 5.0 or later execution time depends on size of arguments+ * and size of result.+ *+ * 'M' must be odd and 'E' non-negative.+ */+mp_size_t+integer_gmp_powm_sec(mp_limb_t rp[], // result+ const mp_limb_t bp[], const mp_size_t bn, // base+ const mp_limb_t ep[], const mp_size_t en, // exponent+ const mp_limb_t mp[], const mp_size_t mn) // mod+{+ assert(!mp_limb_zero_p(mp,mn));+ assert(mp[0] & 1);++ if ((mn == 1 || mn == -1) && mp[0] == 1) {+ rp[0] = 0;+ return 1;+ }++ if (mp_limb_zero_p(ep,en)) {+ rp[0] = 1;+ return 1;+ }++ assert(en > 0);++ const mpz_t b = CONST_MPZ_INIT(bp, mp_limb_zero_p(bp,bn) ? 0 : bn);+ const mpz_t e = CONST_MPZ_INIT(ep, en);+ const mpz_t m = CONST_MPZ_INIT(mp, mn);++ mpz_t r;+ mpz_init (r);++#if HAVE_SECURE_POWM == 0+ mpz_powm(r, b, e, m);+#else+ mpz_powm_sec(r, b, e, m);+#endif++ const mp_size_t rn = r[0]._mp_size;++ if (rn) {+ assert(0 < rn && rn <= mn);+ memcpy(rp, r[0]._mp_d, rn*sizeof(mp_limb_t));+ }++ mpz_clear (r);++ if (!rn) {+ rp[0] = 0;+ return 1;+ }++ return rn; }
changelog.md view
@@ -1,5 +1,12 @@ # Changelog for [`integer-gmp` package](http://hackage.haskell.org/package/integer-gmp) +## 1.0.2.0 *April 2018*++ * Bundled with GHC 8.4.2++ * Define `powModSecInteger`, a "secure" version of `powModInteger` using the+ `mpz_powm_sec` function.+ ## 1.0.1.0 *July 2017* * Bundled with GHC 8.2.1
include/HsIntegerGmp.h.in view
@@ -1,5 +1,4 @@-#ifndef _HS_INTEGER_GMP_H_-#define _HS_INTEGER_GMP_H_+#pragma once /* Whether GMP is embedded into integer-gmp */ #define GHC_GMP_INTREE @UseIntreeGmp@@@ -11,4 +10,5 @@ #define GHC_GMP_VERSION \ (@GhcGmpVerMj@ * 10000 + @GhcGmpVerMi@ * 100 + @GhcGmpVerPl@) -#endif /* _HS_INTEGER_GMP_H_ */+/* Whether GMP supports mpz_powm_sec */+#define HAVE_SECURE_POWM @HaveSecurePowm@
integer-gmp.cabal view
@@ -1,6 +1,6 @@-cabal-version: 2.0+cabal-version: >=1.10 name: integer-gmp-version: 1.0.1.0+version: 1.0.2.0 synopsis: Integer library based on GMP license: BSD3@@ -55,7 +55,7 @@ StandaloneDeriving UnboxedTuples UnliftedFFITypes- build-depends: ghc-prim ^>= 0.5.1.0+ build-depends: ghc-prim >= 0.5.2 && < 0.6 hs-source-dirs: src/ ghc-options: -this-unit-id integer-gmp -Wall cc-options: -std=c99 -Wall
src/GHC/Integer/GMP/Internals.hs view
@@ -48,6 +48,7 @@ , lcmInteger , sqrInteger , powModInteger+ , powModSecInteger , recipModInteger -- ** Additional conversion operations to 'Integer'@@ -106,6 +107,9 @@ , shiftRBigNat , shiftLBigNat , testBitBigNat+ , clearBitBigNat+ , complementBitBigNat+ , setBitBigNat , andBigNat , xorBigNat , popCountBigNat
src/GHC/Integer/Type.hs view
@@ -25,6 +25,7 @@ module GHC.Integer.Type where #include "MachDeps.h"+#include "HsIntegerGmp.h" -- Sanity check as CPP defines are implicitly 0-valued when undefined #if !(defined(SIZEOF_LONG) && defined(SIZEOF_HSWORD) \@@ -586,15 +587,15 @@ -- Even though the shift-amount is expressed as `Int#`, the result is -- undefined for negative shift-amounts. shiftLInteger :: Integer -> Int# -> Integer-shiftLInteger x 0# = x+shiftLInteger x 0# = x shiftLInteger (S# 0#) _ = S# 0# shiftLInteger (S# 1#) n# = bitInteger n# shiftLInteger (S# i#) n#- | isTrue# (i# >=# 0#) = bigNatToInteger (shiftLBigNat- (wordToBigNat (int2Word# i#)) n#)- | True = bigNatToNegInteger (shiftLBigNat- (wordToBigNat (int2Word#- (negateInt# i#))) n#)+ | isTrue# (i# >=# 0#) = bigNatToInteger (shiftLBigNat+ (wordToBigNat (int2Word# i#)) n#)+ | True = bigNatToNegInteger (shiftLBigNat+ (wordToBigNat (int2Word#+ (negateInt# i#))) n#) shiftLInteger (Jp# bn) n# = Jp# (shiftLBigNat bn n#) shiftLInteger (Jn# bn) n# = Jn# (shiftLBigNat bn n#) {-# CONSTANT_FOLDED shiftLInteger #-}@@ -1059,7 +1060,7 @@ mbn@(MBN# mba#) <- newBigNat# (li# +# 1#) -- FIXME: do we really need to zero-init MBAs returned by 'newByteArray#'? -- clear all limbs (except for the most-significant limb)- _ <- svoid (setByteArray# mba# 0# (li# `uncheckedIShiftL#` GMP_LIMB_SHIFT#) 0#)+ _ <- svoid (clearWordArray# mba# 0# li#) -- set single bit in most-significant limb _ <- svoid (writeBigNat# mbn li# (uncheckedShiftL# 1## bi#)) unsafeFreezeBigNat# mbn@@ -1090,6 +1091,67 @@ allZ j | isTrue# (indexBigNat# bn (j -# 1#) `eqWord#` 0##) = allZ (j -# 1#) | True = False ++clearBitBigNat :: BigNat -> Int# -> BigNat+clearBitBigNat bn i#+ | not (inline testBitBigNat bn i#) = bn+ | isTrue# (nx# ==# 1#) = wordToBigNat (bigNatToWord bn `xor#` bitWord# bi#)+ | isTrue# (li# +# 1# ==# nx#) = -- special case, operating on most-sig limb+ case indexBigNat# bn li# `xor#` bitWord# bi# of+ 0## -> do -- most-sig limb became zero -> result has less limbs+ case fmssl bn (li# -# 1#) of+ 0# -> zeroBigNat+ n# -> runS $ do+ mbn <- newBigNat# n#+ _ <- copyWordArray bn 0# mbn 0# n#+ unsafeFreezeBigNat# mbn+ newlimb# -> runS $ do -- no shrinking+ mbn <- newBigNat# nx#+ _ <- copyWordArray bn 0# mbn 0# li#+ _ <- svoid (writeBigNat# mbn li# newlimb#)+ unsafeFreezeBigNat# mbn++ | True = runS $ do+ mbn <- newBigNat# nx#+ _ <- copyWordArray bn 0# mbn 0# nx#+ let newlimb# = indexBigNat# bn li# `xor#` bitWord# bi#+ _ <- svoid (writeBigNat# mbn li# newlimb#)+ unsafeFreezeBigNat# mbn++ where+ !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#+ nx# = sizeofBigNat# bn++++setBitBigNat :: BigNat -> Int# -> BigNat+setBitBigNat bn i#+ | inline testBitBigNat bn i# = bn+ | isTrue# (d# ># 0#) = runS $ do -- result BigNat will have more limbs+ mbn@(MBN# mba#) <- newBigNat# (li# +# 1#)+ _ <- copyWordArray bn 0# mbn 0# nx#+ _ <- svoid (clearWordArray# mba# nx# (d# -# 1#))+ _ <- svoid (writeBigNat# mbn li# (bitWord# bi#))+ unsafeFreezeBigNat# mbn++ | True = runS $ do+ mbn <- newBigNat# nx#+ _ <- copyWordArray bn 0# mbn 0# nx#+ _ <- svoid (writeBigNat# mbn li# (indexBigNat# bn li#+ `or#` bitWord# bi#))+ unsafeFreezeBigNat# mbn++ where+ !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS#+ nx# = sizeofBigNat# bn+ d# = li# +# 1# -# nx#+++complementBitBigNat :: BigNat -> Int# -> BigNat+complementBitBigNat bn i#+ | testBitBigNat bn i# = clearBitBigNat bn i#+ | True = setBitBigNat bn i#+ popCountBigNat :: BigNat -> Int# popCountBigNat bn@(BN# ba#) = word2Int# (c_mpn_popcount ba# (sizeofBigNat# bn)) @@ -1376,6 +1438,32 @@ b' = integerToSBigNat b e' = integerToSBigNat e +-- | \"@'powModSecInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to+-- exponent @/e/@ modulo @/m/@. It is required that @/e/ >= 0@ and+-- @/m/@ is odd.+--+-- This is a \"secure\" variant of 'powModInteger' using the+-- @mpz_powm_sec()@ function which is designed to be resilient to side+-- channel attacks and is therefore intended for cryptographic+-- applications.+--+-- This primitive is only available when the underlying GMP library+-- supports it (GMP >= 5). Otherwise, it internally falls back to+-- @'powModInteger'@, and a warning will be emitted when used.+--+-- @since 1.0.2.0+{-# NOINLINE powModSecInteger #-}+powModSecInteger :: Integer -> Integer -> Integer -> Integer+powModSecInteger b e m = bigNatToInteger (powModSecSBigNat b' e' m')+ where+ b' = integerToSBigNat b+ e' = integerToSBigNat e+ m' = absSBigNat (integerToSBigNat m)++#if HAVE_SECURE_POWM == 0+{-# WARNING powModSecInteger "The underlying GMP library does not support a secure version of powModInteger which is side-channel resistant - you need at least GMP version 5 to support this" #-}+#endif+ -- | Version of 'powModInteger' operating on 'BigNat's -- -- @since 1.0.0.0@@ -1428,7 +1516,28 @@ integer_gmp_powm1# :: ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb# +-- internal non-exported helper+powModSecSBigNat :: SBigNat -> SBigNat -> BigNat -> BigNat+powModSecSBigNat b e m@(BN# m#) = runS $ do+ r@(MBN# r#) <- newBigNat# mn#+ I# rn_# <- liftIO (integer_gmp_powm_sec# r# b# bn# e# en# m# mn#)+ let rn# = narrowGmpSize# rn_#+ case isTrue# (rn# ==# mn#) of+ False -> unsafeShrinkFreezeBigNat# r rn#+ True -> unsafeFreezeBigNat# r+ where+ !(BN# b#) = absSBigNat b+ !(BN# e#) = absSBigNat e+ bn# = ssizeofSBigNat# b+ en# = ssizeofSBigNat# e+ mn# = sizeofBigNat# m +foreign import ccall unsafe "integer_gmp_powm_sec"+ integer_gmp_powm_sec# :: MutableByteArray# RealWorld+ -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#+ -> ByteArray# -> GmpSize# -> IO GmpSize++ -- | \"@'recipModInteger' /x/ /m/@\" computes the inverse of @/x/@ modulo @/m/@. If -- the inverse exists, the return value @/y/@ will satisfy @0 < /y/ < -- abs(/m/)@, otherwise the result is @0@.@@ -1746,6 +1855,15 @@ dst (dst_ofs `uncheckedIShiftL#` GMP_LIMB_SHIFT#) (len `uncheckedIShiftL#` GMP_LIMB_SHIFT#) +copyWordArray :: BigNat -> Int# -> MutBigNat s -> Int# -> Int# -> S s ()+copyWordArray (BN# ba#) ofs_ba# (MBN# mba#) ofs_mba# len#+ = svoid (copyWordArray# ba# ofs_ba# mba# ofs_mba# len#)++clearWordArray# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+clearWordArray# mba ofs len+ = setByteArray# mba (ofs `uncheckedIShiftL#` GMP_LIMB_SHIFT#)+ (len `uncheckedIShiftL#` GMP_LIMB_SHIFT#) 0#+ -- | Version of 'normSizeofMutBigNat'#' which scans all allocated 'MutBigNat#' normSizeofMutBigNat# :: MutBigNat s -> State# s -> (# State# s, Int# #) normSizeofMutBigNat# mbn@(MBN# mba) s = normSizeofMutBigNat'# mbn sz# s'@@ -1789,13 +1907,7 @@ where !(# baszq#, baszr# #) = quotRemInt# (sizeofByteArray# ba#) GMP_LIMB_BYTES# - n# = fmssl (n0# -# 1#)-- -- find most significant set limb, return normalized size- fmssl i#- | isTrue# (i# <# 0#) = 0#- | isTrue# (neWord# (indexWordArray# ba# i#) 0##) = i# +# 1#- | True = fmssl (i# -# 1#)+ n# = fmssl (BN# ba#) (n0# -# 1#) -- | Read 'Integer' (without sign) from memory location at @/addr/@ in -- base-256 representation.@@ -1996,7 +2108,7 @@ intToSBigNat# 1# = PosBN oneBigNat intToSBigNat# (-1#) = NegBN oneBigNat intToSBigNat# i# | isTrue# (i# ># 0#) = PosBN (wordToBigNat (int2Word# i#))- | True = PosBN (wordToBigNat (int2Word# (negateInt# i#)))+ | True = NegBN (wordToBigNat (int2Word# (negateInt# i#))) -- | Convert 'Integer' into 'SBigNat' integerToSBigNat :: Integer -> SBigNat@@ -2048,3 +2160,11 @@ minI# :: Int# -> Int# -> Int# minI# x# y# | isTrue# (x# <=# y#) = x# | True = y#++-- find most-sig set limb, starting at given index+fmssl :: BigNat -> Int# -> Int#+fmssl !bn i0# = go i0#+ where+ go i# | isTrue# (i# <# 0#) = 0#+ | isTrue# (neWord# (indexBigNat# bn i#) 0##) = i# +# 1#+ | True = go (i# -# 1#)