{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, CPP #-}
--------------------------------------------------------------------
-- |
-- Module    : Network.Curl.Types
-- Copyright : (c) Galois Inc 2007-2009
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@galois.com>
-- Stability : provisional
-- Portability: portable
--
-- Basic set of types for the Haskell curl binding, including the
-- @Curl@ handle type which holds the C library stateful connection
-- handle along with a set of cleanup actions tht should be performed
-- upon shutting down the curl session.
--
--------------------------------------------------------------------
module Network.Curl.Types
  ( CurlH, URLString, Port, Long, LLong, Slist_ 
  , Curl, curlPrim, mkCurl, mkCurlWithCleanup
  , OptionMap, shareCleanup, runCleanup, updateCleanup
  ) where

import Network.Curl.Debug

import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Concurrent ( addForeignPtrFinalizer )
import Data.Word
import Control.Concurrent
import Data.Maybe(fromMaybe)
import qualified Data.IntMap as M
import Data.IORef
-- import System.IO

data Curl_
type CurlH    = Ptr Curl_

type URLString = String
type Port = Long
type Long = Word32
type LLong = Word64
data Slist_


data Curl = Curl 
  { Curl -> MVar (ForeignPtr Curl_)
curlH       :: MVar (ForeignPtr Curl_)  -- libcurl is not thread-safe.
  , Curl -> IORef OptionMap
curlCleanup :: IORef OptionMap          -- deallocate Haskell curl data 
  }  


-- | Execute a "primitve" curl operation.
-- NOTE: See warnings about the use of 'withForeginPtr'.
curlPrim :: Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim :: forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim Curl
c IORef OptionMap -> CurlH -> IO a
f  = MVar (ForeignPtr Curl_) -> (ForeignPtr Curl_ -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Curl -> MVar (ForeignPtr Curl_)
curlH Curl
c) ((ForeignPtr Curl_ -> IO a) -> IO a)
-> (ForeignPtr Curl_ -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ ForeignPtr Curl_
h ->
                ForeignPtr Curl_ -> (CurlH -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Curl_
h   ((CurlH -> IO a) -> IO a) -> (CurlH -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ IORef OptionMap -> CurlH -> IO a
f (IORef OptionMap -> CurlH -> IO a)
-> IORef OptionMap -> CurlH -> IO a
forall a b. (a -> b) -> a -> b
$ Curl -> IORef OptionMap
curlCleanup Curl
c


-- | Allocates a Haskell handle from a C handle.
mkCurl :: CurlH -> IO Curl
mkCurl :: CurlH -> IO Curl
mkCurl CurlH
h = CurlH -> OptionMap -> IO Curl
mkCurlWithCleanup CurlH
h OptionMap
om_empty

-- | Allocates a Haskell handle from a C handle.
mkCurlWithCleanup :: CurlH -> OptionMap -> IO Curl
mkCurlWithCleanup :: CurlH -> OptionMap -> IO Curl
mkCurlWithCleanup CurlH
h OptionMap
clean = do
  String -> IO ()
debug String
"ALLOC: CURL"
  IORef OptionMap
v2  <- OptionMap -> IO (IORef OptionMap)
forall a. a -> IO (IORef a)
newIORef OptionMap
clean
  ForeignPtr Curl_
fh  <- CurlH -> IO (ForeignPtr Curl_)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ CurlH
h 
  MVar (ForeignPtr Curl_)
v1  <- ForeignPtr Curl_ -> IO (MVar (ForeignPtr Curl_))
forall a. a -> IO (MVar a)
newMVar ForeignPtr Curl_
fh
  let new_h :: Curl
new_h = Curl :: MVar (ForeignPtr Curl_) -> IORef OptionMap -> Curl
Curl { curlH :: MVar (ForeignPtr Curl_)
curlH = MVar (ForeignPtr Curl_)
v1, curlCleanup :: IORef OptionMap
curlCleanup = IORef OptionMap
v2 }
  
  let fnalizr :: IO ()
fnalizr = do
         String -> IO ()
debug String
"FREE: CURL"
         CurlH -> IO ()
easy_cleanup CurlH
h
         IORef OptionMap -> IO ()
runCleanup IORef OptionMap
v2
  ForeignPtr Curl_ -> IO () -> IO ()
forall a. ForeignPtr a -> IO () -> IO ()
Foreign.Concurrent.addForeignPtrFinalizer ForeignPtr Curl_
fh IO ()
fnalizr
  Curl -> IO Curl
forall (m :: * -> *) a. Monad m => a -> m a
return Curl
new_h


-- Admin code for cleaning up marshalled data.
-- Note that these functions assume that they are running atomically,
-- so access to them should be protected by a lock.
--------------------------------------------------------------------------------
runCleanup     :: IORef OptionMap -> IO ()
runCleanup :: IORef OptionMap -> IO ()
runCleanup IORef OptionMap
r    = do OptionMap
m <- IORef OptionMap -> IO OptionMap
forall a. IORef a -> IO a
readIORef IORef OptionMap
r
                     OptionMap -> IO ()
om_cleanup OptionMap
m
                     IORef OptionMap -> OptionMap -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef OptionMap
r OptionMap
om_empty 

shareCleanup  :: IORef OptionMap -> IO OptionMap
shareCleanup :: IORef OptionMap -> IO OptionMap
shareCleanup IORef OptionMap
r  = do OptionMap
old <- IORef OptionMap -> IO OptionMap
forall a. IORef a -> IO a
readIORef IORef OptionMap
r
                     OptionMap
new <- OptionMap -> IO OptionMap
om_dup OptionMap
old
                     IORef OptionMap -> OptionMap -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef OptionMap
r OptionMap
new
                     OptionMap -> IO OptionMap
forall (m :: * -> *) a. Monad m => a -> m a
return OptionMap
new

updateCleanup :: IORef OptionMap -> Int -> IO () -> IO ()
updateCleanup :: IORef OptionMap -> Int -> IO () -> IO ()
updateCleanup IORef OptionMap
r Int
option IO ()
act = IORef OptionMap -> OptionMap -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef OptionMap
r (OptionMap -> IO ()) -> IO OptionMap -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO () -> OptionMap -> IO OptionMap
om_set Int
option IO ()
act (OptionMap -> IO OptionMap) -> IO OptionMap -> IO OptionMap
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef OptionMap -> IO OptionMap
forall a. IORef a -> IO a
readIORef IORef OptionMap
r



-- Maps that associate curl options with IO actions to
-- perform cleanup for them.
--------------------------------------------------------------------------------
type OptionMap = M.IntMap (IO ())

-- | An empty option map.
om_empty :: OptionMap
om_empty :: OptionMap
om_empty = OptionMap
forall a. IntMap a
M.empty

-- | Set the IO action for an option,
-- executing the previvous action, if there was one.
om_set :: Int -> IO () -> OptionMap -> IO OptionMap
om_set :: Int -> IO () -> OptionMap -> IO OptionMap
om_set Int
opt IO ()
new_act OptionMap
old_map = 
  do IO () -> Maybe (IO ()) -> IO ()
forall a. a -> Maybe a -> a
fromMaybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (IO ())
old_act
     OptionMap -> IO OptionMap
forall (m :: * -> *) a. Monad m => a -> m a
return OptionMap
new_map
  where
  (Maybe (IO ())
old_act,OptionMap
new_map) = (Int -> IO () -> IO () -> IO ())
-> Int -> IO () -> OptionMap -> (Maybe (IO ()), OptionMap)
forall a.
(Int -> a -> a -> a) -> Int -> a -> IntMap a -> (Maybe a, IntMap a)
M.insertLookupWithKey (\Int
_ IO ()
a IO ()
_ -> IO ()
a) Int
opt IO ()
new_act OptionMap
old_map

-- | Execute all IO actions in the map.
om_cleanup :: OptionMap -> IO ()
om_cleanup :: OptionMap -> IO ()
om_cleanup OptionMap
m = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (OptionMap -> [IO ()]
forall a. IntMap a -> [a]
M.elems OptionMap
m)

-- | Replace the actions in a map, with actions that
-- will only be executed the second time they are invoked.
om_dup :: OptionMap -> IO OptionMap
om_dup :: OptionMap -> IO OptionMap
om_dup OptionMap
old_map = [(Int, IO ())] -> OptionMap
forall a. [(Int, a)] -> IntMap a
M.fromList ([(Int, IO ())] -> OptionMap) -> IO [(Int, IO ())] -> IO OptionMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ((Int, IO ()) -> IO (Int, IO ()))
-> [(Int, IO ())] -> IO [(Int, IO ())]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, IO ()) -> IO (Int, IO ())
forall {a}. (a, IO ()) -> IO (a, IO ())
dup (OptionMap -> [(Int, IO ())]
forall a. IntMap a -> [(Int, a)]
M.assocs OptionMap
old_map)
  where dup :: (a, IO ()) -> IO (a, IO ())
dup (a
x,IO ()
old_io)  = do IO ()
new_io <- IO () -> IO (IO ())
shareIO IO ()
old_io
                             (a, IO ()) -> IO (a, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,IO ()
new_io)

-- Share a cleanup action.  When we share cleanup duty between two handles
-- we need to ensure that the first handle to perform the cleanup will do
-- nothing (because the other handle still needs the resources).
shareIO :: IO () -> IO (IO ())
shareIO :: IO () -> IO (IO ())
shareIO IO ()
act = 
  do MVar Bool
v <- Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
newMVar Bool
False
     let new_act :: IO ()
new_act = do Bool
b <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
v
                      if Bool
b then IO ()
act else MVar Bool -> Bool -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Bool
v Bool
True
     IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return IO ()
new_act
--------------------------------------------------------------------------------

{- UNUSED:
-- FFI for inalizers.

-- | Make a finalizer from an IO action.
mkIOfin :: IO a -> IO (FinalizerPtr b)
mkIOfin m = mfix (\ptr -> ioFinalizer (m >> freeHaskellFunPtr ptr))

foreign import ccall "wrapper"
  ioFinalizer :: IO () -> IO (FinalizerPtr a)


-}

foreign import ccall 
  "curl/curl.h curl_easy_cleanup" easy_cleanup :: CurlH -> IO ()