[number] split the serialization to support a more bit banging direct approach

This commit is contained in:
Vincent Hanquez 2015-06-01 05:59:54 +01:00
parent e9c812e4fd
commit d873564c54
3 changed files with 87 additions and 39 deletions

View File

@ -18,64 +18,32 @@ module Crypto.Number.Serialize
import Data.Bits import Data.Bits
import Data.Word import Data.Word
import Foreign.Storable import Foreign.Storable
import Foreign.Ptr
import Crypto.Number.Compat import Crypto.Number.Compat
import Crypto.Internal.Compat (unsafeDoIO) import Crypto.Internal.Compat (unsafeDoIO)
import qualified Crypto.Number.Serialize.Internal as Internal
import qualified Crypto.Internal.ByteArray as B import qualified Crypto.Internal.ByteArray as B
import Data.Memory.PtrMethods
divMod256 :: Integer -> (Integer, Word8)
divMod256 n = (n `shiftR` 8, fromIntegral n)
-- | os2ip converts a byte string into a positive integer -- | os2ip converts a byte string into a positive integer
os2ip :: B.ByteArrayAccess ba => ba -> Integer os2ip :: B.ByteArrayAccess ba => ba -> Integer
os2ip bs = unsafeDoIO $ B.withByteArray bs (loop 0 0) os2ip bs = unsafeDoIO $ B.withByteArray bs $ \src -> Internal.os2ip src (B.length bs)
where
len = B.length bs
loop :: Integer -> Int -> Ptr Word8 -> IO Integer
loop !acc i p
| i == len = return acc
| otherwise = do
w <- peekByteOff p i :: IO Word8
loop ((acc `shiftL` 8) .|. fromIntegral w) (i+1) p
-- | i2osp converts a positive integer into a byte string -- | i2osp converts a positive integer into a byte string
-- --
-- first byte is MSB (most significant byte), last byte is the LSB (least significant byte) -- first byte is MSB (most significant byte), last byte is the LSB (least significant byte)
i2osp :: B.ByteArray ba => Integer -> ba i2osp :: B.ByteArray ba => Integer -> ba
i2osp 0 = B.allocAndFreeze 1 $ \p -> pokeByteOff p 0 (0 :: Word8) i2osp 0 = B.allocAndFreeze 1 $ \p -> pokeByteOff p 0 (0 :: Word8)
i2osp m = B.allocAndFreeze sz (\p -> fillPtr p >> return ()) i2osp m = B.allocAndFreeze sz (\p -> Internal.i2osp m p sz >> return ())
where where
!sz = lengthBytes m !sz = lengthBytes m
fillPtr p = gmpExportInteger m p `onGmpUnsupported` export p (sz-1) m
export p ofs i
| ofs == 0 = pokeByteOff p ofs (fromIntegral i :: Word8)
| otherwise = do
let (i', b) = divMod256 i
pokeByteOff p ofs b
export p (ofs-1) i'
-- | just like i2osp, but take an extra parameter for size. -- | just like i2osp, but take an extra parameter for size.
-- if the number is too big to fit in @len bytes, nothing is returned -- 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. -- otherwise the number is padded with 0 to fit the @len required.
i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba
i2ospOf 0 _ = error "cannot create integer serialization in 0 bytes"
i2ospOf len 0 = Just $ B.allocAndFreeze len $ \p -> memSet p 0 len
i2ospOf len m i2ospOf len m
| sz > len = Nothing | len <= 0 = Nothing
| otherwise = Just $ B.allocAndFreeze len $ \p -> memSet p 0 len >> fillPtr (p `plusPtr` (len - sz)) | m < 0 = Nothing
where | otherwise = Just $ B.unsafeCreate len $ \p -> Internal.i2ospOf m p len >> return ()
!sz = lengthBytes m
fillPtr p = gmpExportInteger m p `onGmpUnsupported` export p (sz-1) m
export p ofs i
| ofs == 0 = pokeByteOff p ofs (fromIntegral i :: Word8)
| otherwise = do
let (i', b) = divMod256 i
pokeByteOff p ofs b
export p (ofs-1) i'
-- --
-- | just like i2ospOf except that it doesn't expect a failure: i.e. -- | just like i2ospOf except that it doesn't expect a failure: i.e.

View File

@ -0,0 +1,79 @@
-- |
-- Module : Crypto.Number.Serialize.Internal
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
-- fast serialization primitives for integer using raw pointers
{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Serialize.Internal
( 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 big 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 >> return sz
where
!sz = numBytes m
fillPtr = gmpExportInteger m ptr `onGmpUnsupported` export ptr (sz-1) m
export p ofs i
| ofs == 0 = pokeByteOff p ofs (fromIntegral i :: Word8)
| otherwise = do
let (i', b) = i `divMod` 256
pokeByteOff p ofs (fromIntegral b :: Word8)
export p (ofs-1) i'
-- | 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 = (if padSz > 0 then memSet ptr 0 padSz else return ()) >> fillPtr (ptr `plusPtr` padSz) >> return ptrSz
where
!sz = numBytes m
!padSz = ptrSz - sz
fillPtr p = gmpExportInteger m p `onGmpUnsupported` export p (sz-1) m
export p ofs i
| ofs == 0 = pokeByteOff p ofs (fromIntegral i :: Word8)
| otherwise = do
let (i', b) = i `divMod` 256
pokeByteOff p ofs (fromIntegral b :: Word8)
export p (ofs-1) i'
-- | transform a big 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 = {-gmpImportInteger ptrSz ptr `onGmpUnsupported` -} loop 0 0 ptr
where
loop :: Integer -> Int -> Ptr Word8 -> IO Integer
loop !acc i p
| i == ptrSz = return acc
| otherwise = do
w <- peekByteOff p i :: IO Word8
loop ((acc `shiftL` 8) .|. fromIntegral w) (i+1) p

View File

@ -86,6 +86,7 @@ Library
Crypto.Number.ModArithmetic Crypto.Number.ModArithmetic
Crypto.Number.Prime Crypto.Number.Prime
Crypto.Number.Serialize Crypto.Number.Serialize
Crypto.Number.Serialize.Internal
Crypto.KDF.PBKDF2 Crypto.KDF.PBKDF2
Crypto.KDF.Scrypt Crypto.KDF.Scrypt
Crypto.Hash Crypto.Hash