{-# LANGUAGE CPP                        #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE ForeignFunctionInterface   #-}


-- | This module exposes types that builds in type safety into some of
-- the low level pointer operations. The functions here are pretty low
-- level and will be required only by developers of the library that
-- to the core of the library.
module Raaz.Core.Types.Pointer
       ( -- * Pointers, offsets, and alignment
         Pointer
         -- ** Type safe length units.
       , LengthUnit(..)
       , BYTES(..), BITS(..), inBits
       , sizeOf
         -- *** Some length arithmetic
       , bitsQuotRem, bytesQuotRem
       , bitsQuot, bytesQuot
       , atLeast, atLeastAligned, atMost
         -- ** Types measuring alignment
       , Alignment, wordAlignment
       , ALIGN
       , alignment, alignPtr, movePtr, alignedSizeOf, nextAlignedPtr, peekAligned, pokeAligned
         -- ** Allocation functions.
       , allocaAligned, allocaSecureAligned, allocaBuffer, allocaSecure, mallocBuffer
         -- ** Some buffer operations
       , memset, memmove, memcpy
       , hFillBuf
       ) where



import           Control.Applicative
import           Control.Exception     ( bracket_)
import           Control.Monad         ( void, when )
import           Control.Monad.IO.Class
import           Data.Monoid
import           Data.Word
import           Foreign.Marshal.Alloc
import           Foreign.Ptr           ( Ptr         )
import qualified Foreign.Ptr           as FP
import           Foreign.Storable      ( Storable, peek, poke )
import qualified Foreign.Storable      as FS
import           System.IO             (hGetBuf, Handle)

import Prelude -- To stop the annoying warnings of Applicatives and Monoids.

import Raaz.Core.MonoidalAction
import Raaz.Core.Types.Equality
import Raaz.Core.Types.Copying

-- $basics$
--
-- The main concepts introduced here are the following
--
-- [`Pointer`:] The generic pointer type that is used through the
-- library.
--
-- [`LengthUnit`:] This class captures types units of length.
--
-- [`Alignment`:] A dedicated type that is used to keep track of
-- alignment constraints.  offsets in We have the generic pointer type
-- `Pointer` and distinguish between different length units at the
-- type level. This helps in to avoid a lot of length conversion
-- errors.



-- Developers notes: I assumes that word alignment is alignment
-- safe. If this is not the case one needs to fix this to avoid
-- performance degradation or worse incorrect load/store.


-- | A type whose only purpose in this universe is to provide
-- alignment safe pointers.
newtype Align = Align Word deriving Ptr b -> Int -> IO Align
Ptr b -> Int -> Align -> IO ()
Ptr Align -> IO Align
Ptr Align -> Int -> IO Align
Ptr Align -> Int -> Align -> IO ()
Ptr Align -> Align -> IO ()
Align -> Int
(Align -> Int)
-> (Align -> Int)
-> (Ptr Align -> Int -> IO Align)
-> (Ptr Align -> Int -> Align -> IO ())
-> (forall b. Ptr b -> Int -> IO Align)
-> (forall b. Ptr b -> Int -> Align -> IO ())
-> (Ptr Align -> IO Align)
-> (Ptr Align -> Align -> IO ())
-> Storable Align
forall b. Ptr b -> Int -> IO Align
forall b. Ptr b -> Int -> Align -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Align -> Align -> IO ()
$cpoke :: Ptr Align -> Align -> IO ()
peek :: Ptr Align -> IO Align
$cpeek :: Ptr Align -> IO Align
pokeByteOff :: Ptr b -> Int -> Align -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Align -> IO ()
peekByteOff :: Ptr b -> Int -> IO Align
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Align
pokeElemOff :: Ptr Align -> Int -> Align -> IO ()
$cpokeElemOff :: Ptr Align -> Int -> Align -> IO ()
peekElemOff :: Ptr Align -> Int -> IO Align
$cpeekElemOff :: Ptr Align -> Int -> IO Align
alignment :: Align -> Int
$calignment :: Align -> Int
sizeOf :: Align -> Int
$csizeOf :: Align -> Int
Storable

-- | The pointer type used by all cryptographic library.
type Pointer = Ptr Align


-- | In cryptographic settings, we need to measure pointer offsets and
-- buffer sizes. The smallest of length/offset that we have is bytes
-- measured using the type `BYTES`. In various other circumstances, it
-- would be more natural to measure these in multiples of bytes. For
-- example, when allocating buffer to use encrypt using a block cipher
-- it makes sense to measure the buffer size in multiples of block of
-- the cipher. Explicit conversion between these length units, while
-- allocating or moving pointers, involves a lot of low level scaling
-- that is also error prone. To avoid these errors due to unit
-- conversions, we distinguish between different length units at the
-- type level. This type class capturing all such types, i.e. types
-- that stand of length units. Allocation functions and pointer
-- arithmetic are generalised to these length units.
--
-- All instances of a `LengthUnit` are required to be instances of
-- `Monoid` where the monoid operation gives these types the natural
-- size/offset addition semantics: i.e. shifting a pointer by offset
-- @a `mappend` b@ is same as shifting it by @a@ and then by @b@.
class (Enum u, Monoid u) => LengthUnit u where
  -- | Express the length units in bytes.
  inBytes :: u -> BYTES Int

-- | Type safe lengths/offsets in units of bytes.
newtype BYTES a  = BYTES a
        deriving ( Int -> BYTES a -> ShowS
[BYTES a] -> ShowS
BYTES a -> String
(Int -> BYTES a -> ShowS)
-> (BYTES a -> String) -> ([BYTES a] -> ShowS) -> Show (BYTES a)
forall a. Show a => Int -> BYTES a -> ShowS
forall a. Show a => [BYTES a] -> ShowS
forall a. Show a => BYTES a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BYTES a] -> ShowS
$cshowList :: forall a. Show a => [BYTES a] -> ShowS
show :: BYTES a -> String
$cshow :: forall a. Show a => BYTES a -> String
showsPrec :: Int -> BYTES a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BYTES a -> ShowS
Show, BYTES a -> BYTES a -> Bool
(BYTES a -> BYTES a -> Bool)
-> (BYTES a -> BYTES a -> Bool) -> Eq (BYTES a)
forall a. Eq a => BYTES a -> BYTES a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BYTES a -> BYTES a -> Bool
$c/= :: forall a. Eq a => BYTES a -> BYTES a -> Bool
== :: BYTES a -> BYTES a -> Bool
$c== :: forall a. Eq a => BYTES a -> BYTES a -> Bool
Eq, BYTES a -> BYTES a -> Result
(BYTES a -> BYTES a -> Result) -> Equality (BYTES a)
forall a. Equality a => BYTES a -> BYTES a -> Result
forall a. (a -> a -> Result) -> Equality a
eq :: BYTES a -> BYTES a -> Result
$ceq :: forall a. Equality a => BYTES a -> BYTES a -> Result
Equality, Eq (BYTES a)
Eq (BYTES a)
-> (BYTES a -> BYTES a -> Ordering)
-> (BYTES a -> BYTES a -> Bool)
-> (BYTES a -> BYTES a -> Bool)
-> (BYTES a -> BYTES a -> Bool)
-> (BYTES a -> BYTES a -> Bool)
-> (BYTES a -> BYTES a -> BYTES a)
-> (BYTES a -> BYTES a -> BYTES a)
-> Ord (BYTES a)
BYTES a -> BYTES a -> Bool
BYTES a -> BYTES a -> Ordering
BYTES a -> BYTES a -> BYTES 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. Ord a => Eq (BYTES a)
forall a. Ord a => BYTES a -> BYTES a -> Bool
forall a. Ord a => BYTES a -> BYTES a -> Ordering
forall a. Ord a => BYTES a -> BYTES a -> BYTES a
min :: BYTES a -> BYTES a -> BYTES a
$cmin :: forall a. Ord a => BYTES a -> BYTES a -> BYTES a
max :: BYTES a -> BYTES a -> BYTES a
$cmax :: forall a. Ord a => BYTES a -> BYTES a -> BYTES a
>= :: BYTES a -> BYTES a -> Bool
$c>= :: forall a. Ord a => BYTES a -> BYTES a -> Bool
> :: BYTES a -> BYTES a -> Bool
$c> :: forall a. Ord a => BYTES a -> BYTES a -> Bool
<= :: BYTES a -> BYTES a -> Bool
$c<= :: forall a. Ord a => BYTES a -> BYTES a -> Bool
< :: BYTES a -> BYTES a -> Bool
$c< :: forall a. Ord a => BYTES a -> BYTES a -> Bool
compare :: BYTES a -> BYTES a -> Ordering
$ccompare :: forall a. Ord a => BYTES a -> BYTES a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (BYTES a)
Ord, Int -> BYTES a
BYTES a -> Int
BYTES a -> [BYTES a]
BYTES a -> BYTES a
BYTES a -> BYTES a -> [BYTES a]
BYTES a -> BYTES a -> BYTES a -> [BYTES a]
(BYTES a -> BYTES a)
-> (BYTES a -> BYTES a)
-> (Int -> BYTES a)
-> (BYTES a -> Int)
-> (BYTES a -> [BYTES a])
-> (BYTES a -> BYTES a -> [BYTES a])
-> (BYTES a -> BYTES a -> [BYTES a])
-> (BYTES a -> BYTES a -> BYTES a -> [BYTES a])
-> Enum (BYTES a)
forall a. Enum a => Int -> BYTES a
forall a. Enum a => BYTES a -> Int
forall a. Enum a => BYTES a -> [BYTES a]
forall a. Enum a => BYTES a -> BYTES a
forall a. Enum a => BYTES a -> BYTES a -> [BYTES a]
forall a. Enum a => BYTES a -> BYTES a -> BYTES a -> [BYTES a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BYTES a -> BYTES a -> BYTES a -> [BYTES a]
$cenumFromThenTo :: forall a. Enum a => BYTES a -> BYTES a -> BYTES a -> [BYTES a]
enumFromTo :: BYTES a -> BYTES a -> [BYTES a]
$cenumFromTo :: forall a. Enum a => BYTES a -> BYTES a -> [BYTES a]
enumFromThen :: BYTES a -> BYTES a -> [BYTES a]
$cenumFromThen :: forall a. Enum a => BYTES a -> BYTES a -> [BYTES a]
enumFrom :: BYTES a -> [BYTES a]
$cenumFrom :: forall a. Enum a => BYTES a -> [BYTES a]
fromEnum :: BYTES a -> Int
$cfromEnum :: forall a. Enum a => BYTES a -> Int
toEnum :: Int -> BYTES a
$ctoEnum :: forall a. Enum a => Int -> BYTES a
pred :: BYTES a -> BYTES a
$cpred :: forall a. Enum a => BYTES a -> BYTES a
succ :: BYTES a -> BYTES a
$csucc :: forall a. Enum a => BYTES a -> BYTES a
Enum, Enum (BYTES a)
Real (BYTES a)
Real (BYTES a)
-> Enum (BYTES a)
-> (BYTES a -> BYTES a -> BYTES a)
-> (BYTES a -> BYTES a -> BYTES a)
-> (BYTES a -> BYTES a -> BYTES a)
-> (BYTES a -> BYTES a -> BYTES a)
-> (BYTES a -> BYTES a -> (BYTES a, BYTES a))
-> (BYTES a -> BYTES a -> (BYTES a, BYTES a))
-> (BYTES a -> Integer)
-> Integral (BYTES a)
BYTES a -> Integer
BYTES a -> BYTES a -> (BYTES a, BYTES a)
BYTES a -> BYTES a -> BYTES a
forall a. Integral a => Enum (BYTES a)
forall a. Integral a => Real (BYTES a)
forall a. Integral a => BYTES a -> Integer
forall a. Integral a => BYTES a -> BYTES a -> (BYTES a, BYTES a)
forall a. Integral a => BYTES a -> BYTES a -> BYTES a
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: BYTES a -> Integer
$ctoInteger :: forall a. Integral a => BYTES a -> Integer
divMod :: BYTES a -> BYTES a -> (BYTES a, BYTES a)
$cdivMod :: forall a. Integral a => BYTES a -> BYTES a -> (BYTES a, BYTES a)
quotRem :: BYTES a -> BYTES a -> (BYTES a, BYTES a)
$cquotRem :: forall a. Integral a => BYTES a -> BYTES a -> (BYTES a, BYTES a)
mod :: BYTES a -> BYTES a -> BYTES a
$cmod :: forall a. Integral a => BYTES a -> BYTES a -> BYTES a
div :: BYTES a -> BYTES a -> BYTES a
$cdiv :: forall a. Integral a => BYTES a -> BYTES a -> BYTES a
rem :: BYTES a -> BYTES a -> BYTES a
$crem :: forall a. Integral a => BYTES a -> BYTES a -> BYTES a
quot :: BYTES a -> BYTES a -> BYTES a
$cquot :: forall a. Integral a => BYTES a -> BYTES a -> BYTES a
$cp2Integral :: forall a. Integral a => Enum (BYTES a)
$cp1Integral :: forall a. Integral a => Real (BYTES a)
Integral
                 , Num (BYTES a)
Ord (BYTES a)
Num (BYTES a)
-> Ord (BYTES a) -> (BYTES a -> Rational) -> Real (BYTES a)
BYTES a -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall a. Real a => Num (BYTES a)
forall a. Real a => Ord (BYTES a)
forall a. Real a => BYTES a -> Rational
toRational :: BYTES a -> Rational
$ctoRational :: forall a. Real a => BYTES a -> Rational
$cp2Real :: forall a. Real a => Ord (BYTES a)
$cp1Real :: forall a. Real a => Num (BYTES a)
Real, Integer -> BYTES a
BYTES a -> BYTES a
BYTES a -> BYTES a -> BYTES a
(BYTES a -> BYTES a -> BYTES a)
-> (BYTES a -> BYTES a -> BYTES a)
-> (BYTES a -> BYTES a -> BYTES a)
-> (BYTES a -> BYTES a)
-> (BYTES a -> BYTES a)
-> (BYTES a -> BYTES a)
-> (Integer -> BYTES a)
-> Num (BYTES a)
forall a. Num a => Integer -> BYTES a
forall a. Num a => BYTES a -> BYTES a
forall a. Num a => BYTES a -> BYTES a -> BYTES a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> BYTES a
$cfromInteger :: forall a. Num a => Integer -> BYTES a
signum :: BYTES a -> BYTES a
$csignum :: forall a. Num a => BYTES a -> BYTES a
abs :: BYTES a -> BYTES a
$cabs :: forall a. Num a => BYTES a -> BYTES a
negate :: BYTES a -> BYTES a
$cnegate :: forall a. Num a => BYTES a -> BYTES a
* :: BYTES a -> BYTES a -> BYTES a
$c* :: forall a. Num a => BYTES a -> BYTES a -> BYTES a
- :: BYTES a -> BYTES a -> BYTES a
$c- :: forall a. Num a => BYTES a -> BYTES a -> BYTES a
+ :: BYTES a -> BYTES a -> BYTES a
$c+ :: forall a. Num a => BYTES a -> BYTES a -> BYTES a
Num, Ptr b -> Int -> IO (BYTES a)
Ptr b -> Int -> BYTES a -> IO ()
Ptr (BYTES a) -> IO (BYTES a)
Ptr (BYTES a) -> Int -> IO (BYTES a)
Ptr (BYTES a) -> Int -> BYTES a -> IO ()
Ptr (BYTES a) -> BYTES a -> IO ()
BYTES a -> Int
(BYTES a -> Int)
-> (BYTES a -> Int)
-> (Ptr (BYTES a) -> Int -> IO (BYTES a))
-> (Ptr (BYTES a) -> Int -> BYTES a -> IO ())
-> (forall b. Ptr b -> Int -> IO (BYTES a))
-> (forall b. Ptr b -> Int -> BYTES a -> IO ())
-> (Ptr (BYTES a) -> IO (BYTES a))
-> (Ptr (BYTES a) -> BYTES a -> IO ())
-> Storable (BYTES a)
forall b. Ptr b -> Int -> IO (BYTES a)
forall b. Ptr b -> Int -> BYTES a -> IO ()
forall a. Storable a => Ptr (BYTES a) -> IO (BYTES a)
forall a. Storable a => Ptr (BYTES a) -> Int -> IO (BYTES a)
forall a. Storable a => Ptr (BYTES a) -> Int -> BYTES a -> IO ()
forall a. Storable a => Ptr (BYTES a) -> BYTES a -> IO ()
forall a. Storable a => BYTES a -> Int
forall a b. Storable a => Ptr b -> Int -> IO (BYTES a)
forall a b. Storable a => Ptr b -> Int -> BYTES a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (BYTES a) -> BYTES a -> IO ()
$cpoke :: forall a. Storable a => Ptr (BYTES a) -> BYTES a -> IO ()
peek :: Ptr (BYTES a) -> IO (BYTES a)
$cpeek :: forall a. Storable a => Ptr (BYTES a) -> IO (BYTES a)
pokeByteOff :: Ptr b -> Int -> BYTES a -> IO ()
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> BYTES a -> IO ()
peekByteOff :: Ptr b -> Int -> IO (BYTES a)
$cpeekByteOff :: forall a b. Storable a => Ptr b -> Int -> IO (BYTES a)
pokeElemOff :: Ptr (BYTES a) -> Int -> BYTES a -> IO ()
$cpokeElemOff :: forall a. Storable a => Ptr (BYTES a) -> Int -> BYTES a -> IO ()
peekElemOff :: Ptr (BYTES a) -> Int -> IO (BYTES a)
$cpeekElemOff :: forall a. Storable a => Ptr (BYTES a) -> Int -> IO (BYTES a)
alignment :: BYTES a -> Int
$calignment :: forall a. Storable a => BYTES a -> Int
sizeOf :: BYTES a -> Int
$csizeOf :: forall a. Storable a => BYTES a -> Int
Storable, BYTES a
BYTES a -> BYTES a -> Bounded (BYTES a)
forall a. a -> a -> Bounded a
forall a. Bounded a => BYTES a
maxBound :: BYTES a
$cmaxBound :: forall a. Bounded a => BYTES a
minBound :: BYTES a
$cminBound :: forall a. Bounded a => BYTES a
Bounded
                 )

-- | Type safe lengths/offsets in units of bits.
newtype BITS  a  = BITS  a
        deriving ( Int -> BITS a -> ShowS
[BITS a] -> ShowS
BITS a -> String
(Int -> BITS a -> ShowS)
-> (BITS a -> String) -> ([BITS a] -> ShowS) -> Show (BITS a)
forall a. Show a => Int -> BITS a -> ShowS
forall a. Show a => [BITS a] -> ShowS
forall a. Show a => BITS a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BITS a] -> ShowS
$cshowList :: forall a. Show a => [BITS a] -> ShowS
show :: BITS a -> String
$cshow :: forall a. Show a => BITS a -> String
showsPrec :: Int -> BITS a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BITS a -> ShowS
Show, BITS a -> BITS a -> Bool
(BITS a -> BITS a -> Bool)
-> (BITS a -> BITS a -> Bool) -> Eq (BITS a)
forall a. Eq a => BITS a -> BITS a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BITS a -> BITS a -> Bool
$c/= :: forall a. Eq a => BITS a -> BITS a -> Bool
== :: BITS a -> BITS a -> Bool
$c== :: forall a. Eq a => BITS a -> BITS a -> Bool
Eq, BITS a -> BITS a -> Result
(BITS a -> BITS a -> Result) -> Equality (BITS a)
forall a. Equality a => BITS a -> BITS a -> Result
forall a. (a -> a -> Result) -> Equality a
eq :: BITS a -> BITS a -> Result
$ceq :: forall a. Equality a => BITS a -> BITS a -> Result
Equality, Eq (BITS a)
Eq (BITS a)
-> (BITS a -> BITS a -> Ordering)
-> (BITS a -> BITS a -> Bool)
-> (BITS a -> BITS a -> Bool)
-> (BITS a -> BITS a -> Bool)
-> (BITS a -> BITS a -> Bool)
-> (BITS a -> BITS a -> BITS a)
-> (BITS a -> BITS a -> BITS a)
-> Ord (BITS a)
BITS a -> BITS a -> Bool
BITS a -> BITS a -> Ordering
BITS a -> BITS a -> BITS 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. Ord a => Eq (BITS a)
forall a. Ord a => BITS a -> BITS a -> Bool
forall a. Ord a => BITS a -> BITS a -> Ordering
forall a. Ord a => BITS a -> BITS a -> BITS a
min :: BITS a -> BITS a -> BITS a
$cmin :: forall a. Ord a => BITS a -> BITS a -> BITS a
max :: BITS a -> BITS a -> BITS a
$cmax :: forall a. Ord a => BITS a -> BITS a -> BITS a
>= :: BITS a -> BITS a -> Bool
$c>= :: forall a. Ord a => BITS a -> BITS a -> Bool
> :: BITS a -> BITS a -> Bool
$c> :: forall a. Ord a => BITS a -> BITS a -> Bool
<= :: BITS a -> BITS a -> Bool
$c<= :: forall a. Ord a => BITS a -> BITS a -> Bool
< :: BITS a -> BITS a -> Bool
$c< :: forall a. Ord a => BITS a -> BITS a -> Bool
compare :: BITS a -> BITS a -> Ordering
$ccompare :: forall a. Ord a => BITS a -> BITS a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (BITS a)
Ord, Int -> BITS a
BITS a -> Int
BITS a -> [BITS a]
BITS a -> BITS a
BITS a -> BITS a -> [BITS a]
BITS a -> BITS a -> BITS a -> [BITS a]
(BITS a -> BITS a)
-> (BITS a -> BITS a)
-> (Int -> BITS a)
-> (BITS a -> Int)
-> (BITS a -> [BITS a])
-> (BITS a -> BITS a -> [BITS a])
-> (BITS a -> BITS a -> [BITS a])
-> (BITS a -> BITS a -> BITS a -> [BITS a])
-> Enum (BITS a)
forall a. Enum a => Int -> BITS a
forall a. Enum a => BITS a -> Int
forall a. Enum a => BITS a -> [BITS a]
forall a. Enum a => BITS a -> BITS a
forall a. Enum a => BITS a -> BITS a -> [BITS a]
forall a. Enum a => BITS a -> BITS a -> BITS a -> [BITS a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BITS a -> BITS a -> BITS a -> [BITS a]
$cenumFromThenTo :: forall a. Enum a => BITS a -> BITS a -> BITS a -> [BITS a]
enumFromTo :: BITS a -> BITS a -> [BITS a]
$cenumFromTo :: forall a. Enum a => BITS a -> BITS a -> [BITS a]
enumFromThen :: BITS a -> BITS a -> [BITS a]
$cenumFromThen :: forall a. Enum a => BITS a -> BITS a -> [BITS a]
enumFrom :: BITS a -> [BITS a]
$cenumFrom :: forall a. Enum a => BITS a -> [BITS a]
fromEnum :: BITS a -> Int
$cfromEnum :: forall a. Enum a => BITS a -> Int
toEnum :: Int -> BITS a
$ctoEnum :: forall a. Enum a => Int -> BITS a
pred :: BITS a -> BITS a
$cpred :: forall a. Enum a => BITS a -> BITS a
succ :: BITS a -> BITS a
$csucc :: forall a. Enum a => BITS a -> BITS a
Enum, Enum (BITS a)
Real (BITS a)
Real (BITS a)
-> Enum (BITS a)
-> (BITS a -> BITS a -> BITS a)
-> (BITS a -> BITS a -> BITS a)
-> (BITS a -> BITS a -> BITS a)
-> (BITS a -> BITS a -> BITS a)
-> (BITS a -> BITS a -> (BITS a, BITS a))
-> (BITS a -> BITS a -> (BITS a, BITS a))
-> (BITS a -> Integer)
-> Integral (BITS a)
BITS a -> Integer
BITS a -> BITS a -> (BITS a, BITS a)
BITS a -> BITS a -> BITS a
forall a. Integral a => Enum (BITS a)
forall a. Integral a => Real (BITS a)
forall a. Integral a => BITS a -> Integer
forall a. Integral a => BITS a -> BITS a -> (BITS a, BITS a)
forall a. Integral a => BITS a -> BITS a -> BITS a
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: BITS a -> Integer
$ctoInteger :: forall a. Integral a => BITS a -> Integer
divMod :: BITS a -> BITS a -> (BITS a, BITS a)
$cdivMod :: forall a. Integral a => BITS a -> BITS a -> (BITS a, BITS a)
quotRem :: BITS a -> BITS a -> (BITS a, BITS a)
$cquotRem :: forall a. Integral a => BITS a -> BITS a -> (BITS a, BITS a)
mod :: BITS a -> BITS a -> BITS a
$cmod :: forall a. Integral a => BITS a -> BITS a -> BITS a
div :: BITS a -> BITS a -> BITS a
$cdiv :: forall a. Integral a => BITS a -> BITS a -> BITS a
rem :: BITS a -> BITS a -> BITS a
$crem :: forall a. Integral a => BITS a -> BITS a -> BITS a
quot :: BITS a -> BITS a -> BITS a
$cquot :: forall a. Integral a => BITS a -> BITS a -> BITS a
$cp2Integral :: forall a. Integral a => Enum (BITS a)
$cp1Integral :: forall a. Integral a => Real (BITS a)
Integral
                 , Num (BITS a)
Ord (BITS a)
Num (BITS a)
-> Ord (BITS a) -> (BITS a -> Rational) -> Real (BITS a)
BITS a -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall a. Real a => Num (BITS a)
forall a. Real a => Ord (BITS a)
forall a. Real a => BITS a -> Rational
toRational :: BITS a -> Rational
$ctoRational :: forall a. Real a => BITS a -> Rational
$cp2Real :: forall a. Real a => Ord (BITS a)
$cp1Real :: forall a. Real a => Num (BITS a)
Real, Integer -> BITS a
BITS a -> BITS a
BITS a -> BITS a -> BITS a
(BITS a -> BITS a -> BITS a)
-> (BITS a -> BITS a -> BITS a)
-> (BITS a -> BITS a -> BITS a)
-> (BITS a -> BITS a)
-> (BITS a -> BITS a)
-> (BITS a -> BITS a)
-> (Integer -> BITS a)
-> Num (BITS a)
forall a. Num a => Integer -> BITS a
forall a. Num a => BITS a -> BITS a
forall a. Num a => BITS a -> BITS a -> BITS a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> BITS a
$cfromInteger :: forall a. Num a => Integer -> BITS a
signum :: BITS a -> BITS a
$csignum :: forall a. Num a => BITS a -> BITS a
abs :: BITS a -> BITS a
$cabs :: forall a. Num a => BITS a -> BITS a
negate :: BITS a -> BITS a
$cnegate :: forall a. Num a => BITS a -> BITS a
* :: BITS a -> BITS a -> BITS a
$c* :: forall a. Num a => BITS a -> BITS a -> BITS a
- :: BITS a -> BITS a -> BITS a
$c- :: forall a. Num a => BITS a -> BITS a -> BITS a
+ :: BITS a -> BITS a -> BITS a
$c+ :: forall a. Num a => BITS a -> BITS a -> BITS a
Num, Ptr b -> Int -> IO (BITS a)
Ptr b -> Int -> BITS a -> IO ()
Ptr (BITS a) -> IO (BITS a)
Ptr (BITS a) -> Int -> IO (BITS a)
Ptr (BITS a) -> Int -> BITS a -> IO ()
Ptr (BITS a) -> BITS a -> IO ()
BITS a -> Int
(BITS a -> Int)
-> (BITS a -> Int)
-> (Ptr (BITS a) -> Int -> IO (BITS a))
-> (Ptr (BITS a) -> Int -> BITS a -> IO ())
-> (forall b. Ptr b -> Int -> IO (BITS a))
-> (forall b. Ptr b -> Int -> BITS a -> IO ())
-> (Ptr (BITS a) -> IO (BITS a))
-> (Ptr (BITS a) -> BITS a -> IO ())
-> Storable (BITS a)
forall b. Ptr b -> Int -> IO (BITS a)
forall b. Ptr b -> Int -> BITS a -> IO ()
forall a. Storable a => Ptr (BITS a) -> IO (BITS a)
forall a. Storable a => Ptr (BITS a) -> Int -> IO (BITS a)
forall a. Storable a => Ptr (BITS a) -> Int -> BITS a -> IO ()
forall a. Storable a => Ptr (BITS a) -> BITS a -> IO ()
forall a. Storable a => BITS a -> Int
forall a b. Storable a => Ptr b -> Int -> IO (BITS a)
forall a b. Storable a => Ptr b -> Int -> BITS a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (BITS a) -> BITS a -> IO ()
$cpoke :: forall a. Storable a => Ptr (BITS a) -> BITS a -> IO ()
peek :: Ptr (BITS a) -> IO (BITS a)
$cpeek :: forall a. Storable a => Ptr (BITS a) -> IO (BITS a)
pokeByteOff :: Ptr b -> Int -> BITS a -> IO ()
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> BITS a -> IO ()
peekByteOff :: Ptr b -> Int -> IO (BITS a)
$cpeekByteOff :: forall a b. Storable a => Ptr b -> Int -> IO (BITS a)
pokeElemOff :: Ptr (BITS a) -> Int -> BITS a -> IO ()
$cpokeElemOff :: forall a. Storable a => Ptr (BITS a) -> Int -> BITS a -> IO ()
peekElemOff :: Ptr (BITS a) -> Int -> IO (BITS a)
$cpeekElemOff :: forall a. Storable a => Ptr (BITS a) -> Int -> IO (BITS a)
alignment :: BITS a -> Int
$calignment :: forall a. Storable a => BITS a -> Int
sizeOf :: BITS a -> Int
$csizeOf :: forall a. Storable a => BITS a -> Int
Storable, BITS a
BITS a -> BITS a -> Bounded (BITS a)
forall a. a -> a -> Bounded a
forall a. Bounded a => BITS a
maxBound :: BITS a
$cmaxBound :: forall a. Bounded a => BITS a
minBound :: BITS a
$cminBound :: forall a. Bounded a => BITS a
Bounded
                 )

-- | Type safe length unit that measures offsets in multiples of word
-- length. This length unit can be used if one wants to make sure that
-- all offsets are word aligned.
newtype ALIGN    = ALIGN { ALIGN -> Int
unALIGN :: Int }
                 deriving ( Int -> ALIGN -> ShowS
[ALIGN] -> ShowS
ALIGN -> String
(Int -> ALIGN -> ShowS)
-> (ALIGN -> String) -> ([ALIGN] -> ShowS) -> Show ALIGN
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ALIGN] -> ShowS
$cshowList :: [ALIGN] -> ShowS
show :: ALIGN -> String
$cshow :: ALIGN -> String
showsPrec :: Int -> ALIGN -> ShowS
$cshowsPrec :: Int -> ALIGN -> ShowS
Show, ALIGN -> ALIGN -> Bool
(ALIGN -> ALIGN -> Bool) -> (ALIGN -> ALIGN -> Bool) -> Eq ALIGN
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ALIGN -> ALIGN -> Bool
$c/= :: ALIGN -> ALIGN -> Bool
== :: ALIGN -> ALIGN -> Bool
$c== :: ALIGN -> ALIGN -> Bool
Eq,Eq ALIGN
Eq ALIGN
-> (ALIGN -> ALIGN -> Ordering)
-> (ALIGN -> ALIGN -> Bool)
-> (ALIGN -> ALIGN -> Bool)
-> (ALIGN -> ALIGN -> Bool)
-> (ALIGN -> ALIGN -> Bool)
-> (ALIGN -> ALIGN -> ALIGN)
-> (ALIGN -> ALIGN -> ALIGN)
-> Ord ALIGN
ALIGN -> ALIGN -> Bool
ALIGN -> ALIGN -> Ordering
ALIGN -> ALIGN -> ALIGN
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
min :: ALIGN -> ALIGN -> ALIGN
$cmin :: ALIGN -> ALIGN -> ALIGN
max :: ALIGN -> ALIGN -> ALIGN
$cmax :: ALIGN -> ALIGN -> ALIGN
>= :: ALIGN -> ALIGN -> Bool
$c>= :: ALIGN -> ALIGN -> Bool
> :: ALIGN -> ALIGN -> Bool
$c> :: ALIGN -> ALIGN -> Bool
<= :: ALIGN -> ALIGN -> Bool
$c<= :: ALIGN -> ALIGN -> Bool
< :: ALIGN -> ALIGN -> Bool
$c< :: ALIGN -> ALIGN -> Bool
compare :: ALIGN -> ALIGN -> Ordering
$ccompare :: ALIGN -> ALIGN -> Ordering
$cp1Ord :: Eq ALIGN
Ord, Int -> ALIGN
ALIGN -> Int
ALIGN -> [ALIGN]
ALIGN -> ALIGN
ALIGN -> ALIGN -> [ALIGN]
ALIGN -> ALIGN -> ALIGN -> [ALIGN]
(ALIGN -> ALIGN)
-> (ALIGN -> ALIGN)
-> (Int -> ALIGN)
-> (ALIGN -> Int)
-> (ALIGN -> [ALIGN])
-> (ALIGN -> ALIGN -> [ALIGN])
-> (ALIGN -> ALIGN -> [ALIGN])
-> (ALIGN -> ALIGN -> ALIGN -> [ALIGN])
-> Enum ALIGN
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ALIGN -> ALIGN -> ALIGN -> [ALIGN]
$cenumFromThenTo :: ALIGN -> ALIGN -> ALIGN -> [ALIGN]
enumFromTo :: ALIGN -> ALIGN -> [ALIGN]
$cenumFromTo :: ALIGN -> ALIGN -> [ALIGN]
enumFromThen :: ALIGN -> ALIGN -> [ALIGN]
$cenumFromThen :: ALIGN -> ALIGN -> [ALIGN]
enumFrom :: ALIGN -> [ALIGN]
$cenumFrom :: ALIGN -> [ALIGN]
fromEnum :: ALIGN -> Int
$cfromEnum :: ALIGN -> Int
toEnum :: Int -> ALIGN
$ctoEnum :: Int -> ALIGN
pred :: ALIGN -> ALIGN
$cpred :: ALIGN -> ALIGN
succ :: ALIGN -> ALIGN
$csucc :: ALIGN -> ALIGN
Enum, Enum ALIGN
Real ALIGN
Real ALIGN
-> Enum ALIGN
-> (ALIGN -> ALIGN -> ALIGN)
-> (ALIGN -> ALIGN -> ALIGN)
-> (ALIGN -> ALIGN -> ALIGN)
-> (ALIGN -> ALIGN -> ALIGN)
-> (ALIGN -> ALIGN -> (ALIGN, ALIGN))
-> (ALIGN -> ALIGN -> (ALIGN, ALIGN))
-> (ALIGN -> Integer)
-> Integral ALIGN
ALIGN -> Integer
ALIGN -> ALIGN -> (ALIGN, ALIGN)
ALIGN -> ALIGN -> ALIGN
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: ALIGN -> Integer
$ctoInteger :: ALIGN -> Integer
divMod :: ALIGN -> ALIGN -> (ALIGN, ALIGN)
$cdivMod :: ALIGN -> ALIGN -> (ALIGN, ALIGN)
quotRem :: ALIGN -> ALIGN -> (ALIGN, ALIGN)
$cquotRem :: ALIGN -> ALIGN -> (ALIGN, ALIGN)
mod :: ALIGN -> ALIGN -> ALIGN
$cmod :: ALIGN -> ALIGN -> ALIGN
div :: ALIGN -> ALIGN -> ALIGN
$cdiv :: ALIGN -> ALIGN -> ALIGN
rem :: ALIGN -> ALIGN -> ALIGN
$crem :: ALIGN -> ALIGN -> ALIGN
quot :: ALIGN -> ALIGN -> ALIGN
$cquot :: ALIGN -> ALIGN -> ALIGN
$cp2Integral :: Enum ALIGN
$cp1Integral :: Real ALIGN
Integral
                          , Num ALIGN
Ord ALIGN
Num ALIGN -> Ord ALIGN -> (ALIGN -> Rational) -> Real ALIGN
ALIGN -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: ALIGN -> Rational
$ctoRational :: ALIGN -> Rational
$cp2Real :: Ord ALIGN
$cp1Real :: Num ALIGN
Real, Integer -> ALIGN
ALIGN -> ALIGN
ALIGN -> ALIGN -> ALIGN
(ALIGN -> ALIGN -> ALIGN)
-> (ALIGN -> ALIGN -> ALIGN)
-> (ALIGN -> ALIGN -> ALIGN)
-> (ALIGN -> ALIGN)
-> (ALIGN -> ALIGN)
-> (ALIGN -> ALIGN)
-> (Integer -> ALIGN)
-> Num ALIGN
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ALIGN
$cfromInteger :: Integer -> ALIGN
signum :: ALIGN -> ALIGN
$csignum :: ALIGN -> ALIGN
abs :: ALIGN -> ALIGN
$cabs :: ALIGN -> ALIGN
negate :: ALIGN -> ALIGN
$cnegate :: ALIGN -> ALIGN
* :: ALIGN -> ALIGN -> ALIGN
$c* :: ALIGN -> ALIGN -> ALIGN
- :: ALIGN -> ALIGN -> ALIGN
$c- :: ALIGN -> ALIGN -> ALIGN
+ :: ALIGN -> ALIGN -> ALIGN
$c+ :: ALIGN -> ALIGN -> ALIGN
Num, Ptr b -> Int -> IO ALIGN
Ptr b -> Int -> ALIGN -> IO ()
Ptr ALIGN -> IO ALIGN
Ptr ALIGN -> Int -> IO ALIGN
Ptr ALIGN -> Int -> ALIGN -> IO ()
Ptr ALIGN -> ALIGN -> IO ()
ALIGN -> Int
(ALIGN -> Int)
-> (ALIGN -> Int)
-> (Ptr ALIGN -> Int -> IO ALIGN)
-> (Ptr ALIGN -> Int -> ALIGN -> IO ())
-> (forall b. Ptr b -> Int -> IO ALIGN)
-> (forall b. Ptr b -> Int -> ALIGN -> IO ())
-> (Ptr ALIGN -> IO ALIGN)
-> (Ptr ALIGN -> ALIGN -> IO ())
-> Storable ALIGN
forall b. Ptr b -> Int -> IO ALIGN
forall b. Ptr b -> Int -> ALIGN -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr ALIGN -> ALIGN -> IO ()
$cpoke :: Ptr ALIGN -> ALIGN -> IO ()
peek :: Ptr ALIGN -> IO ALIGN
$cpeek :: Ptr ALIGN -> IO ALIGN
pokeByteOff :: Ptr b -> Int -> ALIGN -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ALIGN -> IO ()
peekByteOff :: Ptr b -> Int -> IO ALIGN
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ALIGN
pokeElemOff :: Ptr ALIGN -> Int -> ALIGN -> IO ()
$cpokeElemOff :: Ptr ALIGN -> Int -> ALIGN -> IO ()
peekElemOff :: Ptr ALIGN -> Int -> IO ALIGN
$cpeekElemOff :: Ptr ALIGN -> Int -> IO ALIGN
alignment :: ALIGN -> Int
$calignment :: ALIGN -> Int
sizeOf :: ALIGN -> Int
$csizeOf :: ALIGN -> Int
Storable
                          )
