{-# LANGUAGE BangPatterns #-}
module Crypto.Number.Serialize
( i2osp
, os2ip
, i2ospOf
, i2ospOf_
) where
import Crypto.Number.Basic
import Crypto.Internal.Compat (unsafeDoIO)
import qualified Crypto.Internal.ByteArray as B
import qualified Crypto.Number.Serialize.Internal as Internal
os2ip :: B.ByteArrayAccess ba => ba -> Integer
os2ip :: forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ba
bs = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
bs (\Ptr Word8
p -> Ptr Word8 -> Int -> IO Integer
Internal.os2ip Ptr Word8
p (forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
bs))
i2osp :: B.ByteArray ba => Integer -> ba
i2osp :: forall ba. ByteArray ba => Integer -> ba
i2osp Integer
0 = forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
1 (\Ptr Word8
p -> Integer -> Ptr Word8 -> Int -> IO Int
Internal.i2osp Integer
0 Ptr Word8
p Int
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ())
i2osp Integer
m = forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
sz (\Ptr Word8
p -> Integer -> Ptr Word8 -> Int -> IO Int
Internal.i2osp Integer
m Ptr Word8
p Int
sz forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ())
where
!sz :: Int
sz = Integer -> Int
numBytes Integer
m
{-# INLINABLE i2ospOf #-}
i2ospOf :: B.ByteArray ba => Int -> Integer -> Maybe ba
i2ospOf :: forall ba. ByteArray ba => Int -> Integer -> Maybe ba
i2ospOf Int
len Integer
m
| Int
len forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Maybe a
Nothing
| Integer
m forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a. Maybe a
Nothing
| Int
sz forall a. Ord a => a -> a -> Bool
> Int
len = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.unsafeCreate Int
len (\Ptr Word8
p -> Integer -> Ptr Word8 -> Int -> IO Int
Internal.i2ospOf Integer
m Ptr Word8
p Int
len forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ())
where
!sz :: Int
sz = Integer -> Int
numBytes Integer
m
i2ospOf_ :: B.ByteArray ba => Int -> Integer -> ba
i2ospOf_ :: forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
len = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error [Char]
"i2ospOf_: integer is larger than expected") forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba. ByteArray ba => Int -> Integer -> Maybe ba
i2ospOf Int
len