[Pkg-haskell-commits] r706 - in /packages/haskell-http/branches/upstream/current: HTTP.cabal Makefile Network/Browser.hs Network/HTTP.hs README debian/ http.cabal test/
arjan at users.alioth.debian.org
arjan at users.alioth.debian.org
Mon May 28 03:39:30 UTC 2007
Author: arjan
Date: Mon May 28 03:39:30 2007
New Revision: 706
URL: http://svn.debian.org/wsvn/pkg-haskell/?sc=1&rev=706
Log:
[svn-upgrade] Integrating new upstream version, haskell-http (30000000)
Added:
packages/haskell-http/branches/upstream/current/HTTP.cabal
Removed:
packages/haskell-http/branches/upstream/current/Makefile
packages/haskell-http/branches/upstream/current/README
packages/haskell-http/branches/upstream/current/debian/
packages/haskell-http/branches/upstream/current/http.cabal
packages/haskell-http/branches/upstream/current/test/
Modified:
packages/haskell-http/branches/upstream/current/Network/Browser.hs
packages/haskell-http/branches/upstream/current/Network/HTTP.hs
Added: packages/haskell-http/branches/upstream/current/HTTP.cabal
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/branches/upstream/current/HTTP.cabal?rev=706&op=file
==============================================================================
--- packages/haskell-http/branches/upstream/current/HTTP.cabal (added)
+++ packages/haskell-http/branches/upstream/current/HTTP.cabal Mon May 28 03:39:30 2007
@@ -1,0 +1,26 @@
+Name: HTTP
+Version: 3000.0.0
+License: BSD3
+License-file: LICENSE
+Copyright:
+ Copyright (c) 2002, Warrick Gray
+ Copyright (c) 2002-2005, Ian Lynagh
+ Copyright (c) 2003-2006, Bjorn Bringert
+ Copyright (c) 2004, Andre Furtado
+ Copyright (c) 2004, Ganesh Sittampalam
+ Copyright (c) 2004-2005, Dominic Steinitz
+Author: Warrick Gray <warrick.gray at hotmail.com>
+Maintainer: Bjorn Bringert <bjorn at bringert.net>
+Homepage: http://www.haskell.org/http/
+Description: A library for client-side HTTP
+Build-depends: base, network, parsec
+Exposed-modules:
+ Network.Stream,
+ Network.TCP,
+ Network.HTTP,
+ Network.Browser
+Other-modules:
+ Network.HTTP.Base64,
+ Network.HTTP.MD5,
+ Network.HTTP.MD5Aux
+GHC-options: -O -fwarn-missing-signatures
Modified: packages/haskell-http/branches/upstream/current/Network/Browser.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/branches/upstream/current/Network/Browser.hs?rev=706&op=diff
==============================================================================
--- packages/haskell-http/branches/upstream/current/Network/Browser.hs (original)
+++ packages/haskell-http/branches/upstream/current/Network/Browser.hs Mon May 28 03:39:30 2007
@@ -37,6 +37,14 @@
setAllowRedirects,
getAllowRedirects,
+ Authority(..),
+ getAuthorities,
+ setAuthorities,
+ addAuthority,
+ getAuthorityGen,
+ setAuthorityGen,
+ setAllowBasicAuth,
+
setCookieFilter,
defaultCookieFilter,
userCookieFilter,
@@ -90,8 +98,7 @@
; return str
}
-word = many1 (satisfy (\x -> isAlphaNum x || x=='_' || x=='.'))
-
+word = many1 (satisfy (\x -> isAlphaNum x || x=='_' || x=='.' || x=='-' || x==':'))
-- misc string fns
trim :: String -> String
@@ -157,8 +164,10 @@
-
+defaultCookieFilter :: URI -> Cookie -> IO Bool
defaultCookieFilter url cky = return True
+
+userCookieFilter :: URI -> Cookie -> IO Bool
userCookieFilter url cky =
do putStrLn ("Set-Cookie received when requesting: " ++ show url)
case ckComment cky of
@@ -222,14 +231,14 @@
-- all keys in the result list MUST be in lower case
cdetail :: Parser [(String,String)]
cdetail = many $
- do { spaces
+ try (do { spaces
; char ';'
; spaces
; s1 <- word
; spaces
; s2 <- option "" (do { char '=' ; spaces ; v <- cvalue ; return v })
; return (map toLower s1,s2)
- }
+ })
mkCookie :: String -> String -> [(String,String)] -> Cookie
mkCookie nm val more = MkCookie { ckName=nm
@@ -248,7 +257,10 @@
where
fn = filter (not . (==c))
+setCookies :: [Cookie] -> BrowserAction ()
setCookies cs = alterBS (\b -> b { bsCookies=cs })
+
+getCookies :: BrowserAction [Cookie]
getCookies = getBS bsCookies
-- ...get domain specific cookies...
@@ -444,7 +456,7 @@
match (AuthDigest _ _ _ _ _ ds _ _) = or (map matchURI ds)
matchURI :: URI -> Bool
- matchURI s = (authority s == dom) && (path s `isPrefixOf` pth)
+ matchURI s = (uriToAuthorityString s == dom) && (uriPath s `isPrefixOf` pth)
-- | Interacting with browser state:
@@ -479,7 +491,7 @@
anticipateChallenge :: Request -> BrowserAction (Maybe Authority)
anticipateChallenge rq =
let uri = rqURI rq in
- do { authlist <- getAuthFor (authority uri) (path uri)
+ do { authlist <- getAuthFor (uriToAuthorityString uri) (uriPath uri)
; return (listToMaybe authlist)
}
@@ -693,6 +705,7 @@
-- Surely the most important bit:
+request :: Request -> BrowserAction (URI,Response)
request = request' initialState
where
initialState = (0,0,0,True)
@@ -702,7 +715,7 @@
request' (denycount,redirectcount,retrycount,preempt) rq =
do -- add cookies to request
let uri = rqURI rq
- cookies <- getCookiesFor (authority uri) (path uri)
+ cookies <- getCookiesFor (uriToAuthorityString uri) (uriPath uri)
when (not $ null cookies)
(out $ "Adding cookies to request. Cookie names: "
@@ -738,7 +751,7 @@
-- add new cookies to browser state
let cookieheaders = retrieveHeaders HdrSetCookie rsp
- let newcookies = concat (map (headerToCookies $ authority uri) cookieheaders)
+ let newcookies = concat (map (headerToCookies $ uriToAuthorityString uri) cookieheaders)
when (not $ null newcookies)
(out $ foldl (\x y -> x ++ "\n " ++ show y) "Cookies received:" newcookies)
@@ -827,7 +840,7 @@
(Header _ u:_) -> case parseURIReference u of
Just newuri ->
do { out ("Retrying with proxy " ++ show newuri ++ "...")
- ; setProxy (Proxy (authority newuri) Nothing)
+ ; setProxy (Proxy (uriToAuthorityString newuri) Nothing)
; request' (0,0,retrycount+1,True) rq
}
Nothing ->
@@ -914,6 +927,10 @@
. (regname++)
. (port++)) ""
+-- This function duplicates old Network.URI.authority behaviour.
+uriToAuthorityString :: URI -> String
+uriToAuthorityString u = maybe "" uriAuthToString (uriAuthority u)
+
------------------------------------------------------------------
@@ -923,6 +940,7 @@
libUA = "haskell-libwww/0.1"
+defaultGETRequest :: URI -> Request
defaultGETRequest uri =
Request { rqURI=uri
, rqBody=""
@@ -951,7 +969,8 @@
, rqURI=u { uriQuery= '?' : enc } -- What about old query?
}
POST -> Request { rqMethod=POST
- , rqHeaders=[ Header HdrContentLength (show $ length enc) ]
+ , rqHeaders=[ Header HdrContentType "application/x-www-form-urlencoded",
+ Header HdrContentLength (show $ length enc) ]
, rqBody=enc
, rqURI=u
}
Modified: packages/haskell-http/branches/upstream/current/Network/HTTP.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/branches/upstream/current/Network/HTTP.hs?rev=706&op=diff
==============================================================================
--- packages/haskell-http/branches/upstream/current/Network/HTTP.hs (original)
+++ packages/haskell-http/branches/upstream/current/Network/HTTP.hs Mon May 28 03:39:30 2007
@@ -724,7 +724,7 @@
++ auth ++ "'"
where auth = case findHeader HdrHost r of
Just h -> h
- Nothing -> authority (rqURI r)
+ Nothing -> uriToAuthorityString (rqURI r)
sendHTTP :: Stream s => s -> Request -> IO (Result Response)
sendHTTP conn rq =
@@ -834,7 +834,7 @@
fixHostHeader :: Request -> Request
fixHostHeader rq =
let uri = rqURI rq
- host = authority uri
+ host = uriToAuthorityString uri
in insertHeaderIfMissing HdrHost host rq
-- Looks for a "Connection" header with the value "close".
@@ -844,6 +844,13 @@
case lookupHeader HdrConnection hdrs of
Nothing -> False
Just x -> map toLower (trim x) == "close"
+
+-- This function duplicates old Network.URI.authority behaviour.
+uriToAuthorityString :: URI -> String
+uriToAuthorityString URI{uriAuthority=Nothing} = ""
+uriToAuthorityString URI{uriAuthority=Just ua} = uriUserInfo ua ++
+ uriRegName ua ++
+ uriPort ua
-- | Receive and parse a HTTP request from the given Stream. Should be used
-- for server side interactions.
More information about the Pkg-haskell-commits
mailing list