#if MIN_VERSION_base(4,11,0)

instance Num a => Semigroup (BYTES a) where
  <> :: BYTES a -> BYTES a -> BYTES a
(<>) = BYTES a -> BYTES a -> BYTES a
forall a. Num a => a -> a -> a
(+)

#endif

instance Num a => Monoid (BYTES a) where
  mempty :: BYTES a
mempty  = BYTES a
0
  mappend :: BYTES a -> BYTES a -> BYTES a
mappend = BYTES a -> BYTES a -> BYTES a
forall a. Num a => a -> a -> a
(+)

#if MIN_VERSION_base(4,11,0)

instance Semigroup ALIGN where
  <> :: ALIGN -> ALIGN -> ALIGN
(<>) ALIGN
x ALIGN
y = Int -> ALIGN
ALIGN (Int -> ALIGN) -> Int -> ALIGN
forall a b. (a -> b) -> a -> b
$ ALIGN -> Int
unALIGN ALIGN
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ALIGN -> Int
unALIGN ALIGN
y

#endif

instance Monoid ALIGN where
  mempty :: ALIGN
mempty  = Int -> ALIGN
ALIGN Int
0
  mappend :: ALIGN -> ALIGN -> ALIGN
mappend ALIGN
x ALIGN
y = Int -> ALIGN
ALIGN (Int -> ALIGN) -> Int -> ALIGN
forall a b. (a -> b) -> a -> b
$ ALIGN -> Int
unALIGN ALIGN
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ALIGN -> Int
unALIGN ALIGN
y

