{-# 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 num <- Ptr STACK -> IO CInt
skNum Ptr STACK
st
         mapM (\ CInt
i -> (Ptr () -> Ptr a) -> IO (Ptr ()) -> IO (Ptr a)
forall a b. (a -> b) -> IO a -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr a -> IO b
m)
                  $ take (fromIntegral num) [0..]


newStack :: [Ptr a] -> IO (Ptr STACK)
newStack :: forall a. [Ptr a] -> IO (Ptr STACK)
newStack [Ptr a]
values
    = do st <- IO (Ptr STACK)
skNewNull
         mapM_ (skPush st . castPtr) values
         return 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 <- [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
         mapM_ touchFp fps
         return ret