{-# LINE 1 "OpenSSL/Stack.hsc" #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI                  #-}
module OpenSSL.Stack
    ( STACK
    , mapStack
    , withStack
    , withForeignStack
    )
    where

import           Control.Exception
import           Foreign
import           Foreign.C


data STACK



{-# LINE 21 "OpenSSL/Stack.hsc" #-}
foreign import capi unsafe "openssl/safestack.h OPENSSL_sk_new_null"
        skNewNull :: IO (Ptr STACK)

foreign import capi unsafe "openssl/safestack.h OPENSSL_sk_free"
        skFree :: Ptr STACK -> IO ()

foreign import capi unsafe "openssl/safestack.h OPENSSL_sk_push"
        skPush :: Ptr STACK -> Ptr () -> IO ()

foreign import capi unsafe "openssl/safestack.h OPENSSL_sk_num"
        skNum :: Ptr STACK -> IO CInt

foreign import capi unsafe "openssl/safestack.h OPENSSL_sk_value"
        skValue :: Ptr STACK -> CInt -> IO (Ptr ())

{-# LINE 51 "OpenSSL/Stack.hsc" #-}

mapStack :: (Ptr a -> IO b) -> Ptr STACK -> IO [b]
mapStack :: forall a b. (Ptr a -> IO b) -> Ptr STACK -> IO [b]
mapStack Ptr a -> IO b
m Ptr STACK
st
    = do CInt
num <- Ptr STACK -> IO CInt
skNum Ptr STACK
st
         (CInt -> IO b) -> [CInt] -> IO [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ CInt
i -> (Ptr () -> Ptr a) -> IO (Ptr ()) -> IO (Ptr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr () -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr (Ptr STACK -> CInt -> IO (Ptr ())
skValue Ptr STACK
st CInt
i) IO (Ptr a) -> (Ptr a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr a -> IO b
m)
                  ([CInt] -> IO [b]) -> [CInt] -> IO [b]
forall a b. (a -> b) -> a -> b
$ Int -> [CInt] -> [CInt]
forall a. Int -> [a] -> [a]
take (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
num) [CInt
0..]


newStack :: [Ptr a] -> IO (Ptr STACK)
newStack :: forall a. [Ptr a] -> IO (Ptr STACK)
newStack [Ptr a]
values
    = do Ptr STACK
st <- IO (Ptr STACK)
skNewNull
         (Ptr a -> IO ()) -> [Ptr a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ptr STACK -> Ptr () -> IO ()
skPush Ptr STACK
st (Ptr () -> IO ()) -> (Ptr a -> Ptr ()) -> Ptr a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr) [Ptr a]
values
         Ptr STACK -> IO (Ptr STACK)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr STACK
st


withStack :: [Ptr a] -> (Ptr STACK -> IO b) -> IO b
withStack :: forall a b. [Ptr a] -> (Ptr STACK -> IO b) -> IO b
withStack [Ptr a]
values
    = IO (Ptr STACK)
-> (Ptr STACK -> IO ()) -> (Ptr STACK -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ([Ptr a] -> IO (Ptr STACK)
forall a. [Ptr a] -> IO (Ptr STACK)
newStack [Ptr a]
values) Ptr STACK -> IO ()
skFree


withForeignStack :: (fp -> Ptr obj)
                 -> (fp -> IO ())
                 -> [fp]
                 -> (Ptr STACK -> IO ret)
                 -> IO ret
withForeignStack :: forall fp obj ret.
(fp -> Ptr obj)
-> (fp -> IO ()) -> [fp] -> (Ptr STACK -> IO ret) -> IO ret
withForeignStack fp -> Ptr obj
unsafeFpToPtr fp -> IO ()
touchFp [fp]
fps Ptr STACK -> IO ret
action
    = do ret
ret <- [Ptr obj] -> (Ptr STACK -> IO ret) -> IO ret
forall a b. [Ptr a] -> (Ptr STACK -> IO b) -> IO b
withStack ((fp -> Ptr obj) -> [fp] -> [Ptr obj]
forall a b. (a -> b) -> [a] -> [b]
map fp -> Ptr obj
unsafeFpToPtr [fp]
fps) Ptr STACK -> IO ret
action
         (fp -> IO ()) -> [fp] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ fp -> IO ()
touchFp [fp]
fps
         ret -> IO ret
forall (m :: * -> *) a. Monad m => a -> m a
return ret
ret