instance LengthUnit ALIGN where
  inBytes :: ALIGN -> BYTES Int
inBytes (ALIGN Int
x) = Int -> BYTES Int
forall a. a -> BYTES a
BYTES (Int -> BYTES Int) -> Int -> BYTES Int
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Align -> Int
forall a. Storable a => a -> Int
FS.alignment (Align
forall a. HasCallStack => a
undefined :: Align)
  {-# INLINE inBytes #-}

instance LengthUnit (BYTES Int) where
  inBytes :: BYTES Int -> BYTES Int
inBytes = BYTES Int -> BYTES Int
forall a. a -> a
id
  {-# INLINE inBytes #-}

-- | Express the length units in bits.
inBits  :: LengthUnit u => u -> BITS Word64
inBits :: u -> BITS Word64
inBits u
u = Word64 -> BITS Word64
forall a. a -> BITS a
BITS (Word64 -> BITS Word64) -> Word64 -> BITS Word64
forall a b. (a -> b) -> a -> b
$ Word64
8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
by
  where BYTES Int
by = u -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes u
u

-- | Express length unit @src@ in terms of length unit @dest@ rounding
-- upwards.
atLeast :: ( LengthUnit src
           , LengthUnit dest
           )
        => src
        -> dest
atLeast :: src -> dest
atLeast src
src | BYTES Int
r BYTES Int -> BYTES Int -> Bool
forall a. Eq a => a -> a -> Bool
== BYTES Int
0    = dest
u
            | Bool
otherwise = dest -> dest
forall a. Enum a => a -> a
succ dest
u
    where (dest
u , BYTES Int
r) = BYTES Int -> (dest, BYTES Int)
forall u. LengthUnit u => BYTES Int -> (u, BYTES Int)
bytesQuotRem (BYTES Int -> (dest, BYTES Int)) -> BYTES Int -> (dest, BYTES Int)
forall a b. (a -> b) -> a -> b
$ src -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes src
src


-- | Often we want to allocate a buffer of size @l@. We also want to
-- make sure that the buffer starts at an alignment boundary
-- @a@. However, the standard word allocation functions might return a
-- pointer that is not aligned as desired. The @atLeastAligned l a@
-- returns a length @n@ such the length @n@ is big enough to ensure
-- that there is at least @l@ length of valid buffer starting at the
-- next pointer aligned at boundary @a@. If the alignment required in
-- @a@ then allocating @l + a - 1 should do the trick.
atLeastAligned :: LengthUnit l => l -> Alignment -> ALIGN
atLeastAligned :: l -> Alignment -> ALIGN
atLeastAligned l
l Alignment
a = ALIGN
n ALIGN -> ALIGN -> ALIGN
forall a. Num a => a -> a -> a
+ ALIGN
pad ALIGN -> ALIGN -> ALIGN
forall a. Num a => a -> a -> a
- ALIGN
1
  where n :: ALIGN
n = l -> ALIGN
forall src dest. (LengthUnit src, LengthUnit dest) => src -> dest
atLeast l
l
        -- Alignment adjusted to word boundary.
        algn :: Alignment
algn = Alignment
wordAlignment   Alignment -> Alignment -> Alignment
forall a. Semigroup a => a -> a -> a
<> Alignment
a
        pad :: ALIGN
pad  = BYTES Int -> ALIGN
forall src dest. (LengthUnit src, LengthUnit dest) => src -> dest
atLeast (BYTES Int -> ALIGN) -> BYTES Int -> ALIGN
forall a b. (a -> b) -> a -> b
$ Int -> BYTES Int
forall a. a -> BYTES a
BYTES  (Int -> BYTES Int) -> Int -> BYTES Int
forall a b. (a -> b) -> a -> b
$ Alignment -> Int
unAlignment Alignment
algn


-- | Express length unit @src@ in terms of length unit @dest@ rounding
-- downwards.
atMost :: ( LengthUnit src
          , LengthUnit dest
          )
       => src
       -> dest
atMost :: src -> dest
atMost = (dest, BYTES Int) -> dest
forall a b. (a, b) -> a
fst ((dest, BYTES Int) -> dest)
-> (src -> (dest, BYTES Int)) -> src -> dest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BYTES Int -> (dest, BYTES Int)
forall u. LengthUnit u => BYTES Int -> (u, BYTES Int)
bytesQuotRem (BYTES Int -> (dest, BYTES Int))
-> (src -> BYTES Int) -> src -> (dest, BYTES Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. src -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes

-- | A length unit @u@ is usually a multiple of bytes. The function
-- `bytesQuotRem` is like `quotRem`: the value @byteQuotRem bytes@ is
-- a tuple @(x,r)@, where @x@ is @bytes@ expressed in the unit @u@
-- with @r@ being the reminder.
bytesQuotRem :: LengthUnit u
             => BYTES Int
             -> (u , BYTES Int)
bytesQuotRem :: BYTES Int -> (u, BYTES Int)
bytesQuotRem BYTES Int
bytes = (u
u , BYTES Int
r)
  where divisor :: BYTES Int
divisor       = u -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes (Int -> u
forall a. Enum a => Int -> a
toEnum Int
1 u -> u -> u
forall a. a -> a -> a
`asTypeOf` u
u)
        (BYTES Int
q, BYTES Int
r)  = BYTES Int
bytes BYTES Int -> BYTES Int -> (BYTES Int, BYTES Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` BYTES Int
divisor
        u :: u
u             = Int -> u
forall a. Enum a => Int -> a
toEnum Int
q

-- | Function similar to `bytesQuotRem` but returns only the quotient.
bytesQuot :: LengthUnit u
          => BYTES Int
          -> u
bytesQuot :: BYTES Int -> u
bytesQuot BYTES Int
bytes = u
u
  where divisor :: BYTES Int
divisor = u -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes (Int -> u
forall a. Enum a => Int -> a
toEnum Int
1 u -> u -> u
forall a. a -> a -> a
`asTypeOf` u
u)
        q :: BYTES Int
q       = BYTES Int
bytes BYTES Int -> BYTES Int -> BYTES Int
forall a. Integral a => a -> a -> a
`quot` BYTES Int
divisor
        u :: u
u       = Int -> u
forall a. Enum a => Int -> a
toEnum (Int -> u) -> Int -> u
forall a b. (a -> b) -> a -> b
$ BYTES Int -> Int
forall a. Enum a => a -> Int
fromEnum BYTES Int
q


-- | Function similar to `bytesQuotRem` but works with bits instead.
bitsQuotRem :: LengthUnit u
            => BITS Word64
            -> (u , BITS Word64)
bitsQuotRem :: BITS Word64 -> (u, BITS Word64)
bitsQuotRem BITS Word64
bits = (u
u , BITS Word64
r)
  where divisor :: BITS Word64
divisor = u -> BITS Word64
forall u. LengthUnit u => u -> BITS Word64
inBits (Int -> u
forall a. Enum a => Int -> a
toEnum Int
1 u -> u -> u
forall a. a -> a -> a
`asTypeOf` u
u)
        (BITS Word64
q, BITS Word64
r)  = BITS Word64
bits BITS Word64 -> BITS Word64 -> (BITS Word64, BITS Word64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` BITS Word64
divisor
        u :: u
u       = Int -> u
forall a. Enum a => Int -> a
toEnum (Int -> u) -> Int -> u
forall a b. (a -> b) -> a -> b
$ BITS Word64 -> Int
forall a. Enum a => a -> Int
fromEnum BITS Word64
q

-- | Function similar to `bitsQuotRem` but returns only the quotient.
bitsQuot :: LengthUnit u
         => BITS Word64
         -> u
bitsQuot :: BITS Word64 -> u
bitsQuot BITS Word64
bits = u
u
  where divisor :: BITS Word64
divisor = u -> BITS Word64
forall u. LengthUnit u => u -> BITS Word64
inBits (Int -> u
forall a. Enum a => Int -> a
toEnum Int
1 u -> u -> u
forall a. a -> a -> a
`asTypeOf` u
u)
        q :: BITS Word64
q       = BITS Word64
bits BITS Word64 -> BITS Word64 -> BITS Word64
forall a. Integral a => a -> a -> a
`quot` BITS Word64
divisor
        u :: u
u       = Int -> u
forall a. Enum a => Int -> a
toEnum (Int -> u) -> Int -> u
forall a b. (a -> b) -> a -> b
$ BITS Word64 -> Int
forall a. Enum a => a -> Int
fromEnum BITS Word64
q

-- | The most interesting monoidal action for us.
instance LengthUnit u => LAction u Pointer where
  u
a <.> :: u -> Ptr Align -> Ptr Align
<.> Ptr Align
ptr  = Ptr Align -> u -> Ptr Align
forall l a. LengthUnit l => Ptr a -> l -> Ptr a
movePtr Ptr Align
ptr u
a
  {-# INLINE (<.>) #-}

------------------------ Alignment --------------------------------

-- | Types to measure alignment in units of bytes.
newtype Alignment = Alignment { Alignment -> Int
unAlignment :: Int }
        deriving ( Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
(Int -> Alignment -> ShowS)
-> (Alignment -> String)
-> ([Alignment] -> ShowS)
-> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alignment] -> ShowS
$cshowList :: [Alignment] -> ShowS
show :: Alignment -> String
$cshow :: Alignment -> String
showsPrec :: Int -> Alignment -> ShowS
$cshowsPrec :: Int -> Alignment -> ShowS
Show, Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c== :: Alignment -> Alignment -> Bool
Eq, Eq Alignment
Eq Alignment
-> (Alignment -> Alignment -> Ordering)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> Ord Alignment
Alignment -> Alignment -> Bool
Alignment -> Alignment -> Ordering
Alignment -> Alignment -> Alignment
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
min :: Alignment -> Alignment -> Alignment
$cmin :: Alignment -> Alignment -> Alignment
max :: Alignment -> Alignment -> Alignment
$cmax :: Alignment -> Alignment -> Alignment
>= :: Alignment -> Alignment -> Bool
$c>= :: Alignment -> Alignment -> Bool
> :: Alignment -> Alignment -> Bool
$c> :: Alignment -> Alignment -> Bool
<= :: Alignment -> Alignment -> Bool
$c<= :: Alignment -> Alignment -> Bool
< :: Alignment -> Alignment -> Bool
$c< :: Alignment -> Alignment -> Bool
compare :: Alignment -> Alignment -> Ordering
$ccompare :: Alignment -> Alignment -> Ordering
$cp1Ord :: Eq Alignment
Ord, Int -> Alignment
Alignment -> Int
Alignment -> [Alignment]
Alignment -> Alignment
Alignment -> Alignment -> [Alignment]
Alignment -> Alignment -> Alignment -> [Alignment]
(Alignment -> Alignment)
-> (Alignment -> Alignment)
-> (Int -> Alignment)
-> (Alignment -> Int)
-> (Alignment -> [Alignment])
-> (Alignment -> Alignment -> [Alignment])
-> (Alignment -> Alignment -> [Alignment])
-> (Alignment -> Alignment -> Alignment -> [Alignment])
-> Enum Alignment
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Alignment -> Alignment -> Alignment -> [Alignment]
$cenumFromThenTo :: Alignment -> Alignment -> Alignment -> [Alignment]
enumFromTo :: Alignment -> Alignment -> [Alignment]
$cenumFromTo :: Alignment -> Alignment -> [Alignment]
enumFromThen :: Alignment -> Alignment -> [Alignment]
$cenumFromThen :: Alignment -> Alignment -> [Alignment]
enumFrom :: Alignment -> [Alignment]
$cenumFrom :: Alignment -> [Alignment]
fromEnum :: Alignment -> Int
$cfromEnum :: Alignment -> Int
toEnum :: Int -> Alignment
$ctoEnum :: Int -> Alignment
pred :: Alignment -> Alignment
$cpred :: Alignment -> Alignment
succ :: Alignment -> Alignment
$csucc :: Alignment -> Alignment
Enum, Enum Alignment
Real Alignment
Real Alignment
-> Enum Alignment
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> (Alignment, Alignment))
-> (Alignment -> Alignment -> (Alignment, Alignment))
-> (Alignment -> Integer)
-> Integral Alignment
Alignment -> Integer
Alignment -> Alignment -> (Alignment, Alignment)
Alignment -> Alignment -> Alignment
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Alignment -> Integer
$ctoInteger :: Alignment -> Integer
divMod :: Alignment -> Alignment -> (Alignment, Alignment)
$cdivMod :: Alignment -> Alignment -> (Alignment, Alignment)
quotRem :: Alignment -> Alignment -> (Alignment, Alignment)
$cquotRem :: Alignment -> Alignment -> (Alignment, Alignment)
mod :: Alignment -> Alignment -> Alignment
$cmod :: Alignment -> Alignment -> Alignment
div :: Alignment -> Alignment -> Alignment
$cdiv :: Alignment -> Alignment -> Alignment
rem :: Alignment -> Alignment -> Alignment
$crem :: Alignment -> Alignment -> Alignment
quot :: Alignment -> Alignment -> Alignment
$cquot :: Alignment -> Alignment -> Alignment
$cp2Integral :: Enum Alignment
$cp1Integral :: Real Alignment
Integral
                 , Num Alignment
Ord Alignment
Num Alignment
-> Ord Alignment -> (Alignment -> Rational) -> Real Alignment
Alignment -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Alignment -> Rational
$ctoRational :: Alignment -> Rational
$cp2Real :: Ord Alignment
$cp1Real :: Num Alignment
Real, Integer -> Alignment
Alignment -> Alignment
Alignment -> Alignment -> Alignment
(Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment)
-> (Alignment -> Alignment)
-> (Alignment -> Alignment)
-> (Integer -> Alignment)
-> Num Alignment
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Alignment
$cfromInteger :: Integer -> Alignment
signum :: Alignment -> Alignment
$csignum :: Alignment -> Alignment
abs :: Alignment -> Alignment
$cabs :: Alignment -> Alignment
negate :: Alignment -> Alignment
$cnegate :: Alignment -> Alignment
* :: Alignment -> Alignment -> Alignment
$c* :: Alignment -> Alignment -> Alignment
- :: Alignment -> Alignment -> Alignment
$c- :: Alignment -> Alignment -> Alignment
+ :: Alignment -> Alignment -> Alignment
$c+ :: Alignment -> Alignment -> Alignment
Num
                 )

-- | The default alignment to use is word boundary.
wordAlignment :: Alignment
wordAlignment :: Alignment
wordAlignment = Align -> Alignment
forall a. Storable a => a -> Alignment
alignment (Align
forall a. HasCallStack => a
undefined :: Align)

#if MIN_VERSION_base(4,11,0)

instance Semigroup Alignment where
  <> :: Alignment -> Alignment -> Alignment
(<>) = Alignment -> Alignment -> Alignment
forall a. Integral a => a -> a -> a
lcm
#endif

instance Monoid Alignment where
  mempty :: Alignment
mempty  = Int -> Alignment
Alignment Int
1
  mappend :: Alignment -> Alignment -> Alignment
mappend = Alignment -> Alignment -> Alignment
forall a. Integral a => a -> a -> a
lcm


---------- Type safe versions of some pointer functions -----------------

-- | Compute the size of a storable element.
sizeOf :: Storable a => a -> BYTES Int
sizeOf :: a -> BYTES Int
sizeOf = Int -> BYTES Int
forall a. a -> BYTES a
BYTES (Int -> BYTES Int) -> (a -> Int) -> a -> BYTES Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Storable a => a -> Int
FS.sizeOf

-- | Size of the buffer to be allocated to store an element of type
-- @a@ so as to guarantee that there exist enough space to store the
-- element after aligning the pointer. If the size of the element is
-- @s@ and its alignment is @a@ then this quantity is essentially
-- equal to @s + a - 1@. All units measured in word alignment.
alignedSizeOf  :: Storable a => a -> ALIGN
alignedSizeOf :: a -> ALIGN
alignedSizeOf a
a =  BYTES Int -> Alignment -> ALIGN
forall l. LengthUnit l => l -> Alignment -> ALIGN
atLeastAligned (a -> BYTES Int
forall a. Storable a => a -> BYTES Int
sizeOf a
a) (Alignment -> ALIGN) -> Alignment -> ALIGN
forall a b. (a -> b) -> a -> b
$ a -> Alignment
forall a. Storable a => a -> Alignment
alignment a
a

-- | Compute the alignment for a storable object.
alignment :: Storable a => a -> Alignment
alignment :: a -> Alignment
alignment =  Int -> Alignment
Alignment (Int -> Alignment) -> (a -> Int) -> a -> Alignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Storable a => a -> Int
FS.alignment

-- | Align a pointer to the appropriate alignment.
alignPtr :: Ptr a -> Alignment -> Ptr a
alignPtr :: Ptr a -> Alignment -> Ptr a
alignPtr Ptr a
ptr = Ptr a -> Int -> Ptr a
forall a. Ptr a -> Int -> Ptr a
FP.alignPtr Ptr a
ptr (Int -> Ptr a) -> (Alignment -> Int) -> Alignment -> Ptr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int
unAlignment

-- | Move the given pointer with a specific offset.
movePtr :: LengthUnit l => Ptr a -> l -> Ptr a
movePtr :: Ptr a -> l -> Ptr a
movePtr Ptr a
ptr l
l = Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
FP.plusPtr Ptr a
ptr Int
offset
  where BYTES Int
offset = l -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes l
l

-- | Compute the next aligned pointer starting from the given pointer
-- location.
nextAlignedPtr :: Storable a => Ptr a -> Ptr a
nextAlignedPtr :: Ptr a -> Ptr a
nextAlignedPtr Ptr a
ptr = Ptr a -> Alignment -> Ptr a
forall a. Ptr a -> Alignment -> Ptr a
alignPtr Ptr a
ptr (Alignment -> Ptr a) -> Alignment -> Ptr a
forall a b. (a -> b) -> a -> b
$ a -> Alignment
forall a. Storable a => a -> Alignment
alignment (a -> Alignment) -> a -> Alignment
forall a b. (a -> b) -> a -> b
$ Ptr a -> a
forall b. Ptr b -> b
elementOfPtr Ptr a
ptr
  where elementOfPtr :: Ptr b -> b
        elementOfPtr :: Ptr b -> b
elementOfPtr Ptr b
_ = b
forall a. HasCallStack => a
undefined

-- | Peek the element from the next aligned location.
peekAligned :: Storable a => Ptr a -> IO a
peekAligned :: Ptr a -> IO a
peekAligned = Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr a -> IO a) -> (Ptr a -> Ptr a) -> Ptr a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> Ptr a
forall a. Storable a => Ptr a -> Ptr a
nextAlignedPtr

-- | Poke the element from the next aligned location.
pokeAligned     :: Storable a => Ptr a -> a -> IO ()
pokeAligned :: Ptr a -> a -> IO ()
pokeAligned Ptr a
ptr =  Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr a -> a -> IO ()) -> Ptr a -> a -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr a -> Ptr a
forall a. Storable a => Ptr a -> Ptr a
nextAlignedPtr Ptr a
ptr

-------------------------- Allocation  ---------------------------

-- | A less general version of `allocaAligned` where the pointer passed
-- is aligned to word boundary.
allocaBuffer :: LengthUnit l
             => l                  -- ^ buffer length
             -> (Pointer -> IO b)  -- ^ the action to run
             -> IO b
{-# INLINE allocaBuffer #-}
allocaBuffer :: l -> (Ptr Align -> IO b) -> IO b
allocaBuffer = Alignment -> l -> (Ptr Align -> IO b) -> IO b
forall l b.
LengthUnit l =>
Alignment -> l -> (Ptr Align -> IO b) -> IO b
allocaAligned Alignment
wordAlignment


-- | The expression @allocaAligned a l action@ allocates a local
-- buffer of length @l@ and alignment @a@ and passes it on to the IO
-- action @action@. No explicit freeing of the memory is required as
-- the memory is allocated locally and freed once the action
-- finishes. It is better to use this function than
-- @`allocaBytesAligned`@ as it does type safe scaling and alignment.
allocaAligned :: LengthUnit l
              => Alignment          -- ^ the alignment of the buffer
              -> l                  -- ^ size of the buffer
              -> (Pointer -> IO b)  -- ^ the action to run
              -> IO b
allocaAligned :: Alignment -> l -> (Ptr Align -> IO b) -> IO b
allocaAligned Alignment
algn l
l = Int -> Int -> (Ptr Align -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned Int
b Int
a
  where BYTES     Int
b = l -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes l
l
        Alignment Int
a = Alignment
algn

----------------- Secure allocation ---------------------------------

-- | A less general version of `allocaSecureAligned` where the pointer passed
-- is aligned to word boundary
allocaSecure :: LengthUnit l
             => l
             -> (Pointer -> IO b)
             -> IO b
allocaSecure :: l -> (Ptr Align -> IO b) -> IO b
allocaSecure = Alignment -> l -> (Ptr Align -> IO b) -> IO b
forall l b.
LengthUnit l =>
Alignment -> l -> (Ptr Align -> IO b) -> IO b
allocaSecureAligned Alignment
wordAlignment

foreign import ccall unsafe "raaz/core/memory.h raazMemorylock"
  c_mlock :: Pointer -> BYTES Int -> IO Int

foreign import ccall unsafe "raaz/core/memory.h raazMemoryunlock"
  c_munlock :: Pointer -> BYTES Int -> IO ()


-- | This function allocates a chunk of "secure" memory of a given
-- size and runs the action. The memory (1) exists for the duration of
-- the action (2) will not be swapped during that time and (3) will be
-- wiped clean and deallocated when the action terminates either
-- directly or indirectly via errors. While this is mostly secure,
-- there can be strange situations in multi-threaded application where
-- the memory is not wiped out. For example if you run a
-- crypto-sensitive action inside a child thread and the main thread
-- gets exists, then the child thread is killed (due to the demonic
-- nature of haskell threads) immediately and might not give it chance
-- to wipe the memory clean. This is a problem inherent to how the
-- `bracket` combinator works inside a child thread.
--
-- TODO: File this insecurity in the wiki.
--
allocaSecureAligned :: LengthUnit l
                    => Alignment
                    -> l
                    -> (Pointer -> IO a)
                    -> IO a




allocaSecureAligned :: Alignment -> l -> (Ptr Align -> IO a) -> IO a
allocaSecureAligned Alignment
a l
l Ptr Align -> IO a
action = Alignment -> l -> (Ptr Align -> IO a) -> IO a
forall l b.
LengthUnit l =>
Alignment -> l -> (Ptr Align -> IO b) -> IO b
allocaAligned Alignment
a l
l Ptr Align -> IO a
actualAction
  where sz :: BYTES Int
sz = l -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes l
l
        actualAction :: Ptr Align -> IO a
actualAction Ptr Align
cptr = let
          lockIt :: IO ()
lockIt    = do Int
c <- Ptr Align -> BYTES Int -> IO Int
c_mlock Ptr Align
cptr BYTES Int
sz
                         Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"secure memory: unable to lock memory"
          releaseIt :: IO ()
releaseIt =  Ptr Align -> Word8 -> l -> IO ()
forall (m :: * -> *) l.
(MonadIO m, LengthUnit l) =>
Ptr Align -> Word8 -> l -> m ()
memset Ptr Align
cptr Word8
0 l
l IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  Ptr Align -> BYTES Int -> IO ()
c_munlock Ptr Align
cptr BYTES Int
sz
          in IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ IO ()
lockIt IO ()
releaseIt (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ Ptr Align -> IO a
action Ptr Align
cptr

-- | Creates a memory of given size. It is better to use over
-- @`mallocBytes`@ as it uses typesafe length.
mallocBuffer :: LengthUnit l
             => l                    -- ^ buffer length
             -> IO Pointer
{-# INLINE mallocBuffer #-}
mallocBuffer :: l -> IO (Ptr Align)
mallocBuffer l
l = Int -> IO (Ptr Align)
forall a. Int -> IO (Ptr a)
mallocBytes Int
bytes
  where BYTES Int
bytes = l -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes l
l


-------------------- Low level pointer operations ------------------

-- | A version of `hGetBuf` which works for any type safe length units.
hFillBuf :: LengthUnit bufSize
         => Handle
         -> Pointer
         -> bufSize
         -> IO (BYTES Int)
{-# INLINE hFillBuf #-}
hFillBuf :: Handle -> Ptr Align -> bufSize -> IO (BYTES Int)
hFillBuf Handle
handle Ptr Align
cptr bufSize
bufSize = Int -> BYTES Int
forall a. a -> BYTES a
BYTES (Int -> BYTES Int) -> IO Int -> IO (BYTES Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Ptr Align -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
handle Ptr Align
cptr Int
bytes
  where BYTES Int
bytes = bufSize -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes bufSize
bufSize

------------------- Copy move and set contents ----------------------------

-- | Some common PTR functions abstracted over type safe length.
foreign import ccall unsafe "string.h memcpy" c_memcpy
    :: Dest Pointer -> Src Pointer -> BYTES Int -> IO Pointer

-- | Copy between pointers.
memcpy :: (MonadIO m, LengthUnit l)
       => Dest Pointer -- ^ destination
       -> Src  Pointer -- ^ src
       -> l            -- ^ Number of Bytes to copy
       -> m ()
memcpy :: Dest (Ptr Align) -> Src (Ptr Align) -> l -> m ()
memcpy Dest (Ptr Align)
dest Src (Ptr Align)
src = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (l -> IO ()) -> l -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Ptr Align) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Ptr Align) -> IO ()) -> (l -> IO (Ptr Align)) -> l -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dest (Ptr Align) -> Src (Ptr Align) -> BYTES Int -> IO (Ptr Align)
c_memcpy Dest (Ptr Align)
dest Src (Ptr Align)
src (BYTES Int -> IO (Ptr Align))
-> (l -> BYTES Int) -> l -> IO (Ptr Align)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes

{-# SPECIALIZE memcpy :: Dest Pointer -> Src Pointer -> BYTES Int -> IO () #-}

foreign import ccall unsafe "string.h memmove" c_memmove
    :: Dest Pointer -> Src Pointer -> BYTES Int -> IO Pointer

-- | Move between pointers.
memmove :: (MonadIO m, LengthUnit l)
        => Dest Pointer -- ^ destination
        -> Src Pointer  -- ^ source
        -> l            -- ^ Number of Bytes to copy
        -> m ()
memmove :: Dest (Ptr Align) -> Src (Ptr Align) -> l -> m ()
memmove Dest (Ptr Align)
dest Src (Ptr Align)
src = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (l -> IO ()) -> l -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Ptr Align) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Ptr Align) -> IO ()) -> (l -> IO (Ptr Align)) -> l -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dest (Ptr Align) -> Src (Ptr Align) -> BYTES Int -> IO (Ptr Align)
c_memmove Dest (Ptr Align)
dest Src (Ptr Align)
src (BYTES Int -> IO (Ptr Align))
-> (l -> BYTES Int) -> l -> IO (Ptr Align)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes
{-# SPECIALIZE memmove :: Dest Pointer -> Src Pointer -> BYTES Int -> IO () #-}

foreign import ccall unsafe "string.h memset" c_memset
    :: Pointer -> Word8 -> BYTES Int -> IO Pointer

-- | Sets the given number of Bytes to the specified value.
memset :: (MonadIO m, LengthUnit l)
       => Pointer -- ^ Target
       -> Word8     -- ^ Value byte to set
       -> l         -- ^ Number of bytes to set
       -> m ()
memset :: Ptr Align -> Word8 -> l -> m ()
memset Ptr Align
p Word8
w = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (l -> IO ()) -> l -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Ptr Align) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Ptr Align) -> IO ()) -> (l -> IO (Ptr Align)) -> l -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Align -> Word8 -> BYTES Int -> IO (Ptr Align)
c_memset Ptr Align
p Word8
w (BYTES Int -> IO (Ptr Align))
-> (l -> BYTES Int) -> l -> IO (Ptr Align)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes
{-# SPECIALIZE memset :: Pointer -> Word8 -> BYTES Int -> IO () #-}