module Z.Crypto.SafeMem (
  -- * Password
    Password, mkPassword, mkPasswordMaybe, passwordSize, passwordToText
  , withPasswordUnsafe, withPasswordSafe
  , InvalidPasswordException(..)
  -- * Nonce
  , Nonce, rand96bitNonce, rand128bitNonce, rand192bitNonce
  , cnt32bitNonce, cnt64bitNonce
  -- * CEBytes
  , CEBytes(..), ceBytesSize, ceBytesBitSize, newCEBytesUnsafe, newCEBytesSafe, ceBytes, unCEBytes
  -- * Secret
  , Secret, secretSize, secretBitSize, unsafeSecretFromBytes, unsafeSecretToBytes
  , newSecret, withSecret
  ) where

import           Control.Monad.Primitive
import           Data.Bits
import           Data.Char
import           Data.Int
import           Data.String
import           Data.Word
import           GHC.Prim
import           GHC.Ptr
import           Z.Botan.FFI
import           Z.Crypto.RNG
import qualified Z.Data.Builder          as B
import qualified Z.Data.CBytes           as CB
import qualified Z.Data.Text             as T
import qualified Z.Data.Text.Base        as T
import qualified Z.Data.Vector.Base      as V
import qualified Z.Data.Vector.Hex       as V
import           Z.Foreign
import           Z.IO.Exception
import           System.IO.Unsafe

-- | A type for human readable, it have
--
-- The 'Key' have the properties that:
--
-- * It's assumed to be UTF8 encoded and normalized, and does not have <https://en.wikipedia.org/wiki/Control_character control-characters>.
-- * There's no 'Eq' instance, you should always compare 'Password' via password hash.
-- * The 'Show' or 'Print' instance always print @"**PASSWORD**"@.
--
--  'Password' is not intented to be saved or transmitted, it's only useful when you want to validate a user's input against password hash.
--  See "Z.Crypto.PwdHash".
--
newtype Password = Password CB.CBytes

instance Show Password where
    show :: Password -> String
show Password
_ = String
"**PASSWORD**"

