Merge pull request #277 from ocheron/little-endian

Little-endian integer serialization

.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

.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

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

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

Crypto/Number/Serialize/Internal/LE.hs

@@ -0,0 +1,75 @@
+-- |
+-- Module      : Crypto.Number.Serialize.Internal.LE
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- 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

Crypto/Number/Serialize/LE.hs

@@ -0,0 +1,54 @@
+-- |
+-- Module      : Crypto.Number.Serialize.LE
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- 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

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

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: {} }
 

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)