{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
module Crypto.Store.Block
( Block, Offset(..), CountOf(..), PrimType(..)
, createWithPtr, Crypto.Store.Block.map, unsafeCast, unsafeIndex
) where
import Data.Memory.Endian
import Data.Proxy
import Data.Word
import Foreign.Ptr (castPtr)
import GHC.Exts
import GHC.IO (IO(..))
import GHC.Word
import System.IO.Unsafe
data Block a = Block ByteArray#
data MutableBlock a = MutableBlock (MutableByteArray# RealWorld)
newtype CountOf a = CountOf Int deriving (Int -> CountOf a -> ShowS
[CountOf a] -> ShowS
CountOf a -> String
(Int -> CountOf a -> ShowS)
-> (CountOf a -> String)
-> ([CountOf a] -> ShowS)
-> Show (CountOf a)
forall a. Int -> CountOf a -> ShowS
forall a. [CountOf a] -> ShowS
forall a. CountOf a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> CountOf a -> ShowS
showsPrec :: Int -> CountOf a -> ShowS
$cshow :: forall a. CountOf a -> String
show :: CountOf a -> String
$cshowList :: forall a. [CountOf a] -> ShowS
showList :: [CountOf a] -> ShowS
Show, CountOf a -> CountOf a -> Bool
(CountOf a -> CountOf a -> Bool)
-> (CountOf a -> CountOf a -> Bool) -> Eq (CountOf a)
forall a. CountOf a -> CountOf a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. CountOf a -> CountOf a -> Bool
== :: CountOf a -> CountOf a -> Bool
$c/= :: forall a. CountOf a -> CountOf a -> Bool
/= :: CountOf a -> CountOf a -> Bool
Eq, Eq (CountOf a)
Eq (CountOf a) =>
(CountOf a -> CountOf a -> Ordering)
-> (CountOf a -> CountOf a -> Bool)
-> (CountOf a -> CountOf a -> Bool)
-> (CountOf a -> CountOf a -> Bool)
-> (CountOf a -> CountOf a -> Bool)
-> (CountOf a -> CountOf a -> CountOf a)
-> (CountOf a -> CountOf a -> CountOf a)
-> Ord (CountOf a)
CountOf a -> CountOf a -> Bool
CountOf a -> CountOf a -> Ordering
CountOf a -> CountOf a -> CountOf a
forall a. Eq (CountOf a)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. CountOf a -> CountOf a -> Bool
forall a. CountOf a -> CountOf a -> Ordering
forall a. CountOf a -> CountOf a -> CountOf a
$ccompare :: forall a. CountOf a -> CountOf a -> Ordering
compare :: CountOf a -> CountOf a -> Ordering
$c< :: forall a. CountOf a -> CountOf a -> Bool
< :: CountOf a -> CountOf a -> Bool
$c<= :: forall a. CountOf a -> CountOf a -> Bool
<= :: CountOf a -> CountOf a -> Bool
$c> :: forall a. CountOf a -> CountOf a -> Bool
> :: CountOf a -> CountOf a -> Bool
$c>= :: forall a. CountOf a -> CountOf a -> Bool
>= :: CountOf a -> CountOf a -> Bool
$cmax :: forall a. CountOf a -> CountOf a -> CountOf a
max :: CountOf a -> CountOf a -> CountOf a
$cmin :: forall a. CountOf a -> CountOf a -> CountOf a
min :: CountOf a -> CountOf a -> CountOf a
Ord)
newtype Offset a = Offset Int deriving (Int -> Offset a -> ShowS
[Offset a] -> ShowS
Offset a -> String
(Int -> Offset a -> ShowS)
-> (Offset a -> String) -> ([Offset a] -> ShowS) -> Show (Offset a)
forall a. Int -> Offset a -> ShowS
forall a. [Offset a] -> ShowS
forall a. Offset a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Offset a -> ShowS
showsPrec :: Int -> Offset a -> ShowS
$cshow :: forall a. Offset a -> String
show :: Offset a -> String
$cshowList :: forall a. [Offset a] -> ShowS
showList :: [Offset a] -> ShowS
Show, Offset a -> Offset a -> Bool
(Offset a -> Offset a -> Bool)
-> (Offset a -> Offset a -> Bool) -> Eq (Offset a)
forall a. Offset a -> Offset a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Offset a -> Offset a -> Bool
== :: Offset a -> Offset a -> Bool
$c/= :: forall a. Offset a -> Offset a -> Bool
/= :: Offset a -> Offset a -> Bool
Eq, Eq (Offset a)
Eq (Offset a) =>
(Offset a -> Offset a -> Ordering)
-> (Offset a -> Offset a -> Bool)
-> (Offset a -> Offset a -> Bool)
-> (Offset a -> Offset a -> Bool)
-> (Offset a -> Offset a -> Bool)
-> (Offset a -> Offset a -> Offset a)
-> (Offset a -> Offset a -> Offset a)
-> Ord (Offset a)
Offset a -> Offset a -> Bool
Offset a -> Offset a -> Ordering
Offset a -> Offset a -> Offset a
forall a. Eq (Offset a)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Offset a -> Offset a -> Bool
forall a. Offset a -> Offset a -> Ordering
forall a. Offset a -> Offset a -> Offset a
$ccompare :: forall a. Offset a -> Offset a -> Ordering
compare :: Offset a -> Offset a -> Ordering
$c< :: forall a. Offset a -> Offset a -> Bool
< :: Offset a -> Offset a -> Bool
$c<= :: forall a. Offset a -> Offset a -> Bool
<= :: Offset a -> Offset a -> Bool
$c> :: forall a. Offset a -> Offset a -> Bool
> :: Offset a -> Offset a -> Bool
$c>= :: forall a. Offset a -> Offset a -> Bool
>= :: Offset a -> Offset a -> Bool
$cmax :: forall a. Offset a -> Offset a -> Offset a
max :: Offset a -> Offset a -> Offset a
$cmin :: forall a. Offset a -> Offset a -> Offset a
min :: Offset a -> Offset a -> Offset a
Ord, Integer -> Offset a
Offset a -> Offset a
Offset a -> Offset a -> Offset a
(Offset a -> Offset a -> Offset a)
-> (Offset a -> Offset a -> Offset a)
-> (Offset a -> Offset a -> Offset a)
-> (Offset a -> Offset a)
-> (Offset a -> Offset a)
-> (Offset a -> Offset a)
-> (Integer -> Offset a)
-> Num (Offset a)
forall a. Integer -> Offset a
forall a. Offset a -> Offset a
forall a. Offset a -> Offset a -> Offset a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: forall a. Offset a -> Offset a -> Offset a
+ :: Offset a -> Offset a -> Offset a
$c- :: forall a. Offset a -> Offset a -> Offset a
- :: Offset a -> Offset a -> Offset a
$c* :: forall a. Offset a -> Offset a -> Offset a
* :: Offset a -> Offset a -> Offset a
$cnegate :: forall a. Offset a -> Offset a
negate :: Offset a -> Offset a
$cabs :: forall a. Offset a -> Offset a
abs :: Offset a -> Offset a
$csignum :: forall a. Offset a -> Offset a
signum :: Offset a -> Offset a
$cfromInteger :: forall a. Integer -> Offset a
fromInteger :: Integer -> Offset a
Num)
class PrimType a where
primSizeInBytes :: Proxy a -> CountOf Word8
primBaIndex :: ByteArray# -> Offset a -> a
primMbaWrite :: MutableByteArray# RealWorld -> Offset a -> a -> IO ()
instance PrimType Word8 where
primSizeInBytes :: Proxy Word8 -> CountOf Word8
primSizeInBytes Proxy Word8
_ = Int -> CountOf Word8
forall a. Int -> CountOf a
CountOf Int
1
{-# INLINE primSizeInBytes #-}
primBaIndex :: ByteArray# -> Offset Word8 -> Word8
primBaIndex ByteArray#
ba (Offset (I# Int#
n)) = Word8# -> Word8
W8# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
ba Int#
n)
{-# INLINE primBaIndex #-}
primMbaWrite :: MutableByteArray# RealWorld -> Offset Word8 -> Word8 -> IO ()
primMbaWrite MutableByteArray# RealWorld
mba (Offset (I# Int#
n)) (W8# Word8#
w) = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> (# MutableByteArray# RealWorld
-> Int# -> Word8# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Word8# -> State# d -> State# d
writeWord8Array# MutableByteArray# RealWorld
mba Int#
n Word8#
w State# RealWorld
s, () #)
{-# INLINE primMbaWrite #-}
instance PrimType Word16 where
primSizeInBytes :: Proxy Word16 -> CountOf Word8
primSizeInBytes Proxy Word16
_ = Int -> CountOf Word8
forall a. Int -> CountOf a
CountOf Int
2
{-# INLINE primSizeInBytes #-}
primBaIndex :: ByteArray# -> Offset Word16 -> Word16
primBaIndex ByteArray#
ba (Offset (I# Int#
n)) = Word16# -> Word16
W16# (ByteArray# -> Int# -> Word16#
indexWord16Array# ByteArray#
ba Int#
n)
{-# INLINE primBaIndex #-}
primMbaWrite :: MutableByteArray# RealWorld -> Offset Word16 -> Word16 -> IO ()
primMbaWrite MutableByteArray# RealWorld
mba (Offset (I# Int#
n)) (W16# Word16#
w) = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> (# MutableByteArray# RealWorld
-> Int# -> Word16# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Word16# -> State# d -> State# d
writeWord16Array# MutableByteArray# RealWorld
mba Int#
n Word16#
w State# RealWorld
s, () #)
{-# INLINE primMbaWrite #-}
instance PrimType a => PrimType (LE a) where
primSizeInBytes :: Proxy (LE a) -> CountOf Word8
primSizeInBytes Proxy (LE a)
_ = Proxy a -> CountOf Word8
forall a. PrimType a => Proxy a -> CountOf Word8
primSizeInBytes (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
{-# INLINE primSizeInBytes #-}
primBaIndex :: ByteArray# -> Offset (LE a) -> LE a
primBaIndex ByteArray#
ba (Offset Int
i) = a -> LE a
forall a. a -> LE a
LE (a -> LE a) -> a -> LE a
forall a b. (a -> b) -> a -> b
$ ByteArray# -> Offset a -> a
forall a. PrimType a => ByteArray# -> Offset a -> a
primBaIndex ByteArray#
ba (Int -> Offset a
forall a. Int -> Offset a
Offset Int
i)
{-# INLINE primBaIndex #-}
primMbaWrite :: MutableByteArray# RealWorld -> Offset (LE a) -> LE a -> IO ()
primMbaWrite MutableByteArray# RealWorld
mba (Offset Int
i) (LE a
x) = MutableByteArray# RealWorld -> Offset a -> a -> IO ()
forall a.
PrimType a =>
MutableByteArray# RealWorld -> Offset a -> a -> IO ()
primMbaWrite MutableByteArray# RealWorld
mba (Int -> Offset a
forall a. Int -> Offset a
Offset Int
i) a
x
{-# INLINE primMbaWrite #-}
create :: PrimType a => CountOf a -> (Offset a -> a) -> Block a
create :: forall a. PrimType a => CountOf a -> (Offset a -> a) -> Block a
create n :: CountOf a
n@(CountOf !Int
sz) Offset a -> a
f = IO (Block a) -> Block a
forall a. IO a -> a
unsafeDupablePerformIO (IO (Block a) -> Block a) -> IO (Block a) -> Block a
forall a b. (a -> b) -> a -> b
$ do
mb <- CountOf a -> IO (MutableBlock a)
forall a. PrimType a => CountOf a -> IO (MutableBlock a)
new CountOf a
n
loop mb 0
unsafeFreeze mb
where
loop :: MutableBlock a -> Int -> IO ()
loop !MutableBlock a
mb Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise =
let off :: Offset a
off = Int -> Offset a
forall a. Int -> Offset a
Offset Int
i
in MutableBlock a -> Offset a -> a -> IO ()
forall a. PrimType a => MutableBlock a -> Offset a -> a -> IO ()
unsafeWrite MutableBlock a
mb Offset a
forall {a}. Offset a
off (Offset a -> a
f Offset a
forall {a}. Offset a
off) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutableBlock a -> Int -> IO ()
loop MutableBlock a
mb (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE create #-}
createWithPtr :: CountOf Word8 -> (Ptr p -> IO a) -> Block Word8
createWithPtr :: forall p a. CountOf Word8 -> (Ptr p -> IO a) -> Block Word8
createWithPtr CountOf Word8
n Ptr p -> IO a
f = IO (Block Word8) -> Block Word8
forall a. IO a -> a
unsafeDupablePerformIO (IO (Block Word8) -> Block Word8)
-> IO (Block Word8) -> Block Word8
forall a b. (a -> b) -> a -> b
$ do
b <- CountOf Word8 -> IO (MutableBlock Word8)
forall a. CountOf Word8 -> IO (MutableBlock a)
unsafeNewPinned CountOf Word8
n IO (MutableBlock Word8)
-> (MutableBlock Word8 -> IO (Block Word8)) -> IO (Block Word8)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutableBlock Word8 -> IO (Block Word8)
forall a. MutableBlock a -> IO (Block a)
unsafeFreeze
f (castPtr $ unsafeBlockPtr b) *> touch b
return b
{-# INLINE createWithPtr #-}
length :: forall a. PrimType a => Block a -> CountOf a
length :: forall a. PrimType a => Block a -> CountOf a
length (Block ByteArray#
ba) = Int -> CountOf a
forall a. Int -> CountOf a
CountOf (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
sz)
where CountOf Int
sz = Proxy a -> CountOf Word8
forall a. PrimType a => Proxy a -> CountOf Word8
primSizeInBytes (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
{-# INLINE length #-}
map :: (PrimType a, PrimType b) => (a -> b) -> Block a -> Block b
map :: forall a b.
(PrimType a, PrimType b) =>
(a -> b) -> Block a -> Block b
map a -> b
f Block a
b = CountOf b -> (Offset b -> b) -> Block b
forall a. PrimType a => CountOf a -> (Offset a -> a) -> Block a
create (Int -> CountOf b
forall a. Int -> CountOf a
CountOf Int
len) ((Offset b -> b) -> Block b) -> (Offset b -> b) -> Block b
forall a b. (a -> b) -> a -> b
$ \(Offset Int
i) -> a -> b
f (Block a -> Offset a -> a
forall a. PrimType a => Block a -> Offset a -> a
unsafeIndex Block a
b (Int -> Offset a
forall a. Int -> Offset a
Offset Int
i))
where CountOf Int
len = Block a -> CountOf a
forall a. PrimType a => Block a -> CountOf a
Crypto.Store.Block.length Block a
b
{-# INLINE map #-}
new :: forall a. PrimType a => CountOf a -> IO (MutableBlock a)
new :: forall a. PrimType a => CountOf a -> IO (MutableBlock a)
new (CountOf Int
n) = (State# RealWorld -> (# State# RealWorld, MutableBlock a #))
-> IO (MutableBlock a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, MutableBlock a #))
-> IO (MutableBlock a))
-> (State# RealWorld -> (# State# RealWorld, MutableBlock a #))
-> IO (MutableBlock a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s1 ->
case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
bytes State# RealWorld
s1 of
(# State# RealWorld
s2, MutableByteArray# RealWorld
mba #) -> (# State# RealWorld
s2, MutableByteArray# RealWorld -> MutableBlock a
forall a. MutableByteArray# RealWorld -> MutableBlock a
MutableBlock MutableByteArray# RealWorld
mba #)
where
!(I# Int#
bytes) = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sz
CountOf Int
sz = Proxy a -> CountOf Word8
forall a. PrimType a => Proxy a -> CountOf Word8
primSizeInBytes (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
{-# INLINE new #-}
touch :: Block a -> IO ()
touch :: forall a. Block a -> IO ()
touch (Block ByteArray#
ba) = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s1 -> case ByteArray# -> State# RealWorld -> State# RealWorld
forall a d. a -> State# d -> State# d
touch# ByteArray#
ba State# RealWorld
s1 of { State# RealWorld
s2 -> (# State# RealWorld
s2, () #) }
unsafeBlockPtr :: Block a -> Ptr a
unsafeBlockPtr :: forall a. Block a -> Ptr a
unsafeBlockPtr (Block ByteArray#
ba) = Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
ba)
{-# INLINE unsafeBlockPtr #-}
unsafeCast :: Block a -> Block b
unsafeCast :: forall a b. Block a -> Block b
unsafeCast (Block ByteArray#
ba) = ByteArray# -> Block b
forall a. ByteArray# -> Block a
Block ByteArray#
ba
{-# INLINE unsafeCast #-}
unsafeFreeze :: MutableBlock a -> IO (Block a)
unsafeFreeze :: forall a. MutableBlock a -> IO (Block a)
unsafeFreeze (MutableBlock MutableByteArray# RealWorld
mba) = (State# RealWorld -> (# State# RealWorld, Block a #))
-> IO (Block a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Block a #))
-> IO (Block a))
-> (State# RealWorld -> (# State# RealWorld, Block a #))
-> IO (Block a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s1 ->
case MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# RealWorld
mba State# RealWorld
s1 of
(# State# RealWorld
s2, ByteArray#
ba #) -> (# State# RealWorld
s2, ByteArray# -> Block a
forall a. ByteArray# -> Block a
Block ByteArray#
ba #)
{-# INLINE unsafeFreeze #-}
unsafeIndex :: PrimType a => Block a -> Offset a -> a
unsafeIndex :: forall a. PrimType a => Block a -> Offset a -> a
unsafeIndex (Block ByteArray#
ba) = ByteArray# -> Offset a -> a
forall a. PrimType a => ByteArray# -> Offset a -> a
primBaIndex ByteArray#
ba
{-# INLINE unsafeIndex #-}
unsafeNewPinned :: CountOf Word8 -> IO (MutableBlock a)
unsafeNewPinned :: forall a. CountOf Word8 -> IO (MutableBlock a)
unsafeNewPinned (CountOf (I# Int#
bytes)) = (State# RealWorld -> (# State# RealWorld, MutableBlock a #))
-> IO (MutableBlock a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, MutableBlock a #))
-> IO (MutableBlock a))
-> (State# RealWorld -> (# State# RealWorld, MutableBlock a #))
-> IO (MutableBlock a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s1 ->
case Int#
-> Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Int#
bytes Int#
8# State# RealWorld
s1 of
(# State# RealWorld
s2, MutableByteArray# RealWorld
mba #) -> (# State# RealWorld
s2, MutableByteArray# RealWorld -> MutableBlock a
forall a. MutableByteArray# RealWorld -> MutableBlock a
MutableBlock MutableByteArray# RealWorld
mba #)
{-# INLINE unsafeNewPinned #-}
unsafeWrite :: PrimType a => MutableBlock a -> Offset a -> a -> IO ()
unsafeWrite :: forall a. PrimType a => MutableBlock a -> Offset a -> a -> IO ()
unsafeWrite (MutableBlock MutableByteArray# RealWorld
mba) = MutableByteArray# RealWorld -> Offset a -> a -> IO ()
forall a.
PrimType a =>
MutableByteArray# RealWorld -> Offset a -> a -> IO ()
primMbaWrite MutableByteArray# RealWorld
mba
{-# INLINE unsafeWrite #-}