instance T.Print Password where
    {-# INLINABLE toUTF8BuilderP #-}
    toUTF8BuilderP :: Int -> Password -> Builder ()
toUTF8BuilderP Int
_ Password
_ = Builder ()
"**PASSWORD**"

instance IsString Password where
    {-# INLINABLE fromString #-}
    fromString :: String -> Password
fromString = HasCallStack => Text -> Password
Text -> Password
mkPassword (Text -> Password) -> (String -> Text) -> String -> Password
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- | Construct a password value from 'T.Text', if there're control-characters error will be thrown.
mkPassword :: HasCallStack => T.Text -> Password
{-# INLINABLE mkPassword #-}
mkPassword :: Text -> Password
mkPassword Text
pwd = case Text -> Maybe Password
mkPasswordMaybe Text
pwd of
    Just Password
r -> Password
r
    Maybe Password
_ -> InvalidPasswordException -> Password
forall a e. Exception e => e -> a
throw (CallStack -> InvalidPasswordException
PasswordContainsControlCharacter CallStack
HasCallStack => CallStack
callStack)

data InvalidPasswordException = PasswordContainsControlCharacter CallStack deriving Int -> InvalidPasswordException -> ShowS
[InvalidPasswordException] -> ShowS
InvalidPasswordException -> String
(Int -> InvalidPasswordException -> ShowS)
-> (InvalidPasswordException -> String)
-> ([InvalidPasswordException] -> ShowS)
-> Show InvalidPasswordException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidPasswordException] -> ShowS
$cshowList :: [InvalidPasswordException] -> ShowS
show :: InvalidPasswordException -> String
$cshow :: InvalidPasswordException -> String
showsPrec :: Int -> InvalidPasswordException -> ShowS
$cshowsPrec :: Int -> InvalidPasswordException -> ShowS
Show
instance Exception InvalidPasswordException

-- | Construct a password value from 'Text', return 'Nothing' if contain control-characters.
mkPasswordMaybe :: T.Text -> Maybe Password
{-# INLINABLE mkPasswordMaybe #-}
mkPasswordMaybe :: Text -> Maybe Password
mkPasswordMaybe Text
pwd =
    case (Char -> Bool) -> Text -> (Int, Maybe Char)
T.find Char -> Bool
isControl Text
pwd of
        (Int
_, Maybe Char
Nothing) ->
            let pwd' :: Text
pwd' = case Text -> NormalizationResult
T.isNormalized Text
pwd of
                    NormalizationResult
T.NormalizedYes -> Text
pwd
                    NormalizationResult
_ -> Text -> Text
T.normalize Text
pwd
            in Password -> Maybe Password
forall a. a -> Maybe a
Just (Password -> Maybe Password) -> Password -> Maybe Password
forall a b. (a -> b) -> a -> b
$! CBytes -> Password
Password (Text -> CBytes
CB.fromText Text
pwd')
        (Int, Maybe Char)
_ -> Maybe Password
forall a. Maybe a
Nothing

-- | Byte size of a password.
passwordSize :: Password -> Int
{-# INLINABLE passwordSize #-}
passwordSize :: Password -> Int
passwordSize (Password CBytes
pwd) = CBytes -> Int
CB.length CBytes
pwd

-- | Get plaintext of a password.
passwordToText :: Password -> T.Text
{-# INLINABLE passwordToText #-}
passwordToText :: Password -> Text
passwordToText (Password CBytes
pwd) = Bytes -> Text
T.Text (CBytes -> Bytes
CB.toBytes CBytes
pwd)

-- | Use password as null-terminated @const char*@, USE WITH UNSAFE FFI ONLY, PLEASE DO NOT MODIFY THE CONTENT.
withPasswordUnsafe :: Password -> (BA# Word8 -> IO r) -> IO r
{-# INLINABLE withPasswordUnsafe #-}
withPasswordUnsafe :: Password -> (BA# Word8 -> IO r) -> IO r
withPasswordUnsafe (Password CBytes
pwd) = CBytes -> (BA# Word8 -> IO r) -> IO r
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe CBytes
pwd

-- | Use password as null-terminated @const char*@, PLEASE DO NOT MODIFY THE CONTENT.
withPasswordSafe :: Password -> (Ptr Word8 -> IO r) -> IO r
{-# INLINABLE withPasswordSafe #-}
withPasswordSafe :: Password -> (Ptr Word8 -> IO r) -> IO r
withPasswordSafe (Password CBytes
pwd) = CBytes -> (Ptr Word8 -> IO r) -> IO r
forall a. CBytes -> (Ptr Word8 -> IO a) -> IO a
CB.withCBytes CBytes
pwd

--------------------------------------------------------------------------------

-- | A value used only once in AEAD modes.
--
-- We use also this type to represent IV(initialization vector) for stream ciphers, but the way a nonce is generated is different:
-- random IV is one generation choice which is usually fine, while Nonce can also be a counter, which is not ok for CBC mode.
--
-- Some common nonce size:
--
-- * 96bit for GCM AEAD, ChaCha20Poly1305.
-- * 128bit for XChaCha20Poly1305.
-- * Block size for CBC IV(e.g. 128 bits for AES).
--
type Nonce = V.Bytes

-- | Get 64-bit random nonce.
rand96bitNonce :: RNG -> IO Nonce
{-# INLINABLE rand96bitNonce #-}
rand96bitNonce :: RNG -> IO Bytes
rand96bitNonce RNG
rng = HasCallStack => RNG -> Int -> IO Bytes
RNG -> Int -> IO Bytes
getRandom RNG
rng Int
12

-- | Get 128-bit random nonce.
rand128bitNonce :: RNG -> IO Nonce
{-# INLINABLE rand128bitNonce #-}
rand128bitNonce :: RNG -> IO Bytes
rand128bitNonce RNG
rng = HasCallStack => RNG -> Int -> IO Bytes
RNG -> Int -> IO Bytes
getRandom RNG
rng Int
16

-- | Get 192-bit random nonce.
rand192bitNonce :: RNG -> IO Nonce
{-# INLINABLE rand192bitNonce #-}
rand192bitNonce :: RNG -> IO Bytes
rand192bitNonce RNG
rng = HasCallStack => RNG -> Int -> IO Bytes
RNG -> Int -> IO Bytes
getRandom RNG
rng Int
24

-- | Get 32bit nonce from counter.
cnt32bitNonce :: Int32 -> Nonce
{-# INLINABLE cnt32bitNonce #-}
cnt32bitNonce :: Int32 -> Bytes
cnt32bitNonce Int32
c = Builder () -> Bytes
forall a. Builder a -> Bytes
B.build (Builder () -> Bytes) -> Builder () -> Bytes
forall a b. (a -> b) -> a -> b
$ Int32 -> Builder ()
forall a. Unaligned (BE a) => a -> Builder ()
B.encodePrimBE Int32
c

-- | Get 64bit nonce from counter.
cnt64bitNonce :: Int64 -> Nonce
{-# INLINABLE cnt64bitNonce #-}
cnt64bitNonce :: Int64 -> Bytes
cnt64bitNonce Int64
c = Builder () -> Bytes
forall a. Builder a -> Bytes
B.build (Builder () -> Bytes) -> Builder () -> Bytes
forall a b. (a -> b) -> a -> b
$ Int64 -> Builder ()
forall a. Unaligned (BE a) => a -> Builder ()
B.encodePrimBE Int64
c

--------------------------------------------------------------------------------

-- | Constant-time equal comparing bytes.
--
-- It comes with following property:
--
-- * The 'Eq' instance gives you constant-time compare.
-- * The 'Show' and 'T.Print' instances give you hex encoding.
--
newtype CEBytes = CEBytes (PrimArray Word8)

ceBytesSize :: CEBytes -> Int
{-# INLINABLE ceBytesSize #-}
ceBytesSize :: CEBytes -> Int
ceBytesSize (CEBytes PrimArray Word8
d) = PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
d

ceBytesBitSize :: CEBytes -> Int
{-# INLINABLE ceBytesBitSize #-}
ceBytesBitSize :: CEBytes -> Int
ceBytesBitSize (CEBytes PrimArray Word8
d) = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (PrimArray Word8 -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length PrimArray Word8
d)

instance Eq CEBytes where
    {-# INLINABLE (==) #-}
    (CEBytes pa :: PrimArray Word8
pa@(PrimArray BA# Word8
ba#)) == :: CEBytes -> CEBytes -> Bool
== (CEBytes pb :: PrimArray Word8
pb@(PrimArray BA# Word8
bb#)) =
        Int
la Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lb Bool -> Bool -> Bool
&& BA# Word8 -> BA# Word8 -> CSize -> CInt
botan_constant_time_compare_ba BA# Word8
ba# BA# Word8
bb# (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
la) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
      where
        la :: Int
la = PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
pa
        lb :: Int
lb = PrimArray Word8 -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Word8
pb

instance Show CEBytes where
    show :: CEBytes -> String
show = CEBytes -> String
forall a. Print a => a -> String
T.toString

instance T.Print CEBytes where
    toUTF8BuilderP :: Int -> CEBytes -> Builder ()
toUTF8BuilderP Int
_ = Bool -> Bytes -> Builder ()
V.hexEncodeBuilder Bool
True (Bytes -> Builder ())
-> (CEBytes -> Bytes) -> CEBytes -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CEBytes -> Bytes
unCEBytes

-- | Create a ceBytes from unsafe FFI.
newCEBytesUnsafe :: Int -> (MBA# Word8 -> IO r) -> IO CEBytes
{-# INLINABLE newCEBytesUnsafe #-}
newCEBytesUnsafe :: Int -> (MBA# Word8 -> IO r) -> IO CEBytes
newCEBytesUnsafe Int
len MBA# Word8 -> IO r
f = do
    (PrimArray Word8
d, r
_) <- Int -> (MBA# Word8 -> IO r) -> IO (PrimArray Word8, r)
forall a b.
Prim a =>
Int -> (MBA# Word8 -> IO b) -> IO (PrimArray a, b)
allocPrimArrayUnsafe Int
len MBA# Word8 -> IO r
f
    CEBytes -> IO CEBytes
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray Word8 -> CEBytes
CEBytes PrimArray Word8
d)

-- | Create a ceBytes from safe FFI.
newCEBytesSafe :: Int -> (Ptr Word8 -> IO r) -> IO CEBytes
{-# INLINABLE newCEBytesSafe #-}
newCEBytesSafe :: Int -> (Ptr Word8 -> IO r) -> IO CEBytes
newCEBytesSafe Int
len Ptr Word8 -> IO r
f = do
    (PrimArray Word8
d, r
_) <- Int -> (Ptr Word8 -> IO r) -> IO (PrimArray Word8, r)
forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO (PrimArray a, b)
allocPrimArraySafe Int
len Ptr Word8 -> IO r
f
    CEBytes -> IO CEBytes
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimArray Word8 -> CEBytes
CEBytes PrimArray Word8
d)

-- | Create a 'CEBytes' from 'V.Bytes'.
ceBytes :: V.Bytes -> CEBytes
{-# INLINABLE ceBytes #-}
ceBytes :: Bytes -> CEBytes
ceBytes = PrimArray Word8 -> CEBytes
CEBytes (PrimArray Word8 -> CEBytes)
-> (Bytes -> PrimArray Word8) -> Bytes -> CEBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> PrimArray Word8
forall (v :: * -> *) a (u :: * -> *).
(Vec v a, Vec u a, IArray v ~ IArray u) =>
v a -> u a
V.arrVec

-- | Get 'CEBytes' 's content as 'V.Bytes', by doing this you lose the constant-time comparing.
unCEBytes :: CEBytes -> V.Bytes
{-# INLINABLE unCEBytes #-}
unCEBytes :: CEBytes -> Bytes
unCEBytes (CEBytes PrimArray Word8
d) = PrimArray Word8 -> Bytes
forall (v :: * -> *) a (u :: * -> *).
(Vec v a, Vec u a, IArray v ~ IArray u) =>
v a -> u a
V.arrVec PrimArray Word8
d

--------------------------------------------------------------------------------

-- | Memory allocated by locked allocator and will be zeroed after used.
--
-- * It's allocated by botan's locking allocator(which means it will not get swapped to disk) if possible.
-- * It will zero the memory it used once get GCed.
-- * The 'Eq' instance gives you constant-time compare.
-- * The 'Show' or 'Print' instance always print @"**SECRET**"@.
--
--  'Secret' is not intented to be saved or transmitted, there're several way to obtain a 'Secret':
--
--  + Use 'unsafeSecretFromBytes' to convert a piece of 'Bytes' to 'Secret'.
--  + Use key-exchanges from 'Z.Crypto.PubKey'.
--  + Unwrap a key, see 'Z.Crypto.KeyWrap'.
--
newtype Secret = Secret (PrimArray (Ptr Word8))

instance Show Secret where
    show :: Secret -> String
show Secret
_ = String
"**SECRET**"

instance T.Print Secret where
    {-# INLINABLE toUTF8BuilderP #-}
    toUTF8BuilderP :: Int -> Secret -> Builder ()
toUTF8BuilderP Int
_ Secret
_ = Builder ()
"**SECRET**"

-- | This instance will break the no-tracing property by saving secret in compiled and loaded binary.
instance IsString Secret where
    {-# INLINABLE fromString #-}
    fromString :: String -> Secret
fromString = IO Secret -> Secret
forall a. IO a -> a
unsafePerformIO (IO Secret -> Secret) -> (String -> IO Secret) -> String -> Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> IO Secret
unsafeSecretFromBytes (Bytes -> IO Secret) -> (String -> Bytes) -> String -> IO Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bytes
forall a. IsString a => String -> a
fromString

-- | Constant-time compare
instance Eq Secret where
    {-# INLINABLE (==) #-}
    a :: Secret
a@(Secret PrimArray (Ptr Word8)
pa) == :: Secret -> Secret -> Bool
== b :: Secret
b@(Secret PrimArray (Ptr Word8)
pb) =
        Int
la Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lb Bool -> Bool -> Bool
&& Ptr Word8 -> Ptr Word8 -> CSize -> CInt
botan_constant_time_compare (PrimArray (Ptr Word8) -> Int -> Ptr Word8
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray (Ptr Word8)
pa Int
0) (PrimArray (Ptr Word8) -> Int -> Ptr Word8
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray (Ptr Word8)
pb Int
0) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
la) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
      where
        la :: Int
la = Secret -> Int
secretSize Secret
a
        lb :: Int
lb = Secret -> Int
secretSize Secret
b

-- | Get secret key's byte length.
secretSize :: Secret -> Int
{-# INLINABLE secretSize #-}
secretSize :: Secret -> Int
secretSize (Secret PrimArray (Ptr Word8)
pa) = (PrimArray (Ptr Word8) -> Int -> Ptr Word8
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray (Ptr Word8)
pa Int
1) Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` (PrimArray (Ptr Word8) -> Int -> Ptr Word8
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray (Ptr Word8)
pa Int
0)

-- | Get secret key's bit size.
secretBitSize :: Secret -> Int
{-# INLINABLE secretBitSize #-}
secretBitSize :: Secret -> Int
secretBitSize Secret
k = Secret -> Int
secretSize Secret
k Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
3

-- | Unsafe convert a 'V.Bytes' to a 'Secret'.
--
-- Note the original 'V.Bytes' may get moved by GC or swapped to disk, which may defeat the purpose of using a 'Secret'.
unsafeSecretFromBytes :: V.Bytes -> IO Secret
{-# INLINABLE unsafeSecretFromBytes #-}
unsafeSecretFromBytes :: Bytes -> IO Secret
unsafeSecretFromBytes (V.PrimVector PrimArray Word8
pa Int
poff Int
plen) = Int -> (Ptr Word8 -> IO ()) -> IO Secret
forall r. Int -> (Ptr Word8 -> IO r) -> IO Secret
newSecret Int
plen ((Ptr Word8 -> IO ()) -> IO Secret)
-> (Ptr Word8 -> IO ()) -> IO Secret
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
p ->
    Ptr Word8 -> PrimArray Word8 -> Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Ptr a -> PrimArray a -> Int -> Int -> m ()
copyPrimArrayToPtr Ptr Word8
p PrimArray Word8
pa Int
poff Int
plen

-- | Unsafe convert a 'V.Bytes' from a 'Secret'.
--
-- Note the result 'V.Bytes' may get moved by GC or swapped to disk, which may defeat the purpose of using a 'Secret'.
unsafeSecretToBytes :: Secret -> IO V.Bytes
{-# INLINABLE unsafeSecretToBytes #-}
unsafeSecretToBytes :: Secret -> IO Bytes
unsafeSecretToBytes Secret
key = Secret -> (Ptr Word8 -> CSize -> IO Bytes) -> IO Bytes
forall r. Secret -> (Ptr Word8 -> CSize -> IO r) -> IO r
withSecret Secret
key ((Ptr Word8 -> CSize -> IO Bytes) -> IO Bytes)
-> (Ptr Word8 -> CSize -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
p CSize
len ->
    let len' :: Int
len' = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len
    in (Bytes, ()) -> Bytes
forall a b. (a, b) -> a
fst ((Bytes, ()) -> Bytes) -> IO (Bytes, ()) -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (MBA# Word8 -> IO ()) -> IO (Bytes, ())
forall a b.
Prim a =>
Int -> (MBA# Word8 -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe Int
len' (\ MBA# Word8
p' ->
        MutablePrimArray (PrimState IO) Word8
-> Int -> Ptr Word8 -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray (MBA# Word8 -> MutablePrimArray RealWorld Word8
forall s a. MutableByteArray# s -> MutablePrimArray s a
MutablePrimArray MBA# Word8
p') Int
0 Ptr Word8
p Int
len')

-- | Initialize a 'Secret' which pass an allocated pointer pointing to zeros to a init function.
newSecret :: Int -> (Ptr Word8 -> IO r) -> IO Secret
{-# INLINABLE newSecret #-}
newSecret :: Int -> (Ptr Word8 -> IO r) -> IO Secret
newSecret Int
len Ptr Word8 -> IO r
f = IO Secret -> IO Secret
forall a. IO a -> IO a
mask_ (IO Secret -> IO Secret) -> IO Secret -> IO Secret
forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray RealWorld (Ptr Word8)
mpa <- Int -> IO (MutablePrimArray (PrimState IO) (Ptr Word8))
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
2
    p :: Ptr Word8
p@(Ptr Addr#
addr#) <- Int -> IO (Ptr Word8)
hs_botan_allocate_memory Int
len
    r
_ <- Ptr Word8 -> IO r
f Ptr Word8
p IO r -> IO () -> IO r
forall a b. IO a -> IO b -> IO a
`onException` Ptr Word8 -> Ptr Word8 -> IO ()
hs_botan_deallocate_memory (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len) Ptr Word8
p
    let !p' :: Ptr Word8
p'@(Ptr Addr#
addr'#) = Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
    MutablePrimArray (PrimState IO) (Ptr Word8)
-> Int -> Ptr Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld (Ptr Word8)
MutablePrimArray (PrimState IO) (Ptr Word8)
mpa Int
0 Ptr Word8
p
    MutablePrimArray (PrimState IO) (Ptr Word8)
-> Int -> Ptr Word8 -> IO ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld (Ptr Word8)
MutablePrimArray (PrimState IO) (Ptr Word8)
mpa Int
1 Ptr Word8
p'
    pa :: PrimArray (Ptr Word8)
pa@(PrimArray BA# Word8
ba#) <- MutablePrimArray (PrimState IO) (Ptr Word8)
-> IO (PrimArray (Ptr Word8))
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld (Ptr Word8)
MutablePrimArray (PrimState IO) (Ptr Word8)
mpa
    (State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ ((State# (PrimState IO) -> State# (PrimState IO)) -> IO ())
-> (State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ State# (PrimState IO)
s0# ->
        let !(# State# RealWorld
s1#, Weak# ()
w# #) = BA# Word8
-> () -> State# RealWorld -> (# State# RealWorld, Weak# () #)
forall a b.
a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# BA# Word8
ba# () State# RealWorld
State# (PrimState IO)
s0#
            !(# State# RealWorld
s2#, Int#
_ #) = Addr#
-> Addr#
-> Int#
-> Addr#
-> Weak# ()
-> State# RealWorld
-> (# State# RealWorld, Int# #)
forall b.
Addr#
-> Addr#
-> Int#
-> Addr#
-> Weak# b
-> State# RealWorld
-> (# State# RealWorld, Int# #)
addCFinalizerToWeak# Addr#
fin# Addr#
addr# Int#
1# Addr#
addr'# Weak# ()
w# State# RealWorld
s1#
        in State# RealWorld
State# (PrimState IO)
s2#
    Secret -> IO Secret
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray (Ptr Word8) -> Secret
Secret PrimArray (Ptr Word8)
pa)
  where
    !(FunPtr Addr#
fin#) = FunPtr (Ptr Word8 -> Ptr Word8 -> IO ())
hs_botan_deallocate_memory_p

-- | Use 'Secret' as a @const char*@, PLEASE DO NOT MODIFY THE CONTENT.
--
withSecret :: Secret -> (Ptr Word8 -> CSize -> IO r) -> IO r
{-# INLINABLE withSecret #-}
withSecret :: Secret -> (Ptr Word8 -> CSize -> IO r) -> IO r
withSecret (Secret pa :: PrimArray (Ptr Word8)
pa@(PrimArray BA# Word8
ba#)) Ptr Word8 -> CSize -> IO r
f = do
    let p :: Ptr Word8
p   = PrimArray (Ptr Word8) -> Int -> Ptr Word8
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray (Ptr Word8)
pa Int
0
        p' :: Ptr Word8
p'  = PrimArray (Ptr Word8) -> Int -> Ptr Word8
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray (Ptr Word8)
pa Int
1
    r
x <- Ptr Word8 -> CSize -> IO r
f Ptr Word8
p (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Ptr Word8
p' Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p)
    (State# (PrimState IO) -> State# (PrimState IO)) -> IO ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (BA# Word8 -> State# RealWorld -> State# RealWorld
forall a. a -> State# RealWorld -> State# RealWorld
touch# BA# Word8
ba#)
    r -> IO r
forall (m :: * -> *) a. Monad m => a -> m a
return r
x