File: Stack.hs

package info (click to toggle)
haskell-hsopenssl 0.11.3.2-3
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 496 kB
  • ctags: 74
  • sloc: haskell: 1,990; ansic: 349; makefile: 16
file content (61 lines) | stat: -rw-r--r-- 1,470 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module OpenSSL.Stack
    ( STACK
    , mapStack
    , withStack
    , withForeignStack
    )
    where
import           Control.Exception
import           Foreign
import           Foreign.C


data STACK


foreign import ccall unsafe "sk_new_null"
        skNewNull :: IO (Ptr STACK)

foreign import ccall unsafe "sk_free"
        skFree :: Ptr STACK -> IO ()

foreign import ccall unsafe "sk_push"
        skPush :: Ptr STACK -> Ptr () -> IO ()

foreign import ccall unsafe "sk_num"
        skNum :: Ptr STACK -> IO CInt

foreign import ccall unsafe "sk_value"
        skValue :: Ptr STACK -> CInt -> IO (Ptr ())


mapStack :: (Ptr a -> IO b) -> Ptr STACK -> IO [b]
mapStack m st
    = do num <- skNum st
         mapM (\ i -> fmap castPtr (skValue st i) >>= m)
                  $ take (fromIntegral num) [0..]


newStack :: [Ptr a] -> IO (Ptr STACK)
newStack values
    = do st <- skNewNull
         mapM_ (skPush st . castPtr) values
         return st


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


withForeignStack :: (fp -> Ptr obj)
                 -> (fp -> IO ())
                 -> [fp]
                 -> (Ptr STACK -> IO ret)
                 -> IO ret
withForeignStack unsafeFpToPtr touchFp fps action
    = do ret <- withStack (map unsafeFpToPtr fps) action
         mapM_ touchFp fps
         return ret