hxt-http-9.1.5.2/0000755000000000000000000000000012465166667011657 5ustar0000000000000000hxt-http-9.1.5.2/Setup.lhs0000644000000000000000000000015712465166667013472 0ustar0000000000000000#!/usr/bin/runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain hxt-http-9.1.5.2/hxt-http.cabal0000644000000000000000000000332712465166667014430 0ustar0000000000000000Name: hxt-http Version: 9.1.5.2 Synopsis: Interface to native Haskell HTTP package HTTP Description: Interface to native Haskell HTTP package HTTP. This package can be used as alternative for the hxt-curl package for accessing documents via HTTP. . Changes from 9.1.3: Works with ghc-7.10 . Changes to 9.1.3: New warnings from ghc-7.4 removed License: MIT License-file: LICENSE Author: Uwe Schmidt Maintainer: Uwe Schmidt Stability: Experimental Category: XML Homepage: https://github.com/UweSchmidt/hxt Copyright: Copyright (c) 2011 Uwe Schmidt Build-type: Simple Cabal-version: >=1.6 flag network-uri description: Get Network.URI from the network-uri package, with ghc < 7.10 default is False, with ghc >= 7.10 default is True default: False library exposed-modules: Text.XML.HXT.HTTP other-modules: Text.XML.HXT.Arrow.LibHTTPInput, Text.XML.HXT.IO.GetHTTPNative hs-source-dirs: src ghc-options: -Wall ghc-prof-options: -caf-all extensions: build-depends: base >= 4 && < 5, parsec >= 2.1 && < 4, bytestring >= 0.9 && < 1, HTTP >= 4000 && < 5000, hxt >= 9.1 && < 10 if flag(network-uri) build-depends: network-uri >= 2.6, network >= 2.6 else if impl(ghc >= 7.10) build-depends: network-uri >= 2.6, network >= 2.6 else build-depends: network >= 2.4 && < 2.6 Source-Repository head Type: git Location: git://github.com/UweSchmidt/hxt.git hxt-http-9.1.5.2/LICENSE0000644000000000000000000000212012465166667012657 0ustar0000000000000000The MIT License Copyright (c) 2005 Uwe Schmidt, Martin Schmidt, Torben Kuseler Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. hxt-http-9.1.5.2/src/0000755000000000000000000000000012465166667012446 5ustar0000000000000000hxt-http-9.1.5.2/src/Text/0000755000000000000000000000000012465166667013372 5ustar0000000000000000hxt-http-9.1.5.2/src/Text/XML/0000755000000000000000000000000012465166667014032 5ustar0000000000000000hxt-http-9.1.5.2/src/Text/XML/HXT/0000755000000000000000000000000012465166667014475 5ustar0000000000000000hxt-http-9.1.5.2/src/Text/XML/HXT/HTTP.hs0000644000000000000000000000105312465166667015607 0ustar0000000000000000-- ------------------------------------------------------------ {- | Module : Text.XML.HXT.Curl Copyright : Copyright (C) 2010 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : stable Portability: portable libcurl input -} -- ------------------------------------------------------------ module Text.XML.HXT.HTTP ( getHTTPNativeContents , withHTTP , httpOptions ) where import Text.XML.HXT.Arrow.LibHTTPInput -- ---------------------------------------------------------- hxt-http-9.1.5.2/src/Text/XML/HXT/IO/0000755000000000000000000000000012465166667015004 5ustar0000000000000000hxt-http-9.1.5.2/src/Text/XML/HXT/IO/GetHTTPNative.hs0000644000000000000000000002167712465166667017743 0ustar0000000000000000-- ------------------------------------------------------------ {- | 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 strictInput proxy uri redirect options = do res <- try (getHttp False uri1 proxy redirect options) either processError processResponse res where uri1 = fromJust (parseURIReference uri) processError e = return $ Left ( [ (transferStatus, "999") , (transferMessage, "HTTP library error") ] , "http error when requesting URI " ++ show uri ++ ": " ++ ioeGetErrorString e ++ " (perhaps server does not understand HTTP/1.1) " ) processResponse response | ( (rc >= 200 && rc < 300) || rc == 304 -- not modified is o.k., this rc only occurs together with if-modified-since ) && fileSizeOK = do if strictInput then B.length cs `seq` return res else return res | not fileSizeOK = return $ ers "999 max-filesize exceeded" | otherwise = return $ ers (show rc ++ " " ++ rr) where fileSizeOK = case getCurlMaxFileSize options of Nothing -> True Just mx -> B.length cs <= mx rc = convertResponseStatus $ rspCode response rr = rspReason response res = Right (rs, cs) ers e = Left (rs, "http error when accessing URI " ++ show uri ++ ": " ++ e) rs = rst ++ rsh rst = [ (transferStatus, show rc) , (transferMessage, rr) ] rsh = convertResponseHeaders response cs = rspBody response getHttp :: Bool -> URI -> String -> Bool -> Attributes -> IO (Response B.ByteString) getHttp trc' uri' proxy' redirect' options' = withSocketsDo $ browse ( do sequence_ configHttp (_ruri, rsp) <- request $ theRequest return rsp ) where theRequest :: Request B.ByteString theRequest = configHeaders $ defaultGETRequest_ uri' configHeaders :: Request B.ByteString -> Request B.ByteString configHeaders = foldr (>>>) id . map (uncurry replaceHeader) . concatMap (uncurry setHOption) $ options' configHttp = setOutHandler (trcFct) : setErrHandler (trcFct) : ( if null proxy' then return () else setProxy (Proxy proxy' Nothing) ) : setAllowRedirects redirect' : concatMap (uncurry setOption) options' trcFct s | trc' = hPutStrLn stderr ("-- (5) http: " ++ s) | otherwise = return () convertResponseStatus :: (Int, Int, Int) -> Int convertResponseStatus (a, b, c) = 100 * a + 10 * b + c convertResponseHeaders :: Response B.ByteString -> [(String, String)] convertResponseHeaders r' = cvResponseCode (rspCode r') ++ cvResponseReason (rspReason r') ++ cvResponseHeaders (rspHeaders r') where cvResponseCode :: (Int, Int, Int) -> [(String, String)] cvResponseCode st' = [ (transferStatus, show (convertResponseStatus st')) , (transferVersion, httpVersion) ] cvResponseReason :: String -> [(String, String)] cvResponseReason r'' = [ (transferMessage, (stringTrim r'')) ] cvResponseHeaders :: [Header] -> [(String, String)] cvResponseHeaders = concatMap cvResponseHeader cvResponseHeader :: Header -> [(String, String)] cvResponseHeader (Header name value) | name == HdrContentType = ( case (parse parseContentType (show HdrContentType) value) of Right res -> res Left _ -> [] ) ++ addHttpAttr | otherwise = addHttpAttr where addHttpAttr = [ (httpPrefix ++ (show name), value) ] setOption :: String -> String -> [BrowserAction t ()] setOption k0 v | k == "max-redirs" && isIntArg v = [setMaxRedirects (Just $ read v)] | k == "max-redirs" && null v = [setMaxRedirects Nothing] | otherwise = [] where k = dropCurlPrefix k0 curlPrefix :: String curlPrefix = "curl--" dropCurlPrefix :: String -> String dropCurlPrefix k | curlPrefix `isPrefixOf` k = drop (length curlPrefix) k | otherwise = k setHOption :: String -> String -> [(HeaderName, String)] setHOption k0 v | k `elem` [ "-A" , "user-agent" , "curl--user-agent" ] = [(HdrUserAgent, v)] | k `elem` [ "-e" , "referer"] = [(HdrReferer, v)] | k == a_if_modified_since = [(HdrIfModifiedSince, v)] | k == a_if_unmodified_since = [(HdrIfUnmodifiedSince, v)] | otherwise = [] where k = dropCurlPrefix k0 isIntArg :: String -> Bool isIntArg s = not (null s) && all isDigit s getCurlMaxFileSize :: Attributes -> Maybe Int64 getCurlMaxFileSize options = (\ s -> if isIntArg s then Just (read s) else Nothing ) . fromMaybe "" . lookup (curlPrefix ++ "max-filesize") $ options -- ------------------------------------------------------------ hxt-http-9.1.5.2/src/Text/XML/HXT/Arrow/0000755000000000000000000000000012465166667015567 5ustar0000000000000000hxt-http-9.1.5.2/src/Text/XML/HXT/Arrow/LibHTTPInput.hs0000644000000000000000000000545312465166667020360 0ustar0000000000000000-- ------------------------------------------------------------ {- | Module : Text.XML.HXT.Arrow.LibCurlInput Copyright : Copyright (C) 2005 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : experimental Portability: portable libcurl input -} -- ------------------------------------------------------------ module Text.XML.HXT.Arrow.LibHTTPInput ( getHTTPNativeContents , withHTTP , httpOptions ) where import Control.Arrow import Control.Arrow.ArrowIO import Control.Arrow.ArrowList import Control.Arrow.ArrowTree import qualified Data.ByteString.Lazy as B -- import qualified Data.ByteString.Lazy.Char8 as C import System.Console.GetOpt import Text.XML.HXT.Arrow.DocumentInput (addInputError) import Text.XML.HXT.IO.GetHTTPNative (getCont) import Text.XML.HXT.DOM.Interface import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.XmlState import Text.XML.HXT.Arrow.XmlState.TypeDefs -- ---------------------------------------------------------- getHTTPNativeContents :: IOSArrow XmlTree XmlTree getHTTPNativeContents = getC $<< ( getAttrValue transferURI &&& getSysVar (theInputOptions .&&&. theProxy .&&&. theStrictInput .&&&. theRedirect ) ) where getC uri (options, (proxy, (strictInput, redirect))) = applyA ( ( traceMsg 2 ( "get HTTP via native HTTP interface, uri=" ++ show uri ++ " options=" ++ show options ) >>> arrIO0 (getCont strictInput proxy uri redirect options) ) >>> ( arr (uncurry addInputError) ||| arr addContent ) ) addContent :: (Attributes, B.ByteString) -> IOSArrow XmlTree XmlTree addContent (al, bc) = replaceChildren (blb bc) -- add the contents >>> seqA (map (uncurry addAttr) al) -- add the meta info (HTTP headers, ...) -- ------------------------------------------------------------ a_use_http :: String a_use_http = "use-http" withHTTP :: Attributes -> SysConfig withHTTP httpOpts = setS theHttpHandler getHTTPNativeContents >>> withInputOptions httpOpts httpOptions :: [OptDescr SysConfig] httpOptions = [ Option "" [a_use_http] (NoArg (withHTTP [])) "enable HTTP input with native Haskell HTTP package" ] -- ------------------------------------------------------------