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

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

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

   HXT interface for native HTTP access via package HTTP
-}

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

module Text.XML.HXT.IO.GetHTTPNative
    ( module Text.XML.HXT.IO.GetHTTPNative
    )

where

import           Control.Arrow
import           Control.Exception                       (try)

import           Text.XML.HXT.DOM.TypeDefs               (Attributes)
import           Text.XML.HXT.DOM.Util                   (stringTrim)
import           Text.XML.HXT.DOM.XmlKeywords

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

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

import           Text.ParserCombinators.Parsec           (parse)

import qualified Data.ByteString.Lazy                    as B

import           Data.Char                               (isDigit)
import           Data.Int                                (Int64)
import           Data.List                               (isPrefixOf)
import           Data.Maybe
import           System.IO                               (hPutStrLn, stderr)
import           System.IO.Error                         (ioeGetErrorString)

import           Network.Browser                         (BrowserAction,
                                                          Proxy (..), browse,
                                                          defaultGETRequest_,
                                                          request,
                                                          setAllowRedirects,
                                                          setErrHandler,
                                                          setMaxRedirects,
                                                          setOutHandler,
                                                          setProxy)
import           Network.HTTP                            (Header (..),
                                                          HeaderName (..),
                                                          Request (..),
                                                          Response (..),
                                                          httpVersion,
                                                          replaceHeader)
import           Network.Socket                          (withSocketsDo)
import           Network.URI                             (URI,
                                                          parseURIReference)

-- import qualified Debug.Trace as T
-- ------------------------------------------------------------
--
-- the native http protocol handler

-- ------------------------------------------------------------
--
-- the http protocol handler, haskell implementation

getCont         :: Bool -> String -> String -> Bool -> Attributes ->
                   IO (Either ([(String, String)],       String)
                              ([(String, String)], B.ByteString)
                      )
getCont :: Bool
-> String
-> String
-> Bool
-> Attributes
-> IO (Either (Attributes, String) (Attributes, ByteString))
getCont strictInput :: Bool
strictInput proxy :: String
proxy uri :: String
uri redirect :: Bool
redirect options :: Attributes
options
    = do
      Either IOError (Response ByteString)
res <- IO (Response ByteString)
-> IO (Either IOError (Response ByteString))
forall e a. Exception e => IO a -> IO (Either e a)
try (Bool
-> URI -> String -> Bool -> Attributes -> IO (Response ByteString)
getHttp Bool
False URI
uri1 String
proxy Bool
redirect Attributes
options)
      (IOError
 -> IO (Either (Attributes, String) (Attributes, ByteString)))
-> (Response ByteString
    -> IO (Either (Attributes, String) (Attributes, ByteString)))
-> Either IOError (Response ByteString)
-> IO (Either (Attributes, String) (Attributes, ByteString))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError
-> IO (Either (Attributes, String) (Attributes, ByteString))
forall (m :: * -> *) b.
Monad m =>
IOError -> m (Either (Attributes, String) b)
processError Response ByteString
-> IO (Either (Attributes, String) (Attributes, ByteString))
forall (m :: * -> *).
Monad m =>
Response ByteString
-> m (Either (Attributes, String) (Attributes, ByteString))
processResponse Either IOError (Response ByteString)
res
    where
    uri1 :: URI
uri1 = Maybe URI -> URI
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe URI
parseURIReference String
uri)

    processError :: IOError -> m (Either (Attributes, String) b)
processError e :: IOError
e
        = Either (Attributes, String) b -> m (Either (Attributes, String) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Attributes, String) b
 -> m (Either (Attributes, String) b))
-> Either (Attributes, String) b
-> m (Either (Attributes, String) b)
forall a b. (a -> b) -> a -> b
$
          (Attributes, String) -> Either (Attributes, String) b
forall a b. a -> Either a b
Left ( [ (String
transferStatus, "999")
                 , (String
transferMessage, "HTTP library error")
                 ]
               , "http 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 -> String -> String
forall a. [a] -> [a] -> [a]
++ IOError -> String
ioeGetErrorString IOError
e
                 String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (perhaps server does not understand HTTP/1.1) "
               )

    processResponse :: Response ByteString
-> m (Either (Attributes, String) (Attributes, ByteString))
processResponse response :: Response ByteString
response
        | ( (Int
rc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 200 Bool -> Bool -> Bool
&& Int
rc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 300)
            Bool -> Bool -> Bool
||
            Int
rc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 304           -- not modified is o.k., this rc only occurs together with if-modified-since
          )
          Bool -> Bool -> Bool
&&
          Bool
fileSizeOK
            = do
              if Bool
strictInput
                then ByteString -> Int64
B.length ByteString
cs Int64
-> m (Either (Attributes, String) (Attributes, ByteString))
-> m (Either (Attributes, String) (Attributes, ByteString))
forall a b. a -> b -> b
`seq` Either (Attributes, String) (Attributes, ByteString)
-> m (Either (Attributes, String) (Attributes, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return Either (Attributes, String) (Attributes, ByteString)
forall a. Either a (Attributes, ByteString)
res
                else                   Either (Attributes, String) (Attributes, ByteString)
-> m (Either (Attributes, String) (Attributes, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return Either (Attributes, String) (Attributes, ByteString)
forall a. Either a (Attributes, ByteString)
res

        | Bool -> Bool
not Bool
fileSizeOK
            = Either (Attributes, String) (Attributes, ByteString)
-> m (Either (Attributes, String) (Attributes, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Attributes, String) (Attributes, ByteString)
 -> m (Either (Attributes, String) (Attributes, ByteString)))
-> Either (Attributes, String) (Attributes, ByteString)
-> m (Either (Attributes, String) (Attributes, ByteString))
forall a b. (a -> b) -> a -> b
$
              String -> Either (Attributes, String) (Attributes, ByteString)
forall b. String -> Either (Attributes, String) b
ers "999 max-filesize exceeded"

        | Bool
otherwise
            = Either (Attributes, String) (Attributes, ByteString)
-> m (Either (Attributes, String) (Attributes, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Attributes, String) (Attributes, ByteString)
 -> m (Either (Attributes, String) (Attributes, ByteString)))
-> Either (Attributes, String) (Attributes, ByteString)
-> m (Either (Attributes, String) (Attributes, ByteString))
forall a b. (a -> b) -> a -> b
$
              String -> Either (Attributes, String) (Attributes, ByteString)
forall b. String -> Either (Attributes, String) b
ers (Int -> String
forall a. Show a => a -> String
show Int
rc String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rr)
        where
        fileSizeOK :: Bool
fileSizeOK = case Attributes -> Maybe Int64
getCurlMaxFileSize Attributes
options of
                     Nothing -> Bool
True
                     Just mx :: Int64
mx -> ByteString -> Int64
B.length ByteString
cs Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
mx
        rc :: Int
rc  = (Int, Int, Int) -> Int
convertResponseStatus ((Int, Int, Int) -> Int) -> (Int, Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Response ByteString -> (Int, Int, Int)
forall a. Response a -> (Int, Int, Int)
rspCode Response ByteString
response
        rr :: String
rr  = Response ByteString -> String
forall a. Response a -> String
rspReason Response ByteString
response
        res :: Either a (Attributes, ByteString)
res   = (Attributes, ByteString) -> Either a (Attributes, ByteString)
forall a b. b -> Either a b
Right (Attributes
rs, ByteString
cs)
        ers :: String -> Either (Attributes, String) b
ers e :: String
e = (Attributes, String) -> Either (Attributes, String) b
forall a b. a -> Either a b
Left (Attributes
rs, "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
forall a. [a] -> [a] -> [a]
++ String
e)
        rs :: Attributes
rs  = Attributes
rst Attributes -> Attributes -> Attributes
forall a. [a] -> [a] -> [a]
++ Attributes
rsh
        rst :: Attributes
rst = [ (String
transferStatus, Int -> String
forall a. Show a => a -> String
show Int
rc)
              , (String
transferMessage,     String
rr)
              ]
        rsh :: Attributes
rsh = Response ByteString -> Attributes
convertResponseHeaders Response ByteString
response
        cs :: ByteString
cs  = Response ByteString -> ByteString
forall a. Response a -> a
rspBody Response ByteString
response

    getHttp             :: Bool -> URI -> String -> Bool -> Attributes -> IO (Response B.ByteString)
    getHttp :: Bool
-> URI -> String -> Bool -> Attributes -> IO (Response ByteString)
getHttp trc' :: Bool
trc' uri' :: URI
uri' proxy' :: String
proxy' redirect' :: Bool
redirect' options' :: Attributes
options'
        = IO (Response ByteString) -> IO (Response ByteString)
forall a. IO a -> IO a
withSocketsDo (IO (Response ByteString) -> IO (Response ByteString))
-> IO (Response ByteString) -> IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$
          BrowserAction (HandleStream ByteString) (Response ByteString)
-> IO (Response ByteString)
forall conn a. BrowserAction conn a -> IO a
browse ( do
                   [BrowserAction (HandleStream ByteString) ()]
-> BrowserAction (HandleStream ByteString) ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [BrowserAction (HandleStream ByteString) ()]
forall t. [BrowserAction t ()]
configHttp
                   (_ruri :: URI
_ruri, rsp :: Response ByteString
rsp) <- Request ByteString
-> BrowserAction
     (HandleStream ByteString) (URI, Response ByteString)
forall ty.
HStream ty =>
Request ty -> BrowserAction (HandleStream ty) (URI, Response ty)
request (Request ByteString
 -> BrowserAction
      (HandleStream ByteString) (URI, Response ByteString))
-> Request ByteString
-> BrowserAction
     (HandleStream ByteString) (URI, Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request ByteString
theRequest
                   Response ByteString
-> BrowserAction (HandleStream ByteString) (Response ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Response ByteString
rsp
                 )
        where
        theRequest :: Request B.ByteString
        theRequest :: Request ByteString
theRequest
            = Request ByteString -> Request ByteString
configHeaders (Request ByteString -> Request ByteString)
-> Request ByteString -> Request ByteString
forall a b. (a -> b) -> a -> b
$ URI -> Request ByteString
forall a. BufferType a => URI -> Request a
defaultGETRequest_ URI
uri'

        configHeaders :: Request B.ByteString -> Request B.ByteString
        configHeaders :: Request ByteString -> Request ByteString
configHeaders
            = ((Request ByteString -> Request ByteString)
 -> (Request ByteString -> Request ByteString)
 -> Request ByteString
 -> Request ByteString)
-> (Request ByteString -> Request ByteString)
-> [Request ByteString -> Request ByteString]
-> Request ByteString
-> Request ByteString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Request ByteString -> Request ByteString)
-> (Request ByteString -> Request ByteString)
-> Request ByteString
-> Request ByteString
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>) Request ByteString -> Request ByteString
forall a. a -> a
id ([Request ByteString -> Request ByteString]
 -> Request ByteString -> Request ByteString)
-> (Attributes -> [Request ByteString -> Request ByteString])
-> Attributes
-> Request ByteString
-> Request ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HeaderName, String) -> Request ByteString -> Request ByteString)
-> [(HeaderName, String)]
-> [Request ByteString -> Request ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ((HeaderName -> String -> Request ByteString -> Request ByteString)
-> (HeaderName, String) -> Request ByteString -> Request ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HeaderName -> String -> Request ByteString -> Request ByteString
forall a. HasHeaders a => HeaderSetter a
replaceHeader) ([(HeaderName, String)]
 -> [Request ByteString -> Request ByteString])
-> (Attributes -> [(HeaderName, String)])
-> Attributes
-> [Request ByteString -> Request ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> [(HeaderName, String)])
-> Attributes -> [(HeaderName, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> String -> [(HeaderName, String)])
-> (String, String) -> [(HeaderName, String)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> [(HeaderName, String)]
setHOption) (Attributes -> Request ByteString -> Request ByteString)
-> Attributes -> Request ByteString -> Request ByteString
forall a b. (a -> b) -> a -> b
$ Attributes
options'

        configHttp :: [BrowserAction t ()]
configHttp
            = (String -> IO ()) -> BrowserAction t ()
forall t. (String -> IO ()) -> BrowserAction t ()
setOutHandler (String -> IO ()
trcFct)
              BrowserAction t () -> [BrowserAction t ()] -> [BrowserAction t ()]
forall a. a -> [a] -> [a]
: (String -> IO ()) -> BrowserAction t ()
forall t. (String -> IO ()) -> BrowserAction t ()
setErrHandler (String -> IO ()
trcFct)
              BrowserAction t () -> [BrowserAction t ()] -> [BrowserAction t ()]
forall a. a -> [a] -> [a]
: ( if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
proxy'
                  then () -> BrowserAction t ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  else Proxy -> BrowserAction t ()
forall t. Proxy -> BrowserAction t ()
setProxy (String -> Maybe Authority -> Proxy
Proxy String
proxy' Maybe Authority
forall a. Maybe a
Nothing)
                )
              BrowserAction t () -> [BrowserAction t ()] -> [BrowserAction t ()]
forall a. a -> [a] -> [a]
: Bool -> BrowserAction t ()
forall t. Bool -> BrowserAction t ()
setAllowRedirects Bool
redirect'
              BrowserAction t () -> [BrowserAction t ()] -> [BrowserAction t ()]
forall a. a -> [a] -> [a]
: ((String, String) -> [BrowserAction t ()])
-> Attributes -> [BrowserAction t ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> String -> [BrowserAction t ()])
-> (String, String) -> [BrowserAction t ()]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> [BrowserAction t ()]
forall t. String -> String -> [BrowserAction t ()]
setOption) Attributes
options'

        trcFct :: String -> IO ()
trcFct s :: String
s
            | Bool
trc'
                = Handle -> String -> IO ()
hPutStrLn Handle
stderr ("-- (5) http: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
            | Bool
otherwise
                = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    convertResponseStatus       :: (Int, Int, Int) -> Int
    convertResponseStatus :: (Int, Int, Int) -> Int
convertResponseStatus (a :: Int
a, b :: Int
b, c :: Int
c)
        = 100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c

    convertResponseHeaders      :: Response B.ByteString -> [(String, String)]
    convertResponseHeaders :: Response ByteString -> Attributes
convertResponseHeaders r' :: Response ByteString
r'
        = (Int, Int, Int) -> Attributes
cvResponseCode (Response ByteString -> (Int, Int, Int)
forall a. Response a -> (Int, Int, Int)
rspCode Response ByteString
r')
          Attributes -> Attributes -> Attributes
forall a. [a] -> [a] -> [a]
++
          String -> Attributes
cvResponseReason (Response ByteString -> String
forall a. Response a -> String
rspReason Response ByteString
r')
          Attributes -> Attributes -> Attributes
forall a. [a] -> [a] -> [a]
++
          [Header] -> Attributes
cvResponseHeaders (Response ByteString -> [Header]
forall a. Response a -> [Header]
rspHeaders Response ByteString
r')
        where
        cvResponseCode  :: (Int, Int, Int) -> [(String, String)]
        cvResponseCode :: (Int, Int, Int) -> Attributes
cvResponseCode st' :: (Int, Int, Int)
st'
            = [ (String
transferStatus,        Int -> String
forall a. Show a => a -> String
show ((Int, Int, Int) -> Int
convertResponseStatus (Int, Int, Int)
st'))
              , (String
transferVersion,       String
httpVersion)
              ]

        cvResponseReason        :: String -> [(String, String)]
        cvResponseReason :: String -> Attributes
cvResponseReason r'' :: String
r''
            = [ (String
transferMessage, (String -> String
stringTrim String
r'')) ]

        cvResponseHeaders       :: [Header] -> [(String, String)]
        cvResponseHeaders :: [Header] -> Attributes
cvResponseHeaders
            = (Header -> Attributes) -> [Header] -> Attributes
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Header -> Attributes
cvResponseHeader

        cvResponseHeader        :: Header -> [(String, String)]
        cvResponseHeader :: Header -> Attributes
cvResponseHeader (Header name :: HeaderName
name value :: String
value)
            | HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
HdrContentType
                = ( case (Parsec String () Attributes
-> String -> String -> Either ParseError Attributes
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () Attributes
parseContentType (HeaderName -> String
forall a. Show a => a -> String
show HeaderName
HdrContentType) String
value) of
                    Right res :: Attributes
res -> Attributes
res
                    Left  _   -> []
                  )
                  Attributes -> Attributes -> Attributes
forall a. [a] -> [a] -> [a]
++
                  Attributes
addHttpAttr
            | Bool
otherwise
                = Attributes
addHttpAttr
            where
            addHttpAttr :: Attributes
addHttpAttr = [ (String
httpPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ (HeaderName -> String
forall a. Show a => a -> String
show HeaderName
name), String
value) ]


setOption       :: String -> String -> [BrowserAction t ()]
setOption :: String -> String -> [BrowserAction t ()]
setOption k0 :: String
k0 v :: String
v
    | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "max-redirs"
      Bool -> Bool -> Bool
&&
      String -> Bool
isIntArg String
v                        = [Maybe Int -> BrowserAction t ()
forall t. Maybe Int -> BrowserAction t ()
setMaxRedirects (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read String
v)]
    | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "max-redirs"
      Bool -> Bool -> Bool
&&
      String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
v                            = [Maybe Int -> BrowserAction t ()
forall t. Maybe Int -> BrowserAction t ()
setMaxRedirects Maybe Int
forall a. Maybe a
Nothing]

    | Bool
otherwise                         = []
  where
    k :: String
k = String -> String
dropCurlPrefix String
k0

curlPrefix      :: String
curlPrefix :: String
curlPrefix      = "curl--"

dropCurlPrefix :: String -> String
dropCurlPrefix :: String -> String
dropCurlPrefix k :: String
k
  | String
curlPrefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
k  = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
curlPrefix) String
k
  | Bool
otherwise                  = String
k

setHOption      :: String -> String -> [(HeaderName, String)]
setHOption :: String -> String -> [(HeaderName, String)]
setHOption k0 :: String
k0 v :: String
v
    | String
k String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ "-A"
               , "user-agent"
               , "curl--user-agent"
               ]                        = [(HeaderName
HdrUserAgent,         String
v)]
    | String
k String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ "-e"
               , "referer"]             = [(HeaderName
HdrReferer,           String
v)]
    | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
a_if_modified_since          = [(HeaderName
HdrIfModifiedSince,   String
v)]
    | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
a_if_unmodified_since        = [(HeaderName
HdrIfUnmodifiedSince, String
v)]
    | Bool
otherwise                         = []
  where
    k :: String
k = String -> String
dropCurlPrefix String
k0

isIntArg        :: String -> Bool
isIntArg :: String -> Bool
isIntArg s :: String
s      = Bool -> Bool
not (String -> 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

getCurlMaxFileSize :: Attributes -> Maybe Int64
getCurlMaxFileSize :: Attributes -> Maybe Int64
getCurlMaxFileSize options :: Attributes
options
  = (\ s :: String
s -> if String -> Bool
isIntArg String
s
            then Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (String -> Int64
forall a. Read a => String -> a
read String
s)
            else Maybe Int64
forall a. Maybe a
Nothing
    )
    (String -> Maybe Int64)
-> (Attributes -> String) -> Attributes -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe ""
    (Maybe String -> String)
-> (Attributes -> Maybe String) -> Attributes -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String
curlPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ "max-filesize")
    (Attributes -> Maybe Int64) -> Attributes -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ Attributes
options

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