{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
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
, withCurlDo
, setopts
, CurlResponse_(..)
, CurlResponse
, curlGet
, curlGetString
, curlGetResponse
, perform_with_response
, do_curl
, curlGetString_
, curlGetResponse_
, perform_with_response_
, do_curl_
, curlHead_
, curlHead
, curlMultiPost
, curlPost
, getResponseCode
, setDefaultSSLOpts
, callbackWriter
, easyWriter
, ignoreOutput
, gatherOutput
, gatherOutput_
, CurlBuffer(..)
, CurlHeader(..)
, method_GET
, method_HEAD
, method_POST
, parseStatusNHeaders
, parseHeader
, 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 Control.Exception ( finally )
import Data.ByteString ( ByteString, packCStringLen )
import qualified Data.ByteString as BS ( concat )
import qualified Data.ByteString.Lazy as LazyBS ( ByteString, fromChunks )
class CurlBuffer bufferTy where
newIncoming :: IO (IO bufferTy, CStringLen -> IO ())
class headerTy where
:: IO (IO (String,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 (String
st,[(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, \ 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
>>= \ 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, \ 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
>>= \ 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, \ 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
>>= \ 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, \ 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
>>= \ 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, \ 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
>>= \ 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]
:))
withCurlDo :: IO a -> IO a
withCurlDo :: forall a. IO a -> IO a
withCurlDo IO a
m = do CInt -> IO CurlCode
curl_global_init CInt
3
IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
finally IO a
m IO ()
curl_global_cleanup
setopts :: Curl -> [CurlOption] -> IO ()
setopts :: Curl -> [CurlOption] -> IO ()
setopts Curl
h [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 :: URLString -> [CurlOption] -> IO ()
curlGet :: String -> [CurlOption] -> IO ()
curlGet String
url [CurlOption]
opts = IO Curl
initialize IO Curl -> (Curl -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ 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)
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 Curl
h String
url
| String
"https:" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
url = do
(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 Long
0
]
| Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
curlGetString :: URLString
-> [CurlOption]
-> IO (CurlCode, String)
curlGetString :: String -> [CurlOption] -> IO (CurlCode, String)
curlGetString String
url [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
>>= \ Curl
h -> do
IORef [String]
ref <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef []
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_ :: forall ty.
CurlBuffer ty =>
String -> [CurlOption] -> IO (CurlCode, ty)
curlGetString_ String
url [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
>>= \ Curl
h -> do
(IO ty
finalBody, 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
data CurlResponse_ headerTy bodyTy
= CurlResponse
{ forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> CurlCode
respCurlCode :: CurlCode
, forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> Int
respStatus :: Int
, forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> String
respStatusLine :: String
, :: headerTy
, forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> bodyTy
respBody :: bodyTy
, forall headerTy bodyTy.
CurlResponse_ headerTy bodyTy -> Info -> IO InfoValue
respGetInfo :: (Info -> IO InfoValue)
}
curlGetResponse_ :: (CurlHeader hdr, CurlBuffer ty)
=> URLString
-> [CurlOption]
-> IO (CurlResponse_ hdr ty)
curlGetResponse_ :: forall hdr ty.
(CurlHeader hdr, CurlBuffer ty) =>
String -> [CurlOption] -> IO (CurlResponse_ hdr ty)
curlGetResponse_ String
url [CurlOption]
opts = do
Curl
h <- IO Curl
initialize
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
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 String
url [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_with_response :: (CurlHeader hdrTy, CurlBuffer bufTy)
=> Curl
-> IO (CurlResponse_ hdrTy bufTy)
perform_with_response :: forall headerTy bodyTy.
(CurlHeader headerTy, CurlBuffer bodyTy) =>
Curl -> IO (CurlResponse_ headerTy bodyTy)
perform_with_response 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_with_response_ :: (CurlHeader headerTy, CurlBuffer bodyTy)
=> Curl
-> IO (CurlResponse_ headerTy bodyTy)
perform_with_response_ :: forall headerTy bodyTy.
(CurlHeader headerTy, CurlBuffer bodyTy) =>
Curl -> IO (CurlResponse_ headerTy bodyTy)
perform_with_response_ Curl
h = do
(IO (String, headerTy)
finalHeader, CStringLen -> IO ()
gatherHeader) <- IO (IO (String, headerTy), CStringLen -> IO ())
forall headerTy.
CurlHeader headerTy =>
IO (IO (String, headerTy), CStringLen -> IO ())
newIncomingHeader
(IO bodyTy
finalBody, CStringLen -> IO ()
gatherBody) <- IO (IO bodyTy, CStringLen -> IO ())
forall bufferTy.
CurlBuffer bufferTy =>
IO (IO bufferTy, CStringLen -> IO ())
newIncoming
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
(String
st,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
, respGetInfo :: Info -> IO InfoValue
respGetInfo = Curl -> Info -> IO InfoValue
getInfo Curl
h
}
do_curl :: Curl -> URLString -> [CurlOption] -> IO CurlResponse
do_curl :: Curl -> String -> [CurlOption] -> IO CurlResponse
do_curl Curl
h String
url [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_ :: forall headerTy bodyTy.
(CurlHeader headerTy, CurlBuffer bodyTy) =>
Curl
-> String -> [CurlOption] -> IO (CurlResponse_ headerTy bodyTy)
do_curl_ Curl
h String
url [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
curlHead :: URLString -> [CurlOption] -> IO (String,[(String,String)])
curlHead :: String -> [CurlOption] -> IO (String, [(String, String)])
curlHead String
url [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
>>= \ Curl
h ->
do IORef [String]
ref <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef []
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))
curlHead_ :: (CurlHeader headers)
=> URLString
-> [CurlOption]
-> IO (String, headers)
curlHead_ :: forall headers.
CurlHeader headers =>
String -> [CurlOption] -> IO (String, headers)
curlHead_ String
url [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
>>= \ Curl
h -> do
(IO (String, headers)
finalHeader, CStringLen -> IO ()
gatherHeader) <- IO (IO (String, headers), CStringLen -> IO ())
forall headerTy.
CurlHeader headerTy =>
IO (IO (String, headerTy), CStringLen -> IO ())
newIncomingHeader
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
concRev :: [a] -> [[a]] -> [a]
concRev :: forall a. [a] -> [[a]] -> [a]
concRev [a]
acc [] = [a]
acc
concRev [a]
acc ([a]
x:[[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)])
String
ys =
case String -> String -> [String]
intoLines [] String
ys of
String
a:[String]
as -> (String
a,(String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map String -> (String, String)
parseHeader [String]
as)
[] -> (String
"",[])
where
intoLines :: String -> String -> [String]
intoLines String
acc String
"" = String -> [String] -> [String]
addLine String
acc []
intoLines String
acc (Char
'\r':Char
'\n':String
xs) = String -> [String] -> [String]
addLine String
acc (String -> String -> [String]
intoLines String
"" String
xs)
intoLines String
acc (Char
x:String
xs) = String -> String -> [String]
intoLines (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
acc) String
xs
addLine :: String -> [String] -> [String]
addLine String
"" [String]
ls = [String]
ls
addLine String
l [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)
String
xs =
case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char
':' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
xs of
(String
as,Char
_:String
bs) -> (String
as, String
bs)
(String
as,String
_) -> (String
as,String
"")
curlMultiPost :: URLString -> [CurlOption] -> [HttpPost] -> IO ()
curlMultiPost :: String -> [CurlOption] -> [HttpPost] -> IO ()
curlMultiPost String
s [CurlOption]
os [HttpPost]
ps = IO Curl
initialize IO Curl -> (Curl -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ 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 :: URLString -> [String] -> IO ()
curlPost :: String -> [String] -> IO ()
curlPost String
s [String]
ps = IO Curl
initialize IO Curl -> (Curl -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ 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 String
"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 ()
{-# DEPRECATED #-}
easyWriter :: (String -> IO ()) -> WriteFunction
easyWriter :: (String -> IO ()) -> WriteFunction
easyWriter = (String -> IO ()) -> WriteFunction
callbackWriter
callbackWriter :: (String -> IO ()) -> WriteFunction
callbackWriter :: (String -> IO ()) -> WriteFunction
callbackWriter String -> IO ()
f Ptr CChar
pBuf CInt
sz CInt
szI Ptr ()
_ =
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
callbackWriter_ :: (CStringLen -> IO ()) -> WriteFunction
callbackWriter_ :: (CStringLen -> IO ()) -> WriteFunction
callbackWriter_ CStringLen -> IO ()
f Ptr CChar
pBuf CInt
sz CInt
szI Ptr ()
_ = 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
ignoreOutput :: WriteFunction
ignoreOutput :: WriteFunction
ignoreOutput Ptr CChar
_ CInt
x CInt
y Ptr ()
_ = 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)
gatherOutput :: IORef [String] -> WriteFunction
gatherOutput :: IORef [String] -> WriteFunction
gatherOutput IORef [String]
r = (String -> IO ()) -> WriteFunction
callbackWriter (\ 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]
:))
gatherOutput_ :: (CStringLen -> IO ()) -> WriteFunction
gatherOutput_ :: (CStringLen -> IO ()) -> WriteFunction
gatherOutput_ CStringLen -> IO ()
f = (CStringLen -> IO ()) -> WriteFunction
callbackWriter_ CStringLen -> IO ()
f
getResponseCode :: Curl -> IO Int
getResponseCode :: Curl -> IO Int
getResponseCode Curl
c = do
InfoValue
iv <- Curl -> Info -> IO InfoValue
getInfo Curl
c Info
ResponseCode
case InfoValue
iv of
IString String
s ->
case (ReadS Int
forall a. Read a => ReadS a
reads String
s) of
((Int
v,String
_):[(Int, String)]
_) -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
v
[(Int, String)]
_ -> String -> IO Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Curl.getResponseCode: not a valid integer string " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
IDouble 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 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 (String
"Curl.getResponseCode: unexpected response code " String -> String -> String
forall a. [a] -> [a] -> [a]
++ InfoValue -> String
forall a. Show a => a -> String
show InfoValue
iv)