diff --git a/.haskell-ci b/.haskell-ci index fc2947c..17cb6a3 100644 --- a/.haskell-ci +++ b/.haskell-ci @@ -2,15 +2,15 @@ compiler: ghc-8.0 lts-9.21 compiler: ghc-8.2 lts-11.22 compiler: ghc-8.4 lts-12.26 -compiler: ghc-8.6 lts-13.3 +compiler: ghc-8.6 lts-13.21 # options # option: alias x=y z=v option: gaugedeps extradep=gauge-0.2.1 -option: basementmin extradep=basement-0.0.6 extradep=foundation-0.0.19 extradep=memory-0.14.14 +option: basementmin extradep=basement-0.0.8 extradep=memory-0.14.18 # builds -build: ghc-8.2 +build: ghc-8.2 basementmin build: ghc-8.0 basementmin gaugedeps build: ghc-8.0 basementmin gaugedeps os=osx build: ghc-8.4 diff --git a/.travis.yml b/.travis.yml index eb4f365..4aa5de8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,4 +1,4 @@ -# ~*~ auto-generated by haskell-ci with config : 8f74deffc95fd794fa2996c167c6543bbfab1ae432f0a83e0898f0b5871a92eb ~*~ +# ~*~ auto-generated by haskell-ci with config : cb76551db808ad3472d36865246ef3849351a6c78535dd987bd37bc95bfd47c0 ~*~ # Use new container infrastructure to enable caching sudo: false @@ -49,15 +49,15 @@ script: # create the build stack.yaml case "$RESOLVER" in ghc-8.2) - echo "{ resolver: lts-11.22, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml + echo "{ resolver: lts-11.22, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18 ], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.0) - echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml + echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18, gauge-0.2.1 ], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.0) - echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml + echo "{ resolver: lts-9.21, packages: [ '.' ], extra-deps: [ basement-0.0.8, memory-0.14.18, gauge-0.2.1 ], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.4) @@ -65,7 +65,7 @@ script: stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; ghc-8.6) - echo "{ resolver: lts-13.3, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml + echo "{ resolver: lts-13.21, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; esac diff --git a/Crypto/Number/Compat.hs b/Crypto/Number/Compat.hs index 6a77c22..01e0455 100644 --- a/Crypto/Number/Compat.hs +++ b/Crypto/Number/Compat.hs @@ -22,7 +22,9 @@ module Crypto.Number.Compat , gmpSizeInBytes , gmpSizeInBits , gmpExportInteger + , gmpExportIntegerLE , gmpImportInteger + , gmpImportIntegerLE ) where #ifndef MIN_VERSION_integer_gmp @@ -134,7 +136,7 @@ gmpSizeInBits n = GmpSupported (I# (word2Int# (sizeInBaseInteger n 2#))) gmpSizeInBits _ = GmpUnsupported #endif --- | Export an integer to a memory +-- | 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 @@ -148,7 +150,21 @@ gmpExportInteger n (Ptr addr) = GmpSupported $ IO $ \s -> gmpExportInteger _ _ = GmpUnsupported #endif --- | Import an integer from a memory +-- | 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 $ @@ -159,3 +175,15 @@ gmpImportInteger (I# n) (Ptr addr) = GmpSupported $ IO $ \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 diff --git a/Crypto/Number/Serialize/Internal.hs b/Crypto/Number/Serialize/Internal.hs index 2f86380..bfa9622 100644 --- a/Crypto/Number/Serialize/Internal.hs +++ b/Crypto/Number/Serialize/Internal.hs @@ -23,7 +23,7 @@ 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, +-- 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 @@ -69,7 +69,7 @@ os2ip ptr ptrSz | otherwise = gmpImportInteger ptrSz ptr `onGmpUnsupported` loop 0 0 ptr where loop :: Integer -> Int -> Ptr Word8 -> IO Integer - loop !acc i p + loop !acc i !p | i == ptrSz = return acc | otherwise = do w <- peekByteOff p i :: IO Word8 diff --git a/Crypto/Number/Serialize/Internal/LE.hs b/Crypto/Number/Serialize/Internal/LE.hs new file mode 100644 index 0000000..d4c2594 --- /dev/null +++ b/Crypto/Number/Serialize/Internal/LE.hs @@ -0,0 +1,75 @@ +-- | +-- Module : Crypto.Number.Serialize.Internal.LE +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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 diff --git a/Crypto/Number/Serialize/LE.hs b/Crypto/Number/Serialize/LE.hs new file mode 100644 index 0000000..9f7fbae --- /dev/null +++ b/Crypto/Number/Serialize/LE.hs @@ -0,0 +1,54 @@ +-- | +-- Module : Crypto.Number.Serialize.LE +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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 diff --git a/cryptonite.cabal b/cryptonite.cabal index 0c9b036..7a97a0c 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -36,7 +36,7 @@ Build-Type: Simple Homepage: https://github.com/haskell-crypto/cryptonite Bug-reports: https://github.com/haskell-crypto/cryptonite/issues Cabal-Version: >=1.18 -tested-with: GHC==8.6.1, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 +tested-with: GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 extra-doc-files: README.md CHANGELOG.md extra-source-files: cbits/*.h cbits/aes/*.h @@ -134,7 +134,9 @@ Library Crypto.Number.Nat Crypto.Number.Prime Crypto.Number.Serialize + Crypto.Number.Serialize.LE Crypto.Number.Serialize.Internal + Crypto.Number.Serialize.Internal.LE Crypto.KDF.Argon2 Crypto.KDF.PBKDF2 Crypto.KDF.Scrypt @@ -237,7 +239,7 @@ Library Build-depends: base Build-depends: bytestring - , memory >= 0.14.14 + , memory >= 0.14.18 , basement >= 0.0.6 , ghc-prim ghc-options: -Wall -fwarn-tabs -optc-O3 diff --git a/stack.yaml b/stack.yaml index bf246bb..85bc4e8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ -# ~*~ auto-generated by haskell-ci with config : 8f74deffc95fd794fa2996c167c6543bbfab1ae432f0a83e0898f0b5871a92eb ~*~ -{ resolver: lts-13.2, packages: [ '.' ], extra-deps: [], flags: {} } +# ~*~ auto-generated by haskell-ci with config : cb76551db808ad3472d36865246ef3849351a6c78535dd987bd37bc95bfd47c0 ~*~ +{ resolver: lts-13.21, packages: [ '.' ], extra-deps: [], flags: {} } diff --git a/tests/Number.hs b/tests/Number.hs index fd77fa7..0b8f654 100644 --- a/tests/Number.hs +++ b/tests/Number.hs @@ -4,9 +4,11 @@ module Number (tests) where import Imports import Data.ByteArray (Bytes) +import qualified Data.ByteArray as B import Crypto.Number.Basic import Crypto.Number.Generate -import Crypto.Number.Serialize +import qualified Crypto.Number.Serialize as BE +import qualified Crypto.Number.Serialize.LE as LE import Crypto.Number.Prime import Data.Bits @@ -50,14 +52,24 @@ tests = testGroup "number" bits = 6 + baseBits prime = withTestDRG testDRG $ generateSafePrime bits in bits == numBits prime - , testProperty "marshalling" $ \qaInt -> - getQAInteger qaInt == os2ip (i2osp (getQAInteger qaInt) :: Bytes) , testProperty "as-power-of-2-and-odd" $ \n -> let (e, a1) = asPowerOf2AndOdd n in n == (2^e)*a1 + , testProperty "marshalling-be" $ \qaInt -> + getQAInteger qaInt == BE.os2ip (BE.i2osp (getQAInteger qaInt) :: Bytes) + , testProperty "marshalling-le" $ \qaInt -> + getQAInteger qaInt == LE.os2ip (LE.i2osp (getQAInteger qaInt) :: Bytes) + , testProperty "be-rev-le" $ \qaInt -> + getQAInteger qaInt == LE.os2ip (B.reverse (BE.i2osp (getQAInteger qaInt) :: Bytes)) + , testProperty "be-rev-le-40" $ \qaInt -> + getQAInteger qaInt == LE.os2ip (B.reverse (BE.i2ospOf_ 40 (getQAInteger qaInt) :: Bytes)) + , testProperty "le-rev-be" $ \qaInt -> + getQAInteger qaInt == BE.os2ip (B.reverse (LE.i2osp (getQAInteger qaInt) :: Bytes)) + , testProperty "le-rev-be-40" $ \qaInt -> + getQAInteger qaInt == BE.os2ip (B.reverse (LE.i2ospOf_ 40 (getQAInteger qaInt) :: Bytes)) , testGroup "marshalling-kat-to-bytearray" $ map toSerializationKat $ zip [katZero..] serializationVectors , testGroup "marshalling-kat-to-integer" $ map toSerializationKatInteger $ zip [katZero..] serializationVectors ] where - toSerializationKat (i, (sz, n, ba)) = testCase (show i) (ba @=? i2ospOf_ sz n) - toSerializationKatInteger (i, (_, n, ba)) = testCase (show i) (n @=? os2ip ba) + toSerializationKat (i, (sz, n, ba)) = testCase (show i) (ba @=? BE.i2ospOf_ sz n) + toSerializationKatInteger (i, (_, n, ba)) = testCase (show i) (n @=? BE.os2ip ba)