{-# LANGUAGE TypeSynonymInstances   #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
--------------------------------------------------------------------
-- |
-- Module    : Network.Curl
-- Copyright : (c) 2007-2009, Galois Inc 
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@galois.com>
-- Stability : provisional
-- Portability: portable
--
-- A Haskell binding the libcurl library <http://curl.haxx.se/>, a
-- proven and feature-rich library for interacting with HTTP(S)\/FTP
-- servers.
--
-- The binding was initially made against version 7.16.2; libcurl does
-- appear to be considerate in not introducing breaking changes wrt
-- older versions. So, unless you're after the latest features (i.e.,
-- constructors towards the end the Option type), there's a very good
-- chance your code will work against older installations of libcurl.
--
--------------------------------------------------------------------

module Network.Curl
       ( module Network.Curl.Opts
       , module Network.Curl.Easy
       , module Network.Curl.Post
       , module Network.Curl.Info
       , module Network.Curl.Types
       , module Network.Curl.Code

         -- controlled export of this module: 
         -- (ToDo: tighten it up even more)
       , withCurlDo          -- :: IO a -> IO a
       , setopts             -- :: Curl -> [CurlOption] -> IO ()

       , CurlResponse_(..)
       , CurlResponse

          -- get resources and assoc. metadata.
       , curlGet               -- :: URLString -> [CurlOption] -> IO ()
       , curlGetString         -- :: URLString -> [CurlOption] -> IO (CurlCode, String)
       , curlGetResponse       -- :: URLString -> [CurlOption] -> IO CurlResponse
       , perform_with_response -- :: Curl -> IO CurlResponse
       , do_curl        -- :: Curl -> URLString -> [CurlOption] -> IO CurlResponse

       , curlGetString_         -- :: CurlBuffer ty => URLString -> [CurlOption] -> IO (CurlCode, ty)
       , curlGetResponse_       -- :: URLString -> [CurlOption] -> IO (CurlResponse_ a b)
       , perform_with_response_ -- :: Curl -> IO (CurlResponse_ a b)
       , do_curl_               -- :: Curl -> URLString -> [CurlOption] -> IO (CurlResponse_ a b)
       , curlHead_              -- :: URLString
                                -- -> [CurlOption]
                                -- -> IO (String,ty)

          -- probing for gold..
       , curlHead            -- :: URLString
                             -- -> [CurlOption]
                             -- -> IO (String,[(String,String)])

          -- posting requests.
       , curlMultiPost       -- :: URLString -> [CurlOption] -> [HttpPost] -> IO ()
       , curlPost            -- :: URLString -> [String] -> IO ()

          -- 
       , getResponseCode     -- :: Curl -> IO Int

          -- supporting cast
       , setDefaultSSLOpts   -- :: Curl -> URLString -> IO ()
       , callbackWriter      -- :: (String -> IO ()) -> WriteFunction
       , easyWriter          -- :: (String -> IO ()) -> WriteFunction
       , ignoreOutput        -- :: WriteFunction
       , gatherOutput        -- :: IORef [String] -> WriteFunction

       , gatherOutput_      -- :: (CStringLen -> IO ()) -> WriteFunction
       , CurlBuffer(..)
       , CurlHeader(..)

       , method_GET          -- :: [CurlOption]
       , method_HEAD         -- :: [CurlOption]
       , method_POST         -- :: [CurlOption]

       , parseStatusNHeaders
       , parseHeader
          -- ToDo: get rid of (pretty sure I can already...)
       , concRev
       ) where

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

import Foreign.C.String
import Data.IORef
import Data.List(isPrefixOf)
-- import System.IO
import Control.Exception ( finally )

import Data.ByteString ( ByteString, packCStringLen )
import qualified Data.ByteString as BS ( concat )

import qualified Data.ByteString.Lazy as LazyBS ( ByteString, fromChunks )

-- | The @CurlBuffer@ class encodes the representation
-- of response buffers, allowing you to provide your
-- own app-specific buffer reps to be used..or use
-- one of the standard instances (String and ByteStrings.)
--
class CurlBuffer bufferTy where
  newIncoming    :: IO (IO bufferTy, CStringLen -> IO ())
  

-- | The @CurlHeader@ class encodes the representation
-- of response headers. Similar to 'CurlBuffer'.
--
class CurlHeader headerTy where
  newIncomingHeader :: IO (IO (String{-status-},headerTy), CStringLen -> IO ())

instance CurlHeader [(String,String)] where
  newIncomingHeader :: IO (IO (String, [(String, String)]), CStringLen -> IO ())
newIncomingHeader = do
    IORef [String]
ref <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef []
    let readFinalHeader :: IO (String, [(String, String)])
readFinalHeader = do
          [String]
hss <- IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
ref
          let (st :: String
st,hs :: [(String, String)]
hs) = String -> (String, [(String, String)])
parseStatusNHeaders (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
concRev [] [String]
hss)
          (String, [(String, String)]) -> IO (String, [(String, String)])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
st,[(String, String)]
hs)
    (IO (String, [(String, String)]), CStringLen -> IO ())
-> IO (IO (String, [(String, String)]), CStringLen -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO (String, [(String, String)])
readFinalHeader, \ v :: CStringLen
v -> CStringLen -> IO String
peekCStringLen CStringLen
v IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ x :: String
x -> IORef [String] -> ([String] -> [String]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [String]
ref (String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:))

instance CurlBuffer String where
  newIncoming :: IO (IO String, CStringLen -> IO ())
newIncoming = do
    IORef [String]
ref <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef []
    let readFinal :: IO String
readFinal = IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
ref IO [String] -> ([String] -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> ([String] -> String) -> [String] -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse
    (IO String, CStringLen -> IO ())
-> IO (IO String, CStringLen -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO String
readFinal, \ v :: CStringLen
v -> CStringLen -> IO String
peekCStringLen CStringLen
v IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ x :: String
x -> IORef [String] -> ([String] -> [String]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [String]
ref (String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:))

instance CurlBuffer ByteString where
  newIncoming :: IO (IO ByteString, CStringLen -> IO ())
newIncoming = do
    IORef [ByteString]
ref <- [ByteString] -> IO (IORef [ByteString])
forall a. a -> IO (IORef a)
newIORef []
    let readFinal :: IO ByteString
readFinal = IORef [ByteString] -> IO [ByteString]
forall a. IORef a -> IO a
readIORef IORef [ByteString]
ref IO [ByteString] -> ([ByteString] -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse
    (IO ByteString, CStringLen -> IO ())
-> IO (IO ByteString, CStringLen -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO ByteString
readFinal, \ v :: CStringLen
v -> CStringLen -> IO ByteString
packCStringLen CStringLen
v IO ByteString -> (ByteString -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ x :: ByteString
x -> IORef [ByteString] -> ([ByteString] -> [ByteString]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [ByteString]
ref (ByteString
xByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:))

instance CurlBuffer [ByteString] where
  newIncoming :: IO (IO [ByteString], CStringLen -> IO ())
newIncoming = do
    IORef [ByteString]
ref <- [ByteString] -> IO (IORef [ByteString])
forall a. a -> IO (IORef a)
newIORef []
    let readFinal :: IO [ByteString]
readFinal = IORef [ByteString] -> IO [ByteString]
forall a. IORef a -> IO a
readIORef IORef [ByteString]
ref IO [ByteString]
-> ([ByteString] -> IO [ByteString]) -> IO [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> IO [ByteString])
-> ([ByteString] -> [ByteString])
-> [ByteString]
-> IO [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse
    (IO [ByteString], CStringLen -> IO ())
-> IO (IO [ByteString], CStringLen -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO [ByteString]
readFinal, \ v :: CStringLen
v -> CStringLen -> IO ByteString
packCStringLen CStringLen
v IO ByteString -> (ByteString -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ x :: ByteString
x -> IORef [ByteString] -> ([ByteString] -> [ByteString]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [ByteString]
ref (ByteString
xByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:))

instance CurlBuffer LazyBS.ByteString where
  newIncoming :: IO (IO ByteString, CStringLen -> IO ())
newIncoming = do
    IORef [ByteString]
ref <- [ByteString] -> IO (IORef [ByteString])
forall a. a -> IO (IORef a)
newIORef []
    let readFinal :: IO ByteString
readFinal = IORef [ByteString] -> IO [ByteString]
forall a. IORef a -> IO a
readIORef IORef [ByteString]
ref IO [ByteString] -> ([ByteString] -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LazyBS.fromChunks ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse
    (IO ByteString, CStringLen -> IO ())
-> IO (IO ByteString, CStringLen -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO ByteString
readFinal, \ v :: CStringLen
v -> CStringLen -> IO ByteString
packCStringLen CStringLen
v IO ByteString -> (ByteString -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ x :: ByteString
x -> IORef [ByteString] -> ([ByteString] -> [ByteString]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [ByteString]
ref (ByteString
xByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:))

-- | Should be used once to wrap all uses of libcurl.
-- WARNING: the argument should not return before it
-- is completely done with curl (e.g., no forking or lazy returns)
withCurlDo :: IO a -> IO a
withCurlDo :: IO a -> IO a
withCurlDo m :: IO a
m  = do CInt -> IO CurlCode
curl_global_init 3   -- initialize everything
                   IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
finally IO a
m IO ()
curl_global_cleanup

-- | Set a list of options on a Curl handle.
setopts :: Curl -> [CurlOption] -> IO ()
setopts :: Curl -> [CurlOption] -> IO ()
setopts h :: Curl
h opts :: [CurlOption]
opts = (CurlOption -> IO CurlCode) -> [CurlOption] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Curl -> CurlOption -> IO CurlCode
setopt Curl
h) [CurlOption]
opts


method_GET   :: [CurlOption]
method_GET :: [CurlOption]
method_GET    = [Bool -> CurlOption
CurlPost Bool
False, Bool -> CurlOption
CurlNoBody Bool
False]

method_POST  :: [CurlOption]
method_POST :: [CurlOption]
method_POST   = [Bool -> CurlOption
CurlPost Bool
True, Bool -> CurlOption
CurlNoBody Bool
False]

method_HEAD  :: [CurlOption]
method_HEAD :: [CurlOption]
method_HEAD   = [Bool -> CurlOption
CurlPost Bool
False, Bool -> CurlOption
CurlNoBody Bool
True] 

-- | 'curlGet' perform a basic GET, dumping the output on stdout.
-- The list of options are set prior performing the GET request.
curlGet :: URLString -> [CurlOption] -> IO ()
curlGet :: String -> [CurlOption] -> IO ()
curlGet url :: String
url opts :: [CurlOption]
opts = IO Curl
initialize IO Curl -> (Curl -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ h :: Curl
h -> do
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (Bool -> CurlOption
CurlFailOnError Bool
True)
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (String -> CurlOption
CurlURL String
url)
   -- Note: later options may (and should, probably) override these defaults.
  Curl -> String -> IO ()
setDefaultSSLOpts Curl
h String
url
  (CurlOption -> IO CurlCode) -> [CurlOption] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Curl -> CurlOption -> IO CurlCode
setopt Curl
h) [CurlOption]
opts
  Curl -> IO CurlCode
perform Curl
h
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

setDefaultSSLOpts :: Curl -> URLString -> IO ()
setDefaultSSLOpts :: Curl -> String -> IO ()
setDefaultSSLOpts h :: Curl
h url :: String
url
 | "https:" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
url = do
    -- the default options are pretty dire, really -- turning off
    -- the peer verification checks!
   (CurlOption -> IO CurlCode) -> [CurlOption] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Curl -> CurlOption -> IO CurlCode
setopt Curl
h)
         [ Bool -> CurlOption
CurlSSLVerifyPeer Bool
False
         , Long -> CurlOption
CurlSSLVerifyHost 0
         ]
 | Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | 'curlGetString' performs the same request as 'curlGet', but 
-- returns the response body as a Haskell string.
curlGetString :: URLString
              -> [CurlOption]
              -> IO (CurlCode, String)
curlGetString :: String -> [CurlOption] -> IO (CurlCode, String)
curlGetString url :: String
url opts :: [CurlOption]
opts = IO Curl
initialize IO Curl -> (Curl -> IO (CurlCode, String)) -> IO (CurlCode, String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ h :: Curl
h -> do
  IORef [String]
ref <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef []
   -- Note: later options may (and should, probably) override these defaults.
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (Bool -> CurlOption
CurlFailOnError Bool
True)
  Curl -> String -> IO ()
setDefaultSSLOpts Curl
h String
url
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (String -> CurlOption
CurlURL String
url)
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (WriteFunction -> CurlOption
CurlWriteFunction (IORef [String] -> WriteFunction
gatherOutput IORef [String]
ref))
  (CurlOption -> IO CurlCode) -> [CurlOption] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Curl -> CurlOption -> IO CurlCode
setopt Curl
h) [CurlOption]
opts
  CurlCode
rc <- Curl -> IO CurlCode
perform Curl
h
  [String]
lss <- IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
ref
  (CurlCode, String) -> IO (CurlCode, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (CurlCode
rc, [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse [String]
lss)

curlGetString_ :: (CurlBuffer ty)
               => URLString
               -> [CurlOption]
               -> IO (CurlCode, ty)
curlGetString_ :: String -> [CurlOption] -> IO (CurlCode, ty)
curlGetString_ url :: String
url opts :: [CurlOption]
opts = IO Curl
initialize IO Curl -> (Curl -> IO (CurlCode, ty)) -> IO (CurlCode, ty)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ h :: Curl
h -> do
  (finalBody :: IO ty
finalBody, gatherBody :: CStringLen -> IO ()
gatherBody) <- IO (IO ty, CStringLen -> IO ())
forall bufferTy.
CurlBuffer bufferTy =>
IO (IO bufferTy, CStringLen -> IO ())
newIncoming
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (Bool -> CurlOption
CurlFailOnError Bool
True)
  Curl -> String -> IO ()
setDefaultSSLOpts Curl
h String
url
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (String -> CurlOption
CurlURL String
url)
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (WriteFunction -> CurlOption
CurlWriteFunction ((CStringLen -> IO ()) -> WriteFunction
gatherOutput_ CStringLen -> IO ()
gatherBody))
  (CurlOption -> IO CurlCode) -> [CurlOption] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Curl -> CurlOption -> IO CurlCode
setopt Curl
h) [CurlOption]
opts
  CurlCode
rc <- Curl -> IO CurlCode
perform Curl
h
  ty
bs  <- IO ty
finalBody
  (CurlCode, ty) -> IO (CurlCode, ty)
forall (m :: * -> *) a. Monad m => a -> m a
return (CurlCode
rc, ty
bs)

type CurlResponse = CurlResponse_ [(String,String)] String

-- | 'CurlResponse_' is a record type encoding all the information
-- embodied in a response to your Curl request. Currently only used
-- to gather up the results of doing a GET in 'curlGetResponse'.
data CurlResponse_ headerTy bodyTy
 = CurlResponse
     { CurlResponse_ headerTy bodyTy -> CurlCode
respCurlCode   :: CurlCode
     , CurlResponse_ headerTy bodyTy -> Int
respStatus     :: Int
     , CurlResponse_ headerTy bodyTy -> String
respStatusLine :: String
     , CurlResponse_ headerTy bodyTy -> headerTy
respHeaders    :: headerTy
     , CurlResponse_ headerTy bodyTy -> bodyTy
respBody       :: bodyTy
     , CurlResponse_ headerTy bodyTy -> Info -> IO InfoValue
respGetInfo    :: (Info -> IO InfoValue)
     }


-- | @curlGetResponse url opts@ performs a @GET@, returning all the info
-- it can lay its hands on in the response, a value of type 'CurlResponse'.
-- The representation of the body is overloaded
curlGetResponse_ :: (CurlHeader hdr, CurlBuffer ty)
                 => URLString
                 -> [CurlOption]
                 -> IO (CurlResponse_ hdr ty)
curlGetResponse_ :: String -> [CurlOption] -> IO (CurlResponse_ hdr ty)
curlGetResponse_ url :: String
url opts :: [CurlOption]
opts = do
  Curl
h <- IO Curl
initialize
   -- Note: later options may (and should, probably) override these defaults.
  Curl -> CurlOption -> IO CurlCode
setopt  Curl
h (Bool -> CurlOption
CurlFailOnError Bool
True)
  Curl -> String -> IO ()
setDefaultSSLOpts Curl
h String
url
  Curl -> CurlOption -> IO CurlCode
setopt  Curl
h (String -> CurlOption
CurlURL String
url)
  (CurlOption -> IO CurlCode) -> [CurlOption] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Curl -> CurlOption -> IO CurlCode
setopt Curl
h) [CurlOption]
opts
  -- note that users cannot over-write the body and header handler
  -- which makes sense because otherwise we will return a bogus reposnse.
  Curl -> IO (CurlResponse_ hdr ty)
forall headerTy bodyTy.
(CurlHeader headerTy, CurlBuffer bodyTy) =>
Curl -> IO (CurlResponse_ headerTy bodyTy)
perform_with_response_ Curl
h 

{-# DEPRECATED curlGetResponse "Switch to using curlGetResponse_" #-}
curlGetResponse :: URLString
                -> [CurlOption]
                -> IO CurlResponse
curlGetResponse :: String -> [CurlOption] -> IO CurlResponse
curlGetResponse url :: String
url opts :: [CurlOption]
opts = String -> [CurlOption] -> IO CurlResponse
forall hdr ty.
(CurlHeader hdr, CurlBuffer ty) =>
String -> [CurlOption] -> IO (CurlResponse_ hdr ty)
curlGetResponse_ String
url [CurlOption]
opts

-- | Perform the actions already specified on the handle.
-- Collects useful information about the returned message.
-- Note that this function sets the
-- 'CurlWriteFunction' and 'CurlHeaderFunction' options.
perform_with_response :: (CurlHeader hdrTy, CurlBuffer bufTy)
                      => Curl
		      -> IO (CurlResponse_ hdrTy bufTy)
perform_with_response :: Curl -> IO (CurlResponse_ hdrTy bufTy)
perform_with_response h :: Curl
h = Curl -> IO (CurlResponse_ hdrTy bufTy)
forall headerTy bodyTy.
(CurlHeader headerTy, CurlBuffer bodyTy) =>
Curl -> IO (CurlResponse_ headerTy bodyTy)
perform_with_response_ Curl
h

{-# DEPRECATED perform_with_response "Consider switching to perform_with_response_" #-}

-- | Perform the actions already specified on the handle.
-- Collects useful information about the returned message.
-- Note that this function sets the
-- 'CurlWriteFunction' and 'CurlHeaderFunction' options.
-- The returned payload is overloaded over the representation of
-- both headers and body via the 'CurlResponse_' type.
perform_with_response_ :: (CurlHeader headerTy, CurlBuffer bodyTy)
                       => Curl
		       -> IO (CurlResponse_ headerTy bodyTy)
perform_with_response_ :: Curl -> IO (CurlResponse_ headerTy bodyTy)
perform_with_response_ h :: Curl
h = do
   (finalHeader :: IO (String, headerTy)
finalHeader, gatherHeader :: CStringLen -> IO ()
gatherHeader) <- IO (IO (String, headerTy), CStringLen -> IO ())
forall headerTy.
CurlHeader headerTy =>
IO (IO (String, headerTy), CStringLen -> IO ())
newIncomingHeader
   (finalBody :: IO bodyTy
finalBody,   gatherBody :: CStringLen -> IO ()
gatherBody)   <- IO (IO bodyTy, CStringLen -> IO ())
forall bufferTy.
CurlBuffer bufferTy =>
IO (IO bufferTy, CStringLen -> IO ())
newIncoming

     -- Instead of allocating a separate handler for each
     -- request we could just set this options one and forall
     -- and just clear the IORefs.

   Curl -> CurlOption -> IO CurlCode
setopt  Curl
h (WriteFunction -> CurlOption
CurlWriteFunction ((CStringLen -> IO ()) -> WriteFunction
gatherOutput_ CStringLen -> IO ()
gatherBody))
   Curl -> CurlOption -> IO CurlCode
setopt  Curl
h (WriteFunction -> CurlOption
CurlHeaderFunction ((CStringLen -> IO ()) -> WriteFunction
gatherOutput_ CStringLen -> IO ()
gatherHeader))
   CurlCode
rc      <- Curl -> IO CurlCode
perform Curl
h
   Int
rspCode <- Curl -> IO Int
getResponseCode Curl
h
   (st :: String
st,hs :: headerTy
hs) <- IO (String, headerTy)
finalHeader
   bodyTy
bs      <- IO bodyTy
finalBody
   CurlResponse_ headerTy bodyTy -> IO (CurlResponse_ headerTy bodyTy)
forall (m :: * -> *) a. Monad m => a -> m a
return CurlResponse :: forall headerTy bodyTy.
CurlCode
-> Int
-> String
-> headerTy
-> bodyTy
-> (Info -> IO InfoValue)
-> CurlResponse_ headerTy bodyTy
CurlResponse
       { respCurlCode :: CurlCode
respCurlCode   = CurlCode
rc
       , respStatus :: Int
respStatus     = Int
rspCode
       , respStatusLine :: String
respStatusLine = String
st
       , respHeaders :: headerTy
respHeaders    = headerTy
hs
       , respBody :: bodyTy
respBody       = bodyTy
bs 
       -- note: we're holding onto the handle here..
       -- note: with this interface this is not neccessary.
       , respGetInfo :: Info -> IO InfoValue
respGetInfo    = Curl -> Info -> IO InfoValue
getInfo Curl
h
       }

-- | Performs a curl request using an exisitng curl handle.
-- The provided URL will overwride any 'CurlURL' options that
-- are provided in the list of options.  See also: 'perform_with_response'.
do_curl :: Curl -> URLString -> [CurlOption] -> IO CurlResponse
do_curl :: Curl -> String -> [CurlOption] -> IO CurlResponse
do_curl h :: Curl
h url :: String
url opts :: [CurlOption]
opts = Curl -> String -> [CurlOption] -> IO CurlResponse
forall headerTy bodyTy.
(CurlHeader headerTy, CurlBuffer bodyTy) =>
Curl
-> String -> [CurlOption] -> IO (CurlResponse_ headerTy bodyTy)
do_curl_ Curl
h String
url [CurlOption]
opts

{-# DEPRECATED do_curl "Consider switching to do_curl_" #-}

do_curl_ :: (CurlHeader headerTy, CurlBuffer bodyTy)
         => Curl
	 -> URLString
	 -> [CurlOption]
	 -> IO (CurlResponse_ headerTy bodyTy)
do_curl_ :: Curl
-> String -> [CurlOption] -> IO (CurlResponse_ headerTy bodyTy)
do_curl_ h :: Curl
h url :: String
url opts :: [CurlOption]
opts = do
   Curl -> String -> IO ()
setDefaultSSLOpts Curl
h String
url
   Curl -> [CurlOption] -> IO ()
setopts Curl
h [CurlOption]
opts
   Curl -> CurlOption -> IO CurlCode
setopt Curl
h (String -> CurlOption
CurlURL String
url)
   Curl -> IO (CurlResponse_ headerTy bodyTy)
forall headerTy bodyTy.
(CurlHeader headerTy, CurlBuffer bodyTy) =>
Curl -> IO (CurlResponse_ headerTy bodyTy)
perform_with_response_ Curl
h


-- | Get the headers associated with a particular URL.
-- Returns the status line and the key-value pairs for the headers.
curlHead :: URLString -> [CurlOption] -> IO (String,[(String,String)])
curlHead :: String -> [CurlOption] -> IO (String, [(String, String)])
curlHead url :: String
url opts :: [CurlOption]
opts = IO Curl
initialize IO Curl
-> (Curl -> IO (String, [(String, String)]))
-> IO (String, [(String, String)])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ h :: Curl
h -> 
  do IORef [String]
ref <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef []
--     setopt h (CurlVerbose True)
     Curl -> CurlOption -> IO CurlCode
setopt Curl
h (String -> CurlOption
CurlURL String
url)
     Curl -> CurlOption -> IO CurlCode
setopt Curl
h (Bool -> CurlOption
CurlNoBody Bool
True)
     (CurlOption -> IO CurlCode) -> [CurlOption] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Curl -> CurlOption -> IO CurlCode
setopt Curl
h) [CurlOption]
opts
     Curl -> CurlOption -> IO CurlCode
setopt Curl
h (WriteFunction -> CurlOption
CurlHeaderFunction (IORef [String] -> WriteFunction
gatherOutput IORef [String]
ref))
     Curl -> IO CurlCode
perform Curl
h
     [String]
lss <- IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
ref
     (String, [(String, String)]) -> IO (String, [(String, String)])
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> (String, [(String, String)])
parseStatusNHeaders (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
concRev [] [String]
lss))

-- | Get the headers associated with a particular URL.
-- Returns the status line and the key-value pairs for the headers.
curlHead_ :: (CurlHeader headers)
          => URLString
	  -> [CurlOption]
	  -> IO (String, headers)
curlHead_ :: String -> [CurlOption] -> IO (String, headers)
curlHead_ url :: String
url opts :: [CurlOption]
opts = IO Curl
initialize IO Curl -> (Curl -> IO (String, headers)) -> IO (String, headers)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ h :: Curl
h -> do
  (finalHeader :: IO (String, headers)
finalHeader, gatherHeader :: CStringLen -> IO ()
gatherHeader) <- IO (IO (String, headers), CStringLen -> IO ())
forall headerTy.
CurlHeader headerTy =>
IO (IO (String, headerTy), CStringLen -> IO ())
newIncomingHeader
--  setopt h (CurlVerbose True)
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (String -> CurlOption
CurlURL String
url)
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (Bool -> CurlOption
CurlNoBody Bool
True)
  (CurlOption -> IO CurlCode) -> [CurlOption] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Curl -> CurlOption -> IO CurlCode
setopt Curl
h) [CurlOption]
opts
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (WriteFunction -> CurlOption
CurlHeaderFunction ((CStringLen -> IO ()) -> WriteFunction
gatherOutput_ CStringLen -> IO ()
gatherHeader))
  Curl -> IO CurlCode
perform Curl
h
  IO (String, headers)
finalHeader


-- utils

concRev :: [a] -> [[a]] -> [a]
concRev :: [a] -> [[a]] -> [a]
concRev acc :: [a]
acc []     = [a]
acc
concRev acc :: [a]
acc (x :: [a]
x:xs :: [[a]]
xs) = [a] -> [[a]] -> [a]
forall a. [a] -> [[a]] -> [a]
concRev ([a]
x[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
acc) [[a]]
xs

parseStatusNHeaders :: String -> (String, [(String,String)])
parseStatusNHeaders :: String -> (String, [(String, String)])
parseStatusNHeaders ys :: String
ys =
  case String -> String -> [String]
intoLines [] String
ys of
   a :: String
a:as :: [String]
as  -> (String
a,(String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map String -> (String, String)
parseHeader [String]
as)
   []    -> ("",[]) 
 where
  intoLines :: String -> String -> [String]
intoLines acc :: String
acc "" = String -> [String] -> [String]
addLine String
acc []
  intoLines acc :: String
acc ('\r':'\n':xs :: String
xs) = String -> [String] -> [String]
addLine String
acc (String -> String -> [String]
intoLines "" String
xs)
  intoLines acc :: String
acc (x :: Char
x:xs :: String
xs) = String -> String -> [String]
intoLines (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) String
xs
  
  addLine :: String -> [String] -> [String]
addLine "" ls :: [String]
ls = [String]
ls
  addLine  l :: String
l ls :: [String]
ls = (String -> String
forall a. [a] -> [a]
reverse String
l) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ls
  
parseHeader :: String -> (String,String)
parseHeader :: String -> (String, String)
parseHeader xs :: String
xs = 
  case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (':' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
xs of
   (as :: String
as,_:bs :: String
bs) -> (String
as, String
bs)
   (as :: String
as,_)    -> (String
as,"")

-- | 'curlMultiPost' perform a multi-part POST submission.
curlMultiPost :: URLString -> [CurlOption] -> [HttpPost] -> IO ()
curlMultiPost :: String -> [CurlOption] -> [HttpPost] -> IO ()
curlMultiPost s :: String
s os :: [CurlOption]
os ps :: [HttpPost]
ps = IO Curl
initialize IO Curl -> (Curl -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ h :: Curl
h -> do
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (Bool -> CurlOption
CurlVerbose Bool
True)
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (String -> CurlOption
CurlURL String
s)
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h ([HttpPost] -> CurlOption
CurlHttpPost [HttpPost]
ps)
  (CurlOption -> IO CurlCode) -> [CurlOption] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Curl -> CurlOption -> IO CurlCode
setopt Curl
h) [CurlOption]
os
  Curl -> IO CurlCode
perform Curl
h
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- | 'curlPost' performs. a common POST operation, namely that
-- of submitting a sequence of name=value pairs.
curlPost :: URLString -> [String] -> IO ()
curlPost :: String -> [String] -> IO ()
curlPost s :: String
s ps :: [String]
ps = IO Curl
initialize IO Curl -> (Curl -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ h :: Curl
h -> do
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (Bool -> CurlOption
CurlVerbose Bool
True)
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h ([String] -> CurlOption
CurlPostFields [String]
ps)
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (String -> CurlOption
CurlCookieJar "cookies")
  Curl -> CurlOption -> IO CurlCode
setopt Curl
h (String -> CurlOption
CurlURL String
s)
  Curl -> IO CurlCode
perform Curl
h
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Use 'callbackWriter' instead.
{-# DEPRECATED #-}
easyWriter :: (String -> IO ()) -> WriteFunction
easyWriter :: (String -> IO ()) -> WriteFunction
easyWriter = (String -> IO ()) -> WriteFunction
callbackWriter

-- | Imports data into the Haskell world and invokes the callback.
callbackWriter :: (String -> IO ()) -> WriteFunction
callbackWriter :: (String -> IO ()) -> WriteFunction
callbackWriter f :: String -> IO ()
f pBuf :: Ptr CChar
pBuf sz :: CInt
sz szI :: CInt
szI _ = 
  do let bytes :: CInt
bytes = CInt
sz CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
szI 
     String -> IO ()
f (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CStringLen -> IO String
peekCStringLen (Ptr CChar
pBuf,CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
bytes)
     CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
bytes

-- | Imports data into the Haskell world and invokes the callback.
callbackWriter_ :: (CStringLen -> IO ()) -> WriteFunction
callbackWriter_ :: (CStringLen -> IO ()) -> WriteFunction
callbackWriter_ f :: CStringLen -> IO ()
f pBuf :: Ptr CChar
pBuf sz :: CInt
sz szI :: CInt
szI _ = do
  do let bytes :: CInt
bytes = CInt
sz CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
szI 
     CStringLen -> IO ()
f (Ptr CChar
pBuf,CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
bytes)
     CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
bytes

-- | The output of Curl is ignored.  This function
-- does not marshall data into Haskell.
ignoreOutput :: WriteFunction
ignoreOutput :: WriteFunction
ignoreOutput _ x :: CInt
x y :: CInt
y _ = CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
xCInt -> CInt -> CInt
forall a. Num a => a -> a -> a
*CInt
y)

-- | Add chunks of data to an IORef as they arrive.
gatherOutput :: IORef [String] -> WriteFunction
gatherOutput :: IORef [String] -> WriteFunction
gatherOutput r :: IORef [String]
r = (String -> IO ()) -> WriteFunction
callbackWriter (\ v :: String
v -> IORef [String] -> ([String] -> [String]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [String]
r (String
vString -> [String] -> [String]
forall a. a -> [a] -> [a]
:))

-- | Add chunks of data to an IORef as they arrive.
gatherOutput_ :: (CStringLen -> IO ()) -> WriteFunction
gatherOutput_ :: (CStringLen -> IO ()) -> WriteFunction
gatherOutput_ f :: CStringLen -> IO ()
f = (CStringLen -> IO ()) -> WriteFunction
callbackWriter_ CStringLen -> IO ()
f

getResponseCode :: Curl -> IO Int
getResponseCode :: Curl -> IO Int
getResponseCode c :: Curl
c = do
   InfoValue
iv <- Curl -> Info -> IO InfoValue
getInfo Curl
c Info
ResponseCode
   case InfoValue
iv of
     IString s :: String
s -> 
       case (ReadS Int
forall a. Read a => ReadS a
reads String
s) of
         ((v :: Int
v,_):_) -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
v
         _ -> String -> IO Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("Curl.getResponseCode: not a valid integer string " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
     IDouble d :: Double
d -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
d)
     ILong x :: Long
x   -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Long -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Long
x)
     IList{}   -> String -> IO Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("Curl.getResponseCode: unexpected response code " String -> String -> String
forall a. [a] -> [a] -> [a]
++ InfoValue -> String
forall a. Show a => a -> String
show InfoValue
iv)