1-- |
2-- Module      : Crypto.Number.Serialize.Internal.LE
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : Good
7--
8-- Fast serialization primitives for integer using raw pointers (little endian)
9{-# LANGUAGE BangPatterns #-}
10module Crypto.Number.Serialize.Internal.LE
11    ( i2osp
12    , i2ospOf
13    , os2ip
14    ) where
15
16import           Crypto.Number.Compat
17import           Crypto.Number.Basic
18import           Data.Bits
19import           Data.Memory.PtrMethods
20import           Data.Word (Word8)
21import           Foreign.Ptr
22import           Foreign.Storable
23
24-- | Fill a pointer with the little endian binary representation of an integer
25--
26-- If the room available @ptrSz@ is less than the number of bytes needed,
27-- 0 is returned. Likewise if a parameter is invalid, 0 is returned.
28--
29-- Returns the number of bytes written
30i2osp :: Integer -> Ptr Word8 -> Int -> IO Int
31i2osp m ptr ptrSz
32    | ptrSz <= 0 = return 0
33    | m < 0      = return 0
34    | m == 0     = pokeByteOff ptr 0 (0 :: Word8) >> return 1
35    | ptrSz < sz = return 0
36    | otherwise  = fillPtr ptr sz m >> return sz
37  where
38    !sz    = numBytes m
39
40-- | Similar to 'i2osp', except it will pad any remaining space with zero.
41i2ospOf :: Integer -> Ptr Word8 -> Int -> IO Int
42i2ospOf m ptr ptrSz
43    | ptrSz <= 0 = return 0
44    | m < 0      = return 0
45    | ptrSz < sz = return 0
46    | otherwise  = do
47        memSet ptr 0 ptrSz
48        fillPtr ptr sz m
49        return ptrSz
50  where
51    !sz    = numBytes m
52
53fillPtr :: Ptr Word8 -> Int -> Integer -> IO ()
54fillPtr p sz m = gmpExportIntegerLE m p `onGmpUnsupported` export 0 m
55  where
56    export ofs i
57        | ofs >= sz = return ()
58        | otherwise = do
59            let (i', b) = i `divMod` 256
60            pokeByteOff p ofs (fromIntegral b :: Word8)
61            export (ofs+1) i'
62
63-- | Transform a little endian binary integer representation pointed by a
64-- pointer and a size into an integer
65os2ip :: Ptr Word8 -> Int -> IO Integer
66os2ip ptr ptrSz
67    | ptrSz <= 0 = return 0
68    | otherwise  = gmpImportIntegerLE ptrSz ptr `onGmpUnsupported` loop 0 (ptrSz-1) ptr
69  where
70    loop :: Integer -> Int -> Ptr Word8 -> IO Integer
71    loop !acc i !p
72        | i < 0      = return acc
73        | otherwise  = do
74            w <- peekByteOff p i :: IO Word8
75            loop ((acc `shiftL` 8) .|. fromIntegral w) (i-1) p
76