    {-# LANGUAGE ForeignFunctionInterface #-}
    --------------------------------------------------------------------
    -- |
    -- Module    : Network.Curl.Easy
    -- Copyright : (c) Galois Inc 2007-2009
    -- License   :
    --
    -- Maintainer: Sigbjorn Finne <sof@galois.com>
    -- Stability : provisional
    -- Portability: portable
    --
    -- Haskell binding to the libcurl <http://curl.haxx.se/> \"easy\" API.
    -- The \"easy\" API provides a higher-level, easy-to-get-started calling
    -- interface to the library's wide range of features for interacting
    -- with HTTP\/FTP\/etc servers.
    --
    --------------------------------------------------------------------
    module Network.Curl.Easy
            ( initialize    -- :: IO Curl
            , perform       -- :: Curl -> IO CurlCode
            , setopt        -- :: Curl -> CurlOption -> IO CurlCode
            , duphandle     -- :: Curl -> IO Curl
            , reset         -- :: Curl -> IO ()

            , curl_global_init    -- :: CInt -> IO CurlCode
            , curl_global_cleanup -- :: IO ()

    	, curl_version_number -- :: IO Int
    	, curl_version_string -- :: IO String
            ) where

    import Network.Curl.Types
    import Network.Curl.Opts
    import Network.Curl.Code
    import Network.Curl.Post

    import Network.Curl.Debug

    import Data.IORef(IORef)
    import Foreign.Ptr
    import Foreign.Marshal.Alloc(free)
    import Foreign.C.Types
    import Foreign.C.String
    import Control.Monad
    import Data.Maybe

    -- | Initialise a curl instance
    initialize :: IO Curl
    initialize :: IO Curl
    initialize = do
      h <- IO CurlH
    easy_initialize
      mkCurl h

    -- XXX: Is running cleanup here OK?
    reset :: Curl -> IO ()
    reset :: Curl -> IO ()
    reset Curl
    hh = Curl -> (IORef OptionMap -> CurlH -> IO ()) -> IO ()
    forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
    curlPrim Curl
    hh ((IORef OptionMap -> CurlH -> IO ()) -> IO ())
    -> (IORef OptionMap -> CurlH -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \IORef OptionMap
    r CurlH
    h -> CurlH -> IO ()
    easy_reset CurlH
    h IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IORef OptionMap -> IO ()
    runCleanup IORef OptionMap
    r

    duphandle :: Curl -> IO Curl
    duphandle :: Curl -> IO Curl
    duphandle Curl
    hh = Curl -> (IORef OptionMap -> CurlH -> IO Curl) -> IO Curl
    forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
    curlPrim Curl
    hh ((IORef OptionMap -> CurlH -> IO Curl) -> IO Curl)
    -> (IORef OptionMap -> CurlH -> IO Curl) -> IO Curl
    forall a b. (a -> b) -> a -> b
    $ \IORef OptionMap
    r CurlH
    h ->
      do h1      <- CurlH -> IO CurlH
    easy_duphandle CurlH
    h
         cleanup <- shareCleanup r
         mkCurlWithCleanup h1 cleanup

    setopt :: Curl
           -> CurlOption
           -> IO CurlCode
    setopt :: Curl -> CurlOption -> IO CurlCode
    setopt Curl
    hh CurlOption
    o = Curl -> (IORef OptionMap -> CurlH -> IO CurlCode) -> IO CurlCode
    forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
    curlPrim Curl
    hh ((IORef OptionMap -> CurlH -> IO CurlCode) -> IO CurlCode)
    -> (IORef OptionMap -> CurlH -> IO CurlCode) -> IO CurlCode
    forall a b. (a -> b) -> a -> b
    $ \ IORef OptionMap
    r CurlH
    h -> Unmarshaller CurlCode -> CurlOption -> IO CurlCode
    forall a. Unmarshaller a -> CurlOption -> IO a
    unmarshallOption (IORef OptionMap -> CurlH -> Unmarshaller CurlCode
    easy_um IORef OptionMap
    r CurlH
    h) CurlOption
    o
     where
      easy_um :: IORef OptionMap -> CurlH -> Unmarshaller CurlCode
      easy_um :: IORef OptionMap -> CurlH -> Unmarshaller CurlCode
    easy_um IORef OptionMap
    r CurlH
    h =
        Unmarshaller
        { u_long :: Int -> Long -> IO CurlCode
    u_long    -- :: Int -> Long     -> IO CurlCode
           = \ Int
    i Long
    x -> (CInt -> CurlCode) -> IO CInt -> IO CurlCode
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CInt -> CurlCode
    toCode (IO CInt -> IO CurlCode) -> IO CInt -> IO CurlCode
    forall a b. (a -> b) -> a -> b
    $ CurlH -> Int -> Long -> IO CInt
    easy_setopt_long CurlH
    h Int
    i Long
    x
        , u_llong :: Int -> LLong -> IO CurlCode
    u_llong   --  :: Int -> LLong    -> IO CurlCode
           = \ Int
    i LLong
    x -> (CInt -> CurlCode) -> IO CInt -> IO CurlCode
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CInt -> CurlCode
    toCode (IO CInt -> IO CurlCode) -> IO CInt -> IO CurlCode
    forall a b. (a -> b) -> a -> b
    $ CurlH -> Int -> LLong -> IO CInt
    easy_setopt_llong CurlH
    h Int
    i LLong
    x

        , u_string :: Int -> String -> IO CurlCode
    u_string  -- :: Int -> String   -> IO CurlCode
           = \ Int
    i String
    x -> do String -> IO ()
    debug (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "ALLOC: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x
                         c_x <- String -> IO CString
    newCString String
    x
                         updateCleanup r i $ debug ("FREE: "++ x) >> free c_x
                         liftM toCode $ easy_setopt_string h i c_x

        , u_strings :: Int -> [String] -> IO CurlCode
    u_strings -- :: Int -> [String] -> IO CurlCode
           = \ Int
    i [String]
    x ->
               do String -> IO ()
    debug (String
    "ALLOC: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    forall a. Show a => a -> String
    show [String]
    x)
                  -- curl_slist_append will copy its string argument
                  let addOne :: Ptr Slist_ -> String -> IO (Ptr Slist_)
    addOne Ptr Slist_
    ip String
    s = String -> (CString -> IO (Ptr Slist_)) -> IO (Ptr Slist_)
    forall a. String -> (CString -> IO a) -> IO a
    withCString String
    s ((CString -> IO (Ptr Slist_)) -> IO (Ptr Slist_))
    -> (CString -> IO (Ptr Slist_)) -> IO (Ptr Slist_)
    forall a b. (a -> b) -> a -> b
    $ Ptr Slist_ -> CString -> IO (Ptr Slist_)
    curl_slist_append Ptr Slist_
    ip
                  ip <- (Ptr Slist_ -> String -> IO (Ptr Slist_))
    -> Ptr Slist_ -> [String] -> IO (Ptr Slist_)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Ptr Slist_ -> String -> IO (Ptr Slist_)
    addOne Ptr Slist_
    forall a. Ptr a
    nullPtr [String]
    x
                  updateCleanup r i $
                    debug ("FREE: " ++ show x) >> curl_slist_free ip
                  liftM toCode $ easy_setopt_string h i (castPtr ip)
         , u_ptr :: Int -> Ptr () -> IO CurlCode
    u_ptr    -- :: Int -> Ptr ()   -> IO a
           = \ Int
    i Ptr ()
    x -> (CInt -> CurlCode) -> IO CInt -> IO CurlCode
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CInt -> CurlCode
    toCode (IO CInt -> IO CurlCode) -> IO CInt -> IO CurlCode
    forall a b. (a -> b) -> a -> b
    $ CurlH -> Int -> Ptr () -> IO CInt
    forall a. CurlH -> Int -> Ptr a -> IO CInt
    easy_setopt_ptr CurlH
    h Int
    i Ptr ()
    x
         , u_writeFun :: Int -> WriteFunction -> IO CurlCode
    u_writeFun -- :: Int -> WriteFunction -> IO a
           = \ Int
    i WriteFunction
    x -> do
                String -> IO ()
    debug String
    "ALLOC: WRITER"
                fp <- WriteFunction -> IO (FunPtr WriteFunction)
    mkWriter WriteFunction
    x
                updateCleanup r i $ debug "FREE: WRITER" >> freeHaskellFunPtr fp
                liftM toCode $ easy_setopt_wfun h i fp
         , u_readFun :: Int -> ReadFunction -> IO CurlCode
    u_readFun -- :: Int -> ReadFunction -> IO a
           = \ Int
    i ReadFunction
    x -> do
                let wrapResult :: (t -> t -> t -> t -> m (Maybe CInt)) -> t -> t -> t -> t -> m CInt
    wrapResult t -> t -> t -> t -> m (Maybe CInt)
    f t
    a t
    b t
    c t
    d = do
                         mb <- t -> t -> t -> t -> m (Maybe CInt)
    f t
    a t
    b t
    c t
    d
                         return (fromMaybe curl_readfunc_abort mb)
                String -> IO ()
    debug String
    "ALLOC: READER"
                fp <- WriteFunction -> IO (FunPtr WriteFunction)
    mkReader (ReadFunction -> WriteFunction
    forall {m :: * -> *} {t} {t} {t} {t}.
    Monad m =>
    (t -> t -> t -> t -> m (Maybe CInt)) -> t -> t -> t -> t -> m CInt
    wrapResult ReadFunction
    x)
                updateCleanup r i $ debug "FREE: READER" >> freeHaskellFunPtr fp
                liftM toCode $ easy_setopt_rfun h i fp
         , u_progressFun :: Int -> ProgressFunction -> IO CurlCode
    u_progressFun -- :: Int -> ProgressFunction -> IO a
           = \ Int
    i ProgressFunction
    x -> do
                String -> IO ()
    debug String
    "ALLOC: PROGRESS"
                fp <- ProgressFunction -> IO (FunPtr ProgressFunction)
    mkProgress ProgressFunction
    x
                updateCleanup r i $ debug "FREE: PROGRESS" >> freeHaskellFunPtr fp
                liftM toCode $ easy_setopt_fptr h i fp
         , u_debugFun :: Int -> DebugFunction -> IO CurlCode
    u_debugFun -- :: Int -> DebugFunction -> IO a
           = \ Int
    i DebugFunction
    debFun -> do
                let wrapFun :: (Curl -> t -> t -> t -> t -> m a) -> p -> a -> t -> t -> t -> m b
    wrapFun Curl -> t -> t -> t -> t -> m a
    fun p
    _a a
    b t
    c t
    d t
    e =
                      Curl -> t -> t -> t -> t -> m a
    fun Curl
    hh (Int -> t
    forall a. Enum a => Int -> a
    toEnum (a -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    b)) t
    c t
    d t
    e m a -> m b -> m b
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> b -> m b
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    0
                String -> IO ()
    debug String
    "ALLOC: DEBUG"
                fp <- DebugFunctionPrim -> IO (FunPtr DebugFunctionPrim)
    mkDebugFun (DebugFunction -> DebugFunctionPrim
    forall {m :: * -> *} {a} {b} {t} {t} {t} {t} {a} {p}.
    (Monad m, Integral a, Num b, Enum t) =>
    (Curl -> t -> t -> t -> t -> m a) -> p -> a -> t -> t -> t -> m b
    wrapFun DebugFunction
    debFun)
                updateCleanup r i $ debug "FREE: DEBUG" >> freeHaskellFunPtr fp
                liftM toCode $ easy_setopt_fptr h i fp
         , u_posts :: Int -> [HttpPost] -> IO CurlCode
    u_posts    -- :: Int -> [HttpPost] -> IO a
           = \ Int
    i [HttpPost]
    x -> do
               String -> IO ()
    debug String
    "ALLOC: POSTS"
               p <- [HttpPost] -> IO (Ptr HttpPost)
    marshallPosts [HttpPost]
    x
               updateCleanup r i $ debug "FREE: POSTS" >> curl_formfree p
               liftM toCode $ easy_setopt_ptr h i p
         , u_sslctxt :: Int -> SSLCtxtFunction -> IO CurlCode
    u_sslctxt  -- :: Int -> SSLCtxtFunction -> IO a
           = \ Int
    i SSLCtxtFunction
    x -> do
               String -> IO ()
    debug String
    "ALLOC: SSL_FUN"
               p <- SSLCtxtFunction -> IO (FunPtr SSLCtxtFunction)
    mkSslCtxtFun SSLCtxtFunction
    x
               updateCleanup r i $ debug "FREE: SSL_FUN" >> freeHaskellFunPtr p
               liftM toCode $ easy_setopt_fptr h i p
         , u_ioctl_fun :: Int -> Ptr () -> IO CurlCode
    u_ioctl_fun -- :: Int -> Ptr () -> IO a
           = \ Int
    i Ptr ()
    x -> (CInt -> CurlCode) -> IO CInt -> IO CurlCode
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CInt -> CurlCode
    toCode (IO CInt -> IO CurlCode) -> IO CInt -> IO CurlCode
    forall a b. (a -> b) -> a -> b
    $ CurlH -> Int -> Ptr () -> IO CInt
    forall a. CurlH -> Int -> Ptr a -> IO CInt
    easy_setopt_ptr CurlH
    h Int
    i Ptr ()
    x
         , u_convFromNetwork :: Int -> Ptr () -> IO CurlCode
    u_convFromNetwork -- :: Int -> Ptr () -> IO a
           = \ Int
    i Ptr ()
    x -> (CInt -> CurlCode) -> IO CInt -> IO CurlCode
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CInt -> CurlCode
    toCode (IO CInt -> IO CurlCode) -> IO CInt -> IO CurlCode
    forall a b. (a -> b) -> a -> b
    $ CurlH -> Int -> Ptr () -> IO CInt
    forall a. CurlH -> Int -> Ptr a -> IO CInt
    easy_setopt_ptr CurlH
    h Int
    i Ptr ()
    x
         , u_convToNetwork :: Int -> Ptr () -> IO CurlCode
    u_convToNetwork -- :: Int -> Ptr () -> IO a
           = \ Int
    i Ptr ()
    x -> (CInt -> CurlCode) -> IO CInt -> IO CurlCode
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CInt -> CurlCode
    toCode (IO CInt -> IO CurlCode) -> IO CInt -> IO CurlCode
    forall a b. (a -> b) -> a -> b
    $ CurlH -> Int -> Ptr () -> IO CInt
    forall a. CurlH -> Int -> Ptr a -> IO CInt
    easy_setopt_ptr CurlH
    h Int
    i Ptr ()
    x
         , u_convFromUtf8 :: Int -> Ptr () -> IO CurlCode
    u_convFromUtf8 -- :: Int -> Ptr () -> IO a
           = \ Int
    i Ptr ()
    x -> (CInt -> CurlCode) -> IO CInt -> IO CurlCode
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CInt -> CurlCode
    toCode (IO CInt -> IO CurlCode) -> IO CInt -> IO CurlCode
    forall a b. (a -> b) -> a -> b
    $ CurlH -> Int -> Ptr () -> IO CInt
    forall a. CurlH -> Int -> Ptr a -> IO CInt
    easy_setopt_ptr CurlH
    h Int
    i Ptr ()
    x
         , u_sockoptFun :: Int -> Ptr () -> IO CurlCode
    u_sockoptFun  -- :: Int -> Ptr () -> IO a
           = \ Int
    i Ptr ()
    x -> (CInt -> CurlCode) -> IO CInt -> IO CurlCode
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CInt -> CurlCode
    toCode (IO CInt -> IO CurlCode) -> IO CInt -> IO CurlCode
    forall a b. (a -> b) -> a -> b
    $ CurlH -> Int -> Ptr () -> IO CInt
    forall a. CurlH -> Int -> Ptr a -> IO CInt
    easy_setopt_ptr CurlH
    h Int
    i Ptr ()
    x
         }

    perform :: Curl -> IO CurlCode
    perform :: Curl -> IO CurlCode
    perform Curl
    hh = (CInt -> CurlCode) -> IO CInt -> IO CurlCode
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CInt -> CurlCode
    toCode (IO CInt -> IO CurlCode) -> IO CInt -> IO CurlCode
    forall a b. (a -> b) -> a -> b
    $ Curl -> (IORef OptionMap -> CurlH -> IO CInt) -> IO CInt
    forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
    curlPrim Curl
    hh ((IORef OptionMap -> CurlH -> IO CInt) -> IO CInt)
    -> (IORef OptionMap -> CurlH -> IO CInt) -> IO CInt
    forall a b. (a -> b) -> a -> b
    $ \IORef OptionMap
    _ CurlH
    h -> CurlH -> IO CInt
    easy_perform_prim CurlH
    h

    curl_global_init :: CInt -> IO CurlCode
    curl_global_init :: CInt -> IO CurlCode
    curl_global_init CInt
    v = (CInt -> CurlCode) -> IO CInt -> IO CurlCode
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CInt -> CurlCode
    toCode (IO CInt -> IO CurlCode) -> IO CInt -> IO CurlCode
    forall a b. (a -> b) -> a -> b
    $ CInt -> IO CInt
    curl_global_init_prim CInt
    v

    curl_version_number :: IO Int
    curl_version_number :: IO Int
    curl_version_number = do
      x <- IO CInt
    curl_version_num
      return (fromIntegral x)

    curl_version_string :: IO String
    curl_version_string :: IO String
    curl_version_string = do
      cs <- IO CString
    curl_version_str
      peekCString cs

    -- FFI decls

    foreign import ccall
      "curl_version_num" curl_version_num :: IO CInt

    foreign import ccall
      "curl_version_str" curl_version_str :: IO CString

    foreign import ccall
      "curl/easy.h curl_global_init" curl_global_init_prim :: CInt -> IO CInt

    foreign import ccall
      "curl/easy.h curl_global_cleanup" curl_global_cleanup :: IO ()

    foreign import ccall
      "curl/easy.h curl_easy_init" easy_initialize :: IO CurlH

    foreign import ccall
      "curl/easy.h curl_easy_perform" easy_perform_prim :: CurlH -> IO CInt

    foreign import ccall
      "curl_easy_duphandle" easy_duphandle :: CurlH -> IO CurlH

    foreign import ccall
      "curl_easy_reset" easy_reset :: CurlH -> IO ()

    foreign import ccall
      "curl_easy_setopt_long" easy_setopt_long :: CurlH -> Int -> Long -> IO CInt

    foreign import ccall
      "curl_easy_setopt_longlong" easy_setopt_llong :: CurlH -> Int -> LLong -> IO CInt

    foreign import ccall
      "curl_easy_setopt_string" easy_setopt_string :: CurlH -> Int -> Ptr CChar -> IO CInt

    foreign import ccall
      "curl_easy_setopt_ptr" easy_setopt_ptr :: CurlH -> Int -> Ptr a -> IO CInt

    foreign import ccall
      "curl_easy_setopt_ptr" easy_setopt_fptr :: CurlH -> Int -> FunPtr a -> IO CInt

    foreign import ccall
      "curl_easy_setopt_ptr" easy_setopt_wfun :: CurlH -> Int -> FunPtr WriteFunction -> IO CInt

    foreign import ccall
      "curl_easy_setopt_ptr" easy_setopt_rfun :: CurlH -> Int -> FunPtr ReadFunctionPrim -> IO CInt

    foreign import ccall "wrapper"
       mkWriter :: WriteFunction -> IO (FunPtr WriteFunction)

    foreign import ccall "wrapper"
       mkReader :: ReadFunctionPrim -> IO (FunPtr ReadFunctionPrim)

    foreign import ccall "wrapper"
       mkProgress :: ProgressFunction -> IO (FunPtr ProgressFunction)

    foreign import ccall "wrapper"
       mkDebugFun :: DebugFunctionPrim -> IO (FunPtr DebugFunctionPrim)

    foreign import ccall "wrapper"
       mkSslCtxtFun :: SSLCtxtFunction -> IO (FunPtr SSLCtxtFunction)