-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.IO.GetHTTPLibCurl
   Copyright  : Copyright (C) 2008 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : stable
   Portability: portable

   GET for http access with libcurl

-}

-- ------------------------------------------------------------

module Text.XML.HXT.IO.GetHTTPLibCurl
    ( getCont
    )

where

import           Control.Arrow                           (first, (>>>))
import           Control.Concurrent.MVar
import           Control.Monad                           (when)

import qualified Data.ByteString.Lazy                    as B

import           Data.Char                               (isDigit, isSpace)
import           Data.List                               (isPrefixOf)

import           Network.Curl

import           System.IO
import           System.IO.Unsafe                        (unsafePerformIO)

import           Text.ParserCombinators.Parsec           (parse)

import           Text.XML.HXT.DOM.Util                   (stringToLower)
import           Text.XML.HXT.DOM.XmlKeywords            (httpPrefix,
                                                          transferMessage,
                                                          transferStatus,
                                                          transferVersion)

import           Text.XML.HXT.Arrow.XmlOptions           (a_if_modified_since,
                                                          a_if_unmodified_since,
                                                          a_proxy, a_redirect)

import           Text.XML.HXT.Parser.ProtocolHandlerUtil (parseContentType)
import           Text.XML.HXT.Version

-- ------------------------------------------------------------
--
-- the global flag for initializing curl in the 1. call
-- this is a hack, but until now no better solution found

isInitCurl      :: MVar Bool
isInitCurl :: MVar Bool
isInitCurl      = IO (MVar Bool) -> MVar Bool
forall a. IO a -> a
unsafePerformIO (IO (MVar Bool) -> MVar Bool) -> IO (MVar Bool) -> MVar Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
newMVar Bool
False

{-# NOINLINE isInitCurl #-}

initCurl        :: IO ()
initCurl :: IO ()
initCurl
    = do
      Bool
i <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
isInitCurl
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
i) ( CInt -> IO CurlCode
curl_global_init CInt
3
                     IO CurlCode -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                     () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   )
      MVar Bool -> Bool -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Bool
isInitCurl Bool
True

-- ------------------------------------------------------------

-- The curl lib is not thread save

curlResource    :: MVar ()
curlResource :: MVar ()
curlResource    = IO (MVar ()) -> MVar ()
forall a. IO a -> a
unsafePerformIO (IO (MVar ()) -> MVar ()) -> IO (MVar ()) -> MVar ()
forall a b. (a -> b) -> a -> b
$ () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()

{-# NOINLINE curlResource #-}

requestCurl     :: IO ()
requestCurl :: IO ()
requestCurl     = MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
curlResource

releaseCurl     :: IO ()
releaseCurl :: IO ()
releaseCurl     = MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
curlResource ()

-- ------------------------------------------------------------

--
-- the http protocol handler implemented by calling libcurl
-- (<http://curl.haxx.se/>)
-- via the curl binding
-- <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/curl>
-- This function tries to support mostly all curl options concerning HTTP requests.
-- The naming convetion is as follows: A curl option must be prefixed by the string
-- \"curl\" and then written exactly as described in the curl man page
-- (<http://curl.haxx.se/docs/manpage.html>).
--
-- Example:
--
-- > getCont [("--user-agent","My first HXT app"),("-e","http://the.referer.url/")] "http://..."
--
-- will set the user agent and the referer URL for this request.

getCont         :: Bool -> [(String, String)] -> String ->
                   IO (Either ([(String, String)],       String)
                              ([(String, String)], B.ByteString))
getCont :: Bool
-> [(String, String)]
-> String
-> IO
     (Either
        ([(String, String)], String) ([(String, String)], ByteString))
getCont Bool
strictInput [(String, String)]
options String
uri
    = do
      IO ()
initCurl
      IO ()
requestCurl
      CurlResponse_ [(String, String)] ByteString
resp <- String
-> [CurlOption] -> IO (CurlResponse_ [(String, String)] ByteString)
forall hdr ty.
(CurlHeader hdr, CurlBuffer ty) =>
String -> [CurlOption] -> IO (CurlResponse_ hdr ty)
curlGetResponse_ String
uri [CurlOption]
curlOptions
      let resp' :: Either
  ([(String, String)], String) ([(String, String)], ByteString)
resp' = CurlResponse_ [(String, String)] ByteString
-> Either
     ([(String, String)], String) ([(String, String)], ByteString)
evalResponse CurlResponse_ [(String, String)] ByteString
resp
      Either
  ([(String, String)], String) ([(String, String)], ByteString)
resp' Either
  ([(String, String)], String) ([(String, String)], ByteString)
-> IO () -> IO ()
forall a b. a -> b -> b
`seq`
            IO ()
releaseCurl
      -- dumpResponse
      Either
  ([(String, String)], String) ([(String, String)], ByteString)
-> IO
     (Either
        ([(String, String)], String) ([(String, String)], ByteString))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either
  ([(String, String)], String) ([(String, String)], ByteString)
resp'
    where
    _dumpResponse :: CurlResponse_ headerTy String -> IO ()
_dumpResponse CurlResponse_ headerTy String
r
        = do
          Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ CurlCode -> String
forall a. Show a => a -> String
show (CurlCode -> String) -> CurlCode -> String
forall a b. (a -> b) -> a -> b
$ CurlResponse_ headerTy String -> CurlCode
forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> CurlCode
respCurlCode   CurlResponse_ headerTy String
r
          Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CurlResponse_ headerTy String -> Int
forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> Int
respStatus     CurlResponse_ headerTy String
r
          Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$        CurlResponse_ headerTy String -> String
forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> String
respStatusLine CurlResponse_ headerTy String
r
          Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ headerTy -> String
forall a. Show a => a -> String
show (headerTy -> String) -> headerTy -> String
forall a b. (a -> b) -> a -> b
$ CurlResponse_ headerTy String -> headerTy
forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> headerTy
respHeaders    CurlResponse_ headerTy String
r
          Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$        CurlResponse_ headerTy String -> String
forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> bodyTy
respBody       CurlResponse_ headerTy String
r

    curlOptions :: [CurlOption]
curlOptions
        = [CurlOption]
defaultOptions [CurlOption] -> [CurlOption] -> [CurlOption]
forall a. [a] -> [a] -> [a]
++ ((String, String) -> [CurlOption])
-> [(String, String)] -> [CurlOption]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> String -> [CurlOption])
-> (String, String) -> [CurlOption]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> [CurlOption]
copt) [(String, String)]
options [CurlOption] -> [CurlOption] -> [CurlOption]
forall a. [a] -> [a] -> [a]
++ [CurlOption]
standardOptions

    defaultOptions :: [CurlOption]
defaultOptions                                              -- these options may be overwritten
        = [ String -> CurlOption
CurlUserAgent (String
"hxt/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hxt_version String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" via libcurl")
          , Bool -> CurlOption
CurlFollowLocation Bool
True
          ]

    standardOptions :: [CurlOption]
standardOptions                                             -- these options can't be overwritten
        = [ Bool -> CurlOption
CurlFailOnError    Bool
False
          , Bool -> CurlOption
CurlHeader         Bool
False
          , Bool -> CurlOption
CurlNoProgress     Bool
True
          ]
    evalResponse :: CurlResponse_ [(String, String)] ByteString
-> Either
     ([(String, String)], String) ([(String, String)], ByteString)
evalResponse CurlResponse_ [(String, String)] ByteString
r
        | CurlCode
rc CurlCode -> CurlCode -> Bool
forall a. Eq a => a -> a -> Bool
/= CurlCode
CurlOK
            = ([(String, String)], String)
-> Either
     ([(String, String)], String) ([(String, String)], ByteString)
forall a b. a -> Either a b
Left ( [ String -> String -> (String, String)
forall {a}. a -> String -> (a, String)
mkH String
transferStatus    String
"999"
                     , String -> String -> (String, String)
forall {a}. a -> String -> (a, String)
mkH String
transferMessage (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String
"curl library rc: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CurlCode -> String
forall a. Show a => a -> String
show CurlCode
rc
                     ]
                   , String
"curl library error when requesting URI "
                     String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
uri
                     String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": (curl return code=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CurlCode -> String
forall a. Show a => a -> String
show CurlCode
rc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") "
                   )
        | Int
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
200 Bool -> Bool -> Bool
&& Int
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
300
            = ([(String, String)], String)
-> Either
     ([(String, String)], String) ([(String, String)], ByteString)
forall a b. a -> Either a b
Left ( [(String, String)] -> [(String, String)]
contentT [(String, String)]
rsh [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
headers
                   , String
"http error when accessing URI "
                     String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
uri
                     String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": "
                     String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
rsl
                   )
        | Bool
otherwise
            = ([(String, String)], ByteString)
-> Either
     ([(String, String)], String) ([(String, String)], ByteString)
forall a b. b -> Either a b
Right ( [(String, String)] -> [(String, String)]
contentT [(String, String)]
rsh [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
headers
                    , ByteString
body
                    )
        where
        body :: B.ByteString
        body :: ByteString
body
            | Bool
strictInput       = ByteString -> Int64
B.length ByteString
body' Int64 -> ByteString -> ByteString
forall a b. a -> b -> b
`seq` ByteString
body'
            | Bool
otherwise         =                      ByteString
body'
            where
            body' :: ByteString
body'               = CurlResponse_ [(String, String)] ByteString -> ByteString
forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> bodyTy
respBody CurlResponse_ [(String, String)] ByteString
r

        mkH :: a -> String -> (a, String)
mkH a
x String
y = (a
x, (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
y)

        headers :: [(String, String)]
headers
            = ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (String
k, String
v) -> String -> String -> (String, String)
forall {a}. a -> String -> (a, String)
mkH (String
httpPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
stringToLower String
k) String
v) [(String, String)]
rsh
              [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
              [String] -> [(String, String)]
statusLine (String -> [String]
words String
rsl)

        contentT :: [(String, String)] -> [(String, String)]
contentT
            = ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> (String, String) -> (String, String)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> String
stringToLower)           -- all header names to lowercase
              ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"content-type") (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst)  -- select content-type header
              ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              [(String, String)] -> [(String, String)]
forall a. [a] -> [a]
reverse                             -- when libcurl is called with automatic redirects,
              ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>                                 -- there are more than one content-type headers
              Int -> [(String, String)] -> [(String, String)]
forall a. Int -> [a] -> [a]
take Int
1                              -- take the last one, (if at leat one is found)
              ([(String, String)] -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd                             -- select content-type value
              ([(String, String)] -> [String])
-> ([String] -> [(String, String)])
-> [(String, String)]
-> [(String, String)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              (String -> [(String, String)]) -> [String] -> [[(String, String)]]
forall a b. (a -> b) -> [a] -> [b]
map ( (ParseError -> [(String, String)])
-> ([(String, String)] -> [(String, String)])
-> Either ParseError [(String, String)]
-> [(String, String)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([(String, String)] -> ParseError -> [(String, String)]
forall a b. a -> b -> a
const []) [(String, String)] -> [(String, String)]
forall a. a -> a
id
                    (Either ParseError [(String, String)] -> [(String, String)])
-> (String -> Either ParseError [(String, String)])
-> String
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec String () [(String, String)]
-> String -> String -> Either ParseError [(String, String)]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () [(String, String)]
parseContentType String
""   -- parse the content-type for mimetype and charset
                  )
              ([String] -> [[(String, String)]])
-> ([[(String, String)]] -> [(String, String)])
-> [String]
-> [(String, String)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              [[(String, String)]] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

        statusLine :: [String] -> [(String, String)]
statusLine (String
vers : String
_code : [String]
msg)           -- the status line of the curl response can be an old one,
                                                  -- e.g. in the case of a redirect,
            = [ String -> String -> (String, String)
forall {a}. a -> String -> (a, String)
mkH String
transferVersion   String
vers        -- so the return code is taken from that status field,
              , String -> String -> (String, String)
forall {a}. a -> String -> (a, String)
mkH String
transferMessage (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
msg -- which is contains the last status
              , String -> String -> (String, String)
forall {a}. a -> String -> (a, String)
mkH String
transferStatus  (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
rs
              ]
        statusLine [String]
_
            = []

        rc :: CurlCode
rc  = CurlResponse_ [(String, String)] ByteString -> CurlCode
forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> CurlCode
respCurlCode    CurlResponse_ [(String, String)] ByteString
r
        rs :: Int
rs  = CurlResponse_ [(String, String)] ByteString -> Int
forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> Int
respStatus      CurlResponse_ [(String, String)] ByteString
r
        rsl :: String
rsl = CurlResponse_ [(String, String)] ByteString -> String
forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> String
respStatusLine  CurlResponse_ [(String, String)] ByteString
r
        rsh :: [(String, String)]
rsh = CurlResponse_ [(String, String)] ByteString -> [(String, String)]
forall headerTy bodyTy. CurlResponse_ headerTy bodyTy -> headerTy
respHeaders     CurlResponse_ [(String, String)] ByteString
r

-- ------------------------------------------------------------

copt    :: String -> String -> [CurlOption]
copt :: String -> String -> [CurlOption]
copt String
k String
v
    | String
"curl-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
k    = String -> String -> [CurlOption]
copt (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
k) String
v             -- throw away curl prefix
    | String
"--"    String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
k    = String -> String -> [CurlOption]
opt2copt (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 String
k) String
v
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
a_proxy
               , String
a_redirect]    = String -> String -> [CurlOption]
opt2copt String
k String
v

    | Bool
otherwise                 = String -> String -> [CurlOption]
opt2copt String
k String
v

opt2copt        :: String -> String -> [CurlOption]
opt2copt :: String -> String -> [CurlOption]
opt2copt String
k String
v
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-A", String
"user-agent"]     = [String -> CurlOption
CurlUserAgent String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-b", String
"cookie"]         = [String -> CurlOption
CurlCookie String
v]
    | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"connect-timeout"
      Bool -> Bool -> Bool
&&
      String -> Bool
isIntArg String
v                        = [Long -> CurlOption
CurlConnectTimeout      (Long -> CurlOption) -> Long -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Long
forall a. Read a => String -> a
read    String
v]
    | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"crlf"                       = [Bool -> CurlOption
CurlCRLF                (Bool -> CurlOption) -> Bool -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Bool
isTrue  String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-d", String
"data"]           = [[String] -> CurlOption
CurlPostFields          ([String] -> CurlOption) -> [String] -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines   String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-e", String
"referer"]        = [String -> CurlOption
CurlReferer                       String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-H", String
"header"]         = [[String] -> CurlOption
CurlHttpHeaders         ([String] -> CurlOption) -> [String] -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines   String
v]
    | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ignore-content-length"      = [Bool -> CurlOption
CurlIgnoreContentLength (Bool -> CurlOption) -> Bool -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Bool
isTrue  String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-I", String
"head"]           = [Bool -> CurlOption
CurlNoBody              (Bool -> CurlOption) -> Bool -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Bool
isTrue  String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"-L"
               , String
"location"
               , String
a_redirect
               ]                        = [Bool -> CurlOption
CurlFollowLocation      (Bool -> CurlOption) -> Bool -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Bool
isTrue  String
v]
    | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"max-filesize"
      Bool -> Bool -> Bool
&&
      String -> Bool
isIntArg String
v                        = [LLong -> CurlOption
CurlMaxFileSizeLarge    (LLong -> CurlOption) -> LLong -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> LLong
forall a. Read a => String -> a
read    String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-m", String
"max-time"]
      Bool -> Bool -> Bool
&&
      String -> Bool
isIntArg String
v                        = [Long -> CurlOption
CurlTimeoutMS           (Long -> CurlOption) -> Long -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Long
forall a. Read a => String -> a
read    String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-n", String
"netrc"]          = [String -> CurlOption
CurlNetrcFile                     String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"ssl-verify-peer"]
      Bool -> Bool -> Bool
&&
      String -> Bool
isIntArg String
v                        = [Bool -> CurlOption
CurlSSLVerifyPeer       (Bool -> CurlOption) -> Bool -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall a. Read a => String -> a
read    String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-R", String
"remote-time"]    = [Bool -> CurlOption
CurlFiletime            (Bool -> CurlOption) -> Bool -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Bool
isTrue  String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-u", String
"user"]           = [String -> CurlOption
CurlUserPwd                       String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-U", String
"proxy-user"]     = [String -> CurlOption
CurlProxyUserPwd                  String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"-x"
               , String
"proxy"
               , String
a_proxy
               ]                        =  [CurlOption]
proxyOptions
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-X", String
"request"]        = [String -> CurlOption
CurlCustomRequest                 String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-y", String
"speed-time"]
      Bool -> Bool -> Bool
&&
      String -> Bool
isIntArg String
v                        = [Long -> CurlOption
CurlLowSpeedTime        (Long -> CurlOption) -> Long -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Long
forall a. Read a => String -> a
read    String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-Y", String
"speed-limit"]
      Bool -> Bool -> Bool
&&
      String -> Bool
isIntArg String
v                        = [Long -> CurlOption
CurlLowSpeed            (Long -> CurlOption) -> Long -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Long
forall a. Read a => String -> a
read    String
v]
    | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
a_if_modified_since          = [[String] -> CurlOption
CurlHttpHeaders         ([String] -> CurlOption) -> [String] -> CurlOption
forall a b. (a -> b) -> a -> b
$ [String
"If-Modified-Since: "   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v] ]
    | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
a_if_unmodified_since        = [[String] -> CurlOption
CurlHttpHeaders         ([String] -> CurlOption) -> [String] -> CurlOption
forall a b. (a -> b) -> a -> b
$ [String
"If-Unmodified-Since: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v] ]
                                        -- CurlTimeValue seems to be buggy, therefore the above workaround
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"-z"
               , String
"time-cond"
               , String
a_if_modified_since
               ]                        =  [CurlOption]
ifModifiedOptions

    | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"max-redirs"
      Bool -> Bool -> Bool
&&
      String -> Bool
isIntArg String
v                        = [Long -> CurlOption
CurlMaxRedirs           (Long -> CurlOption) -> Long -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Long
forall a. Read a => String -> a
read    String
v]
    | String
k String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"-0", String
"http1.0"]        = [HttpVersion -> CurlOption
CurlHttpVersion       HttpVersion
HttpVersion10]
    | Bool
otherwise                         = []
    where
    ifModifiedOptions :: [CurlOption]
ifModifiedOptions
        | String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
v
          Bool -> Bool -> Bool
&&
          String -> Bool
isIntArg String
v'                   = [TimeCond -> CurlOption
CurlTimeCondition TimeCond
TimeCondIfUnmodSince
                                          ,Long -> CurlOption
CurlTimeValue           (Long -> CurlOption) -> Long -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Long
forall a. Read a => String -> a
read   String
v'
                                          ]
        | String -> Bool
isIntArg String
v                    = [TimeCond -> CurlOption
CurlTimeCondition TimeCond
TimeCondIfModSince
                                          ,Long -> CurlOption
CurlTimeValue           (Long -> CurlOption) -> Long -> CurlOption
forall a b. (a -> b) -> a -> b
$ String -> Long
forall a. Read a => String -> a
read   String
v'
                                          ]
        | Bool
otherwise                     = []
        where
        v' :: String
v' = String -> String
forall a. HasCallStack => [a] -> [a]
tail String
v

    proxyOptions :: [CurlOption]
proxyOptions
        = [ Long -> CurlOption
CurlProxyPort Long
pport
          , String -> CurlOption
CurlProxy     String
phost
          ]
        where
        pport :: Long
pport
            | String -> Bool
isIntArg String
ppp      = String -> Long
forall a. Read a => String -> a
read String
ppp
            | Bool
otherwise         = Long
1080
        (String
phost, String
pp)             = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
':') String
v
        ppp :: String
ppp                     = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
pp

isTrue          :: String -> Bool
isTrue :: String -> Bool
isTrue String
s        = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s Bool -> Bool -> Bool
|| (String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"1", String
"True", String
"true", String
"Yes", String
"yes"])

isIntArg        :: String -> Bool
isIntArg :: String -> Bool
isIntArg String
s      = Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s) Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
s

-- ------------------------------------------------------------