-- |
-- 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 :: Integer -> Ptr Word8 -> Int -> IO Int
i2osp Integer
m Ptr Word8
ptr Int
ptrSz
    | Int
ptrSz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
    | Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0      = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
    | Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0     = Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ptr Int
0 (Word8
0 :: Word8) IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
    | Int
ptrSz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
    | Bool
otherwise  = Ptr Word8 -> Int -> Integer -> IO ()
fillPtr Ptr Word8
ptr Int
sz Integer
m IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
sz
  where
    !sz :: Int
sz    = Integer -> Int
numBytes Integer
m

-- | Similar to 'i2osp', except it will pad any remaining space with zero.
i2ospOf :: Integer -> Ptr Word8 -> Int -> IO Int
i2ospOf :: Integer -> Ptr Word8 -> Int -> IO Int
i2ospOf Integer
m Ptr Word8
ptr Int
ptrSz
    | Int
ptrSz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
    | Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0      = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
    | Int
ptrSz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
    | Bool
otherwise  = do
        Ptr Word8 -> Word8 -> Int -> IO ()
memSet Ptr Word8
ptr Word8
0 Int
ptrSz
        Ptr Word8 -> Int -> Integer -> IO ()
fillPtr Ptr Word8
ptr Int
sz Integer
m
        Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ptrSz
  where
    !sz :: Int
sz    = Integer -> Int
numBytes Integer
m

fillPtr :: Ptr Word8 -> Int -> Integer -> IO ()
fillPtr :: Ptr Word8 -> Int -> Integer -> IO ()
fillPtr Ptr Word8
p Int
sz Integer
m = Integer -> Ptr Word8 -> GmpSupported (IO ())
gmpExportIntegerLE Integer
m Ptr Word8
p GmpSupported (IO ()) -> IO () -> IO ()
forall a. GmpSupported a -> a -> a
`onGmpUnsupported` Int -> Integer -> IO ()
forall t. Integral t => Int -> t -> IO ()
export Int
0 Integer
m
  where
    export :: Int -> t -> IO ()
export Int
ofs t
i
        | Int
ofs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sz = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
            let (t
i', t
b) = t
i t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
`divMod` t
256
            Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
p Int
ofs (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
b :: Word8)
            Int -> t -> IO ()
export (Int
ofsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) t
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 Word8 -> Int -> IO Integer
os2ip Ptr Word8
ptr Int
ptrSz
    | Int
ptrSz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
    | Bool
otherwise  = Int -> Ptr Word8 -> GmpSupported (IO Integer)
gmpImportIntegerLE Int
ptrSz Ptr Word8
ptr GmpSupported (IO Integer) -> IO Integer -> IO Integer
forall a. GmpSupported a -> a -> a
`onGmpUnsupported` Integer -> Int -> Ptr Word8 -> IO Integer
loop Integer
0 (Int
ptrSzInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Ptr Word8
ptr
  where
    loop :: Integer -> Int -> Ptr Word8 -> IO Integer
    loop :: Integer -> Int -> Ptr Word8 -> IO Integer
loop !Integer
acc Int
i !Ptr Word8
p
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0      = Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
acc
        | Bool
otherwise  = do
            Word8
w <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p Int
i :: IO Word8
            Integer -> Int -> Ptr Word8 -> IO Integer
loop ((Integer
acc Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Ptr Word8
p