1-- |
2-- Module      : Crypto.Number.Serialize.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 (little endian)
9{-# LANGUAGE BangPatterns #-}
10module Crypto.Number.Serialize.LE
11    ( i2osp
12    , os2ip
13    , i2ospOf
14    , i2ospOf_
15    ) where
16
17import           Crypto.Number.Basic
18import           Crypto.Internal.Compat (unsafeDoIO)
19import qualified Crypto.Internal.ByteArray as B
20import qualified Crypto.Number.Serialize.Internal.LE as Internal
21
22-- | @os2ip@ converts a byte string into a positive integer.
23os2ip :: B.ByteArrayAccess ba => ba -> Integer
24os2ip bs = unsafeDoIO $ B.withByteArray bs (\p -> Internal.os2ip p (B.length bs))
25
26-- | @i2osp@ converts a positive integer into a byte string.
27--
28-- The first byte is LSB (least significant byte); the last byte is the MSB (most significant byte)
29i2osp :: B.ByteArray ba => Integer -> ba
30i2osp 0 = B.allocAndFreeze 1  (\p -> Internal.i2osp 0 p 1 >> return ())
31i2osp m = B.allocAndFreeze sz (\p -> Internal.i2osp m p sz >> return ())
32  where
33        !sz = numBytes m
34
35-- | Just like 'i2osp', but takes an extra parameter for size.
36-- If the number is too big to fit in @len@ bytes, 'Nothing' is returned
37-- otherwise the number is padded with 0 to fit the @len@ required.
38{-# INLINABLE i2ospOf #-}
39i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba
40i2ospOf len m
41    | len <= 0  = Nothing
42    | m < 0     = Nothing
43    | sz > len  = Nothing
44    | otherwise = Just $ B.unsafeCreate len (\p -> Internal.i2ospOf m p len >> return ())
45  where
46        !sz = numBytes m
47
48-- | Just like 'i2ospOf' except that it doesn't expect a failure: i.e.
49-- an integer larger than the number of output bytes requested.
50--
51-- For example if you just took a modulo of the number that represent
52-- the size (example the RSA modulo n).
53i2ospOf_ :: B.ByteArray ba => Int -> Integer -> ba
54i2ospOf_ len = maybe (error "i2ospOf_: integer is larger than expected") id . i2ospOf len
55