module Botan.Low.Prelude
( module Prelude
, module Control.Monad
, module Control.Exception
, module Control.DeepSeq
, module Data.ByteString
, module Data.String
, module Data.Text
, module Data.Word
, module System.IO
, module Foreign.C.String
, module Foreign.C.Types
, module Foreign.ForeignPtr
, module Foreign.Marshal.Alloc
, module Foreign.Marshal.Array
, module Foreign.Ptr
, module Foreign.Storable
, module GHC.Stack
, ConstPtr(..)
, peekCString
, withCString
, withCBytes
, withCBytesLen
, withConstCString
, withMany
-- Old
, peekCStringText
, allocBytes
, allocBytesWith
, asCString
, asCStringLen
, asBytes
, unsafeAsBytes
, asBytesLen
, unsafeAsBytesLen
-- Helpers
, (//)
, (/$)
, showBytes
) where

-- Re-exported modules

import Prelude

import Control.Monad
import Control.Exception
import Control.DeepSeq

import Data.ByteString (ByteString)
import Data.String (IsString(..))
import Data.Text (Text)

import Data.Word

import System.IO

import Foreign.C.String hiding (peekCString, peekCStringLen, withCString, withCStringLen)
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable

import GHC.Stack

-- Other Imports

import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Internal as ByteString
import qualified Data.ByteString.Unsafe as ByteString

import qualified Data.ByteString.Char8 as Char8

import qualified Data.Text.Encoding as Text

import Botan.Bindings.Prelude (ConstPtr(..))

{-
Small rant: CString is a bit of a mess

- CString doesn't work with const
- There is no CBytes
- Doesn't work with ConstPtr
- Different names for different types (peek vs pack, useAs vs with)
    - Data.ByteString
        - packCString :: CString -> IO ByteString
        - useAsCString :: ByteString -> (CString -> IO a) -> IO a 
    - Text
    - Foreign.C.String
        - peekCString :: CString -> IO String
        - withCString :: String -> (CString -> IO a) -> IO a 
-}

{-
BETTER VERSIONS
-}

-- Types

-- Safe functions that make a temporary copy
-- Only care about ByteString, leave Text for higher-level botan

-- type CString = Ptr CChar

peekCString :: CString -> IO ByteString
peekCString :: CString -> IO ByteString
peekCString = CString -> IO ByteString
ByteString.packCString

-- Replaces 'asCString'
withCString :: ByteString -> (CString -> IO a) -> IO a
withCString :: forall a. ByteString -> (CString -> IO a) -> IO a
withCString = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
ByteString.useAsCString

-- type CStringLen = (Ptr CChar, Int)

peekCStringLen :: CStringLen -> IO ByteString
peekCStringLen :: CStringLen -> IO ByteString
peekCStringLen = CStringLen -> IO ByteString
ByteString.packCStringLen

-- Replaces 'asCStringLen'
withCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
withCStringLen :: forall a. ByteString -> (CStringLen -> IO a) -> IO a
withCStringLen = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
ByteString.useAsCStringLen

type CBytes = Ptr Word8

-- peekCBytes :: CBytes -> Int -> IO ByteString
-- peekCBytes = undefined

withCBytes :: ByteString -> (CBytes -> IO a) -> IO a 
withCBytes :: forall a. ByteString -> (CBytes -> IO a) -> IO a
withCBytes ByteString
bs CBytes -> IO a
act = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
ByteString.useAsCStringLen ByteString
bs (\ (CString
ptr,Int
_) -> CBytes -> IO a
act (CString -> CBytes
forall a b. Ptr a -> Ptr b
castPtr CString
ptr))

type CBytesLen = (Ptr Word8, Int)

peekCBytesLen :: CBytesLen -> IO ByteString
peekCBytesLen :: CBytesLen -> IO ByteString
peekCBytesLen (CBytes
ptr, Int
len) = CStringLen -> IO ByteString
ByteString.packCStringLen (CBytes -> CString
forall a b. Ptr a -> Ptr b
castPtr CBytes
ptr, Int
len)

-- Replaces 'asBytesLen'
withCBytesLen :: ByteString -> (CBytesLen -> IO a) -> IO a
withCBytesLen :: forall a. ByteString -> (CBytesLen -> IO a) -> IO a
withCBytesLen ByteString
bs CBytesLen -> IO a
act = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
ByteString.useAsCStringLen ByteString
bs (\ (CString
ptr,Int
len) -> CBytesLen -> IO a
act (CString -> CBytes
forall a b. Ptr a -> Ptr b
castPtr CString
ptr, Int
len))

-- QUESTION: Is it worth it to have extra types for ConstPtr versions?

{-
type ConstCString       = ConstPtr CChar
type ConstCStringLen    = (ConstPtr CChar, Int) 

type ConstCBytes    = ConstPtr Word8
type ConstCBytesLen = (ConstPtr Word8, Int)
-}

-- TODO: Replace
--      withCString str $ \ cstr -> ... (ConstPtr cstr) ...
--  with
--      withConstCString str $ \ cstr -> ... cstr ...
withConstCString :: ByteString -> (ConstPtr CChar -> IO a) -> IO a
withConstCString :: forall a. ByteString -> (ConstPtr CChar -> IO a) -> IO a
withConstCString ByteString
bs ConstPtr CChar -> IO a
act = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
ByteString.useAsCString ByteString
bs (ConstPtr CChar -> IO a
act (ConstPtr CChar -> IO a)
-> (CString -> ConstPtr CChar) -> CString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr)

{-
Misc
-}

withMany
    :: (forall a . object -> (cobject -> IO a) -> IO a)
    -> [object]
    -> ([cobject] -> IO b)
    -> IO b
withMany :: forall object cobject b.
(forall a. object -> (cobject -> IO a) -> IO a)
-> [object] -> ([cobject] -> IO b) -> IO b
withMany forall a. object -> (cobject -> IO a) -> IO a
withObject []         [cobject] -> IO b
act = [cobject] -> IO b
act []
withMany forall a. object -> (cobject -> IO a) -> IO a
withObject (object
obj:[object]
objs) [cobject] -> IO b
act = object -> (cobject -> IO b) -> IO b
forall a. object -> (cobject -> IO a) -> IO a
withObject object
obj ((cobject -> IO b) -> IO b) -> (cobject -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ cobject
cobj -> (forall a. object -> (cobject -> IO a) -> IO a)
-> [object] -> ([cobject] -> IO b) -> IO b
forall object cobject b.
(forall a. object -> (cobject -> IO a) -> IO a)
-> [object] -> ([cobject] -> IO b) -> IO b
withMany object -> (cobject -> IO a) -> IO a
forall a. object -> (cobject -> IO a) -> IO a
withObject [object]
objs ([cobject] -> IO b
act ([cobject] -> IO b)
-> ([cobject] -> [cobject]) -> [cobject] -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (cobject
cobjcobject -> [cobject] -> [cobject]
forall a. a -> [a] -> [a]
:))

{-
OLD
-}


-- Because:
--  https://github.com/haskell/text/issues/239
-- Is still an issue
peekCStringText :: CString -> IO Text
peekCStringText :: CString -> IO Text
peekCStringText CString
cs = do
    ByteString
bs <- CString -> IO ByteString
ByteString.unsafePackCString CString
cs
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$! ByteString -> Text
Text.decodeUtf8 ByteString
bs

-- A cheap knockoff of ByteArray.alloc / allocRet
-- We'll make this safer in the future
-- NOTE: THIS IS NOT LIKE Foriegn.Marshal.Alloc.allocaBytes, though it is close
--  Instead of returning the thing, we always return a bytestring.
--  Also, allocaBytes frees the memory after, but this is a malloc freed on garbage collect.
-- I basically ripped the relevant bits from ByteArray for ease of continuity
allocBytes :: Int -> (Ptr byte -> IO ()) -> IO ByteString
-- allocBytes sz f = snd <$> allocBytesWith sz f
-- NOTE: This is probably better than mallocByteString withForeignPtr
--  Use of mallocByteString without mkDeferredByteString / deferForeignPtrAvailability
--  is possibly a factor in our InsufficientBufferSpaceException issues
-- NOTE: Most of the comments are rendered moot now :) this needs cleanup
allocBytes :: forall byte. Int -> (Ptr byte -> IO ()) -> IO ByteString
allocBytes Int
sz Ptr byte -> IO ()
f = Int -> (CBytes -> IO ()) -> IO ByteString
ByteString.create Int
sz (Ptr byte -> IO ()
f (Ptr byte -> IO ()) -> (CBytes -> Ptr byte) -> CBytes -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> Ptr byte
forall a b. Ptr a -> Ptr b
castPtr)

allocBytesWith :: Int -> (Ptr byte -> IO a) -> IO (a, ByteString)
allocBytesWith :: forall byte a. Int -> (Ptr byte -> IO a) -> IO (a, ByteString)
allocBytesWith Int
sz Ptr byte -> IO a
f
    | Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0    = Int -> (Ptr byte -> IO a) -> IO (a, ByteString)
forall byte a. Int -> (Ptr byte -> IO a) -> IO (a, ByteString)
allocBytesWith Int
0 Ptr byte -> IO a
f
    | Bool
otherwise = do
        ForeignPtr Word8
fptr <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
ByteString.mallocByteString Int
sz
        a
a <- ForeignPtr Word8 -> (CBytes -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr (Ptr byte -> IO a
f (Ptr byte -> IO a) -> (CBytes -> Ptr byte) -> CBytes -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> Ptr byte
forall a b. Ptr a -> Ptr b
castPtr)
        -- return (a, ByteString.PS fptr 0 sz)
        -- NOTE: The safety of this function is suspect, may require deepseq
        let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
ByteString.PS ForeignPtr Word8
fptr Int
0 Int
sz
            in ByteString
bs ByteString -> IO (a, ByteString) -> IO (a, ByteString)
forall a b. NFData a => a -> b -> b
`deepseq` (a, ByteString) -> IO (a, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,ByteString
bs)

-- ByteString.create' doesn't exist
-- TODO: Replace allocBytesWith with this
createByteString' :: Int -> (Ptr byte -> IO a) -> IO (ByteString,a)
createByteString' :: forall byte a. Int -> (Ptr byte -> IO a) -> IO (ByteString, a)
createByteString' Int
sz Ptr byte -> IO a
action = Int -> (CBytes -> IO (Int, a)) -> IO (ByteString, a)
forall a. Int -> (CBytes -> IO (Int, a)) -> IO (ByteString, a)
ByteString.createUptoN' Int
sz ((CBytes -> IO (Int, a)) -> IO (ByteString, a))
-> (CBytes -> IO (Int, a)) -> IO (ByteString, a)
forall a b. (a -> b) -> a -> b
$ \ CBytes
ptr -> do
    a
a <- Ptr byte -> IO a
action (CBytes -> Ptr byte
forall a b. Ptr a -> Ptr b
castPtr CBytes
ptr)
    (Int, a) -> IO (Int, a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
sz,a
a)
{-# INLINE createByteString' #-}

--

asCString :: ByteString -> (Ptr CChar -> IO a) -> IO a
asCString :: forall a. ByteString -> (CString -> IO a) -> IO a
asCString = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
ByteString.useAsCString

asCStringLen :: ByteString -> (Ptr CChar -> CSize -> IO a) -> IO a
asCStringLen :: forall a. ByteString -> (CString -> CSize -> IO a) -> IO a
asCStringLen ByteString
bs CString -> CSize -> IO a
f = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
ByteString.useAsCStringLen ByteString
bs (\ (CString
ptr,Int
len) -> CString -> CSize -> IO a
f CString
ptr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))

asBytes :: ByteString -> (Ptr byte -> IO a) -> IO a
asBytes :: forall byte a. ByteString -> (Ptr byte -> IO a) -> IO a
asBytes ByteString
bs Ptr byte -> IO a
f = ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen ByteString
bs (\ Ptr byte
ptr CSize
_ -> Ptr byte -> IO a
f Ptr byte
ptr)

unsafeAsBytes :: ByteString -> (Ptr byte -> IO a) -> IO a
unsafeAsBytes :: forall byte a. ByteString -> (Ptr byte -> IO a) -> IO a
unsafeAsBytes ByteString
bs Ptr byte -> IO a
f = ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
unsafeAsBytesLen ByteString
bs (\ Ptr byte
ptr CSize
_ -> Ptr byte -> IO a
f Ptr byte
ptr)

-- WARNING: This should not be using `useAsCStringLen`
asBytesLen :: ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen :: forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen ByteString
bs Ptr byte -> CSize -> IO a
f = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
ByteString.useAsCStringLen ByteString
bs (\ (CString
ptr,Int
len) -> Ptr byte -> CSize -> IO a
f (CString -> Ptr byte
forall a b. Ptr a -> Ptr b
castPtr CString
ptr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))

unsafeAsBytesLen :: ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
unsafeAsBytesLen :: forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
unsafeAsBytesLen ByteString
bs Ptr byte -> CSize -> IO a
f = ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
ByteString.unsafeUseAsCStringLen ByteString
bs (\ (CString
ptr,Int
len) -> Ptr byte -> CSize -> IO a
f (CString -> Ptr byte
forall a b. Ptr a -> Ptr b
castPtr CString
ptr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))

-- Helpers used in a few name constructors

infixr 6 //
(//) :: (IsString a, Semigroup a) => a -> a -> a
a
a // :: forall a. (IsString a, Semigroup a) => a -> a -> a
// a
b = a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"/" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b

infixr 0 /$
(/$) :: (IsString a, Semigroup a) => a -> a -> a
a
a /$ :: forall a. (IsString a, Semigroup a) => a -> a -> a
/$ a
b = a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"

showBytes :: (Show a) => a -> ByteString
showBytes :: forall a. Show a => a -> ByteString
showBytes = String -> ByteString
Char8.pack (String -> ByteString) -> (a -> String) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show