[number] split the serialization to support a more bit banging direct approach
This commit is contained in:
parent
e9c812e4fd
commit
d873564c54
@ -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.
|
||||||
|
|||||||
79
Crypto/Number/Serialize/Internal.hs
Normal file
79
Crypto/Number/Serialize/Internal.hs
Normal 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
|
||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user