[Pkg-haskell-commits] r876 - in /packages/haskell-http/trunk: ./ Network/ Network/HTTP/ debian/
arjan at users.alioth.debian.org
arjan at users.alioth.debian.org
Sun Dec 30 19:55:10 UTC 2007
Author: arjan
Date: Sun Dec 30 19:55:10 2007
New Revision: 876
URL: http://svn.debian.org/wsvn/pkg-haskell/?sc=1&rev=876
Log:
* New upstream release
Added:
packages/haskell-http/trunk/Network/HTTP/Headers.hs
- copied unchanged from r875, packages/haskell-http/branches/upstream/current/Network/HTTP/Headers.hs
packages/haskell-http/trunk/Network/StreamDebugger.hs
- copied unchanged from r875, packages/haskell-http/branches/upstream/current/Network/StreamDebugger.hs
packages/haskell-http/trunk/Network/StreamSocket.hs
- copied unchanged from r875, packages/haskell-http/branches/upstream/current/Network/StreamSocket.hs
Modified:
packages/haskell-http/trunk/HTTP.cabal
packages/haskell-http/trunk/Network/Browser.hs
packages/haskell-http/trunk/Network/HTTP.hs
packages/haskell-http/trunk/Network/HTTP/Base64.hs
packages/haskell-http/trunk/Network/HTTP/MD5.hs
packages/haskell-http/trunk/Network/HTTP/MD5Aux.hs
packages/haskell-http/trunk/Network/Stream.hs
packages/haskell-http/trunk/Network/TCP.hs
packages/haskell-http/trunk/debian/changelog
packages/haskell-http/trunk/debian/copyright
Modified: packages/haskell-http/trunk/HTTP.cabal
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/trunk/HTTP.cabal?rev=876&op=diff
==============================================================================
--- packages/haskell-http/trunk/HTTP.cabal (original)
+++ packages/haskell-http/trunk/HTTP.cabal Sun Dec 30 19:55:10 2007
@@ -1,5 +1,7 @@
Name: HTTP
-Version: 3000.0.0
+Version: 3001.0.4
+Cabal-Version: >= 1.2
+Build-type: Simple
License: BSD3
License-file: LICENSE
Copyright:
@@ -9,18 +11,33 @@
Copyright (c) 2004, Andre Furtado
Copyright (c) 2004, Ganesh Sittampalam
Copyright (c) 2004-2005, Dominic Steinitz
+ Copyright 2007 Robin Bate Boerop
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:
+
+Flag old-base
+ description: Old, monolithic base
+ default: False
+
+Library
+ Exposed-modules:
Network.Stream,
+ Network.StreamDebugger,
+ Network.StreamSocket,
Network.TCP,
- Network.HTTP,
+ Network.HTTP,
+ Network.HTTP.Headers,
Network.Browser
-Other-modules:
+ Other-modules:
Network.HTTP.Base64,
Network.HTTP.MD5,
Network.HTTP.MD5Aux
-GHC-options: -O -fwarn-missing-signatures
+ GHC-options: -fwarn-missing-signatures
+ Build-depends: network, parsec
+
+ if flag(old-base)
+ Build-depends: base < 3
+ else
+ Build-depends: base >= 3, array
Modified: packages/haskell-http/trunk/Network/Browser.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/trunk/Network/Browser.hs?rev=876&op=diff
==============================================================================
--- packages/haskell-http/trunk/Network/Browser.hs (original)
+++ packages/haskell-http/trunk/Network/Browser.hs Sun Dec 30 19:55:10 2007
@@ -12,6 +12,10 @@
-----------------------------------------------------------------------------
{-
+ Changes by Robin Bate Boerop <robin at bateboerop.name>:
+ - Made dependencies explicit in import statements.
+ - Added type signatures.
+ - Imported new StreamDebugger module.
Change Log:
- altered 'closeTCP' to 'close', for consistency with altered HTTP
@@ -70,19 +74,31 @@
uriTrimHost
) where
+import Network.URI
+ ( URI(uriAuthority, uriScheme, uriPath, uriQuery)
+ , URIAuth(URIAuth, uriUserInfo, uriPort, uriRegName)
+ , parseURI, parseURIReference, relativeTo
+ )
+import Network.StreamDebugger (debugStream)
+import Network.TCP (Connection, isConnectedTo)
import Network.HTTP
+import qualified Network.HTTP.MD5 as MD5 (hash)
+import qualified Network.HTTP.Base64 as Base64 (encode)
import Data.Char (toLower,isAlphaNum,isSpace)
import Data.List (isPrefixOf,isSuffixOf,elemIndex,elemIndices)
-import Data.Maybe
-import Control.Monad (foldM,filterM,liftM,when)
+import Data.Maybe (fromMaybe, listToMaybe, catMaybes, fromJust, isJust)
+import Control.Monad (foldM, filterM, liftM, when)
import Text.ParserCombinators.Parsec
-import Network.URI
-
+ ( Parser, char, many, many1, satisfy, parse, option, try
+ , (<|>), spaces, sepBy1
+ )
import qualified System.IO
+ ( hSetBuffering, hPutStr, stdout, stdin, hGetChar
+ , BufferMode(NoBuffering, LineBuffering)
+ )
import Data.Word (Word8)
-import qualified Network.HTTP.MD5 as MD5
-import qualified Network.HTTP.Base64 as Base64
+
type Octet = Word8
@@ -363,6 +379,7 @@
challenge :: Parser (String,[(String,String)])
challenge =
do { nme <- word
+ ; spaces
; pps <- cprops
; return (map toLower nme,pps)
}
@@ -543,9 +560,9 @@
withAuthority :: Authority -> Request -> String
withAuthority a rq = case a of
AuthBasic _ _ user pass ->
- "basic " ++ base64encode (auUsername a ++ ':' : auPassword a)
+ "Basic " ++ base64encode (auUsername a ++ ':' : auPassword a)
AuthDigest _ _ _ _ _ _ _ _ ->
- "digest username=\"" ++ auUsername a
+ "Digest username=\"" ++ auUsername a
++ "\",realm=\"" ++ auRealm a
++ "\",nonce=\"" ++ auNonce a
++ "\",uri=\"" ++ digesturi
@@ -593,8 +610,9 @@
------------------ Proxy Stuff -----------------------------------
------------------------------------------------------------------
-data Proxy = NoProxy
- | Proxy String (Maybe Authority)
+-- | Specifies if a proxy should be used for the request.
+data Proxy = NoProxy -- ^ Don't use a proxy.
+ | Proxy String (Maybe Authority) -- ^ Use the proxy given. Should be of the form "http:\/\/host:port", "host", "host:port", or "http:\/\/host"
------------------------------------------------------------------
@@ -740,8 +758,24 @@
let rq''' = case ath of
Nothing -> rq''
Just x -> insertHeader HdrProxyAuthorization (withAuthority x rq'') rq''
- in dorequest (URIAuth "" str "") rq'''
-
+ -- Proxy can take multiple forms - look for http://host:port first,
+ -- then host:port. Fall back to just the string given (probably a host name).
+ proxyURIAuth =
+ maybe notURI
+ (\parsed -> maybe notURI
+ id (uriAuthority parsed))
+ (parseURI str)
+ notURI =
+ -- If the ':' is dropped from port below, dorequest will assume port 80. Leave it!
+ let (host, port) = span (':'/=) str
+ in
+ if null port || null host
+ then URIAuth "" str ""
+ else URIAuth "" host port
+ in
+ do
+ out $ "proxy uri host: " ++ uriRegName proxyURIAuth ++ ", port: " ++ uriPort proxyURIAuth
+ dorequest proxyURIAuth rq'''
case e_rsp of
Left v -> if (retrycount < 4) && (v == ErrorReset || v == ErrorClosed)
then request' (denycount,redirectcount,retrycount+1,preempt) rq
@@ -914,6 +948,7 @@
+uriAuth :: URI -> URIAuth
uriAuth x = case uriAuthority x of
Just ua -> ua
_ -> error ("No uri authority for: "++show x)
@@ -938,6 +973,7 @@
------------------------------------------------------------------
+libUA :: String
libUA = "haskell-libwww/0.1"
defaultGETRequest :: URI -> Request
Modified: packages/haskell-http/trunk/Network/HTTP.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/trunk/Network/HTTP.hs?rev=876&op=diff
==============================================================================
--- packages/haskell-http/trunk/Network/HTTP.hs (original)
+++ packages/haskell-http/trunk/Network/HTTP.hs Sun Dec 30 19:55:10 2007
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------------
-- |
-- Module : Network.HTTP
--- Copyright : (c) Warrick Gray 2002, Bjorn Bringert 2003-2005
+-- Copyright : (c) Warrick Gray 2002, Bjorn Bringert 2003-2005, 2007 Robin Bate Boerop
-- License : BSD
--
-- Maintainer : bjorn at bringert.net
@@ -9,6 +9,12 @@
-- Portability : non-portable (not tested)
--
-- An easy HTTP interface enjoy.
+--
+-- * Changes by Robin Bate Boerop <robin at bateboerop.name>:
+-- - Made dependencies explicit in import statements.
+-- - Removed false dependencies in import statements.
+-- - Added missing type signatures.
+-- - Moved Header-related code to Network.HTTP.Headers module.
--
-- * Changes by Simon Foster:
-- - Split module up into to sepearate Network.[Stream,TCP,HTTP] modules
@@ -98,21 +104,14 @@
Request(..),
Response(..),
RequestMethod(..),
+ ResponseCode,
simpleHTTP, simpleHTTP_,
sendHTTP,
receiveHTTP,
respondHTTP,
-- ** Header Functions
- HasHeaders,
- Header(..),
- HeaderName(..),
- insertHeader,
- insertHeaderIfMissing,
- insertHeaders,
- retrieveHeaders,
- replaceHeader,
- findHeader,
+ module Network.HTTP.Headers,
-- ** URL Encoding
urlEncode,
@@ -125,40 +124,30 @@
) where
-
-----------------------------------------------------------------
------------------ Imports --------------------------------------
-----------------------------------------------------------------
-import Control.Exception as Exception
-
--- Networking
-import Network (withSocketsDo)
-import Network.BSD
import Network.URI
-import Network.Socket
+ ( URI(URI, uriScheme, uriAuthority, uriPath)
+ , URIAuth(uriUserInfo, uriRegName, uriPort)
+ , parseURIReference
+ )
+import Network.HTTP.Headers
import Network.Stream
-import Network.TCP
-
-
--- Util
+import Network.StreamDebugger (debugStream)
+import Network.TCP (openTCPPort)
+
+import Control.Exception as Exception (catch, throw)
import Data.Bits ((.&.))
-import Data.Char
-import Data.List (isPrefixOf,partition,elemIndex)
-import Data.Maybe
-import Data.Array.MArray
-import Data.IORef
-import Control.Concurrent
-import Control.Monad (when,liftM,guard)
-import Control.Monad.ST (ST,stToIO)
+import Data.Char (isSpace, intToDigit, digitToInt, ord, chr, toLower)
+import Data.List (partition)
+import Data.Maybe (listToMaybe, fromMaybe)
+import Control.Monad (when, guard)
import Numeric (readHex)
+import Text.Read.Lex (readDecP)
import Text.ParserCombinators.ReadP
-import Text.Read.Lex
-import System.IO
-import System.IO.Error (isEOFError)
-import qualified System.IO.Error
-
-import Foreign.C.Error
+ ( ReadP, readP_to_S, char, (<++), look, munch )
-- Turn on to enable HTTP traffic logging
@@ -179,16 +168,7 @@
reverse . dropspace . reverse . dropspace
--- Split a list into two parts, the delimiter occurs
--- at the head of the second list. Nothing is returned
--- when no occurance of the delimiter is found.
-split :: Eq a => a -> [a] -> Maybe ([a],[a])
-split delim list = case delim `elemIndex` list of
- Nothing -> Nothing
- Just x -> Just $ splitAt x list
-
-
-
+crlf, sp :: String
crlf = "\r\n"
sp = " "
@@ -235,229 +215,6 @@
orNothing p = fmap Just p <++ return Nothing
-----------------------------------------------------------------
------------------- Header Data ----------------------------------
------------------------------------------------------------------
-
-
--- | The Header data type pairs header names & values.
-data Header = Header HeaderName String
-
-
-instance Show Header where
- show (Header key value) = show key ++ ": " ++ value ++ crlf
-
-
--- | HTTP Header Name type:
--- Why include this at all? I have some reasons
--- 1) prevent spelling errors of header names,
--- 2) remind everyone of what headers are available,
--- 3) might speed up searches for specific headers.
---
--- Arguments against:
--- 1) makes customising header names laborious
--- 2) increases code volume.
---
-data HeaderName =
- -- Generic Headers --
- HdrCacheControl
- | HdrConnection
- | HdrDate
- | HdrPragma
- | HdrTransferEncoding
- | HdrUpgrade
- | HdrVia
-
- -- Request Headers --
- | HdrAccept
- | HdrAcceptCharset
- | HdrAcceptEncoding
- | HdrAcceptLanguage
- | HdrAuthorization
- | HdrCookie
- | HdrExpect
- | HdrFrom
- | HdrHost
- | HdrIfModifiedSince
- | HdrIfMatch
- | HdrIfNoneMatch
- | HdrIfRange
- | HdrIfUnmodifiedSince
- | HdrMaxForwards
- | HdrProxyAuthorization
- | HdrRange
- | HdrReferer
- | HdrUserAgent
-
- -- Response Headers
- | HdrAge
- | HdrLocation
- | HdrProxyAuthenticate
- | HdrPublic
- | HdrRetryAfter
- | HdrServer
- | HdrSetCookie
- | HdrVary
- | HdrWarning
- | HdrWWWAuthenticate
-
- -- Entity Headers
- | HdrAllow
- | HdrContentBase
- | HdrContentEncoding
- | HdrContentLanguage
- | HdrContentLength
- | HdrContentLocation
- | HdrContentMD5
- | HdrContentRange
- | HdrContentType
- | HdrETag
- | HdrExpires
- | HdrLastModified
-
- -- Mime entity headers (for sub-parts)
- | HdrContentTransferEncoding
-
- -- | Allows for unrecognised or experimental headers.
- | HdrCustom String -- not in header map below.
- deriving(Eq)
-
-
--- Translation between header names and values,
--- good candidate for improvement.
-headerMap :: [ (String,HeaderName) ]
-headerMap
- = [ ("Cache-Control" ,HdrCacheControl )
- , ("Connection" ,HdrConnection )
- , ("Date" ,HdrDate )
- , ("Pragma" ,HdrPragma )
- , ("Transfer-Encoding" ,HdrTransferEncoding )
- , ("Upgrade" ,HdrUpgrade )
- , ("Via" ,HdrVia )
- , ("Accept" ,HdrAccept )
- , ("Accept-Charset" ,HdrAcceptCharset )
- , ("Accept-Encoding" ,HdrAcceptEncoding )
- , ("Accept-Language" ,HdrAcceptLanguage )
- , ("Authorization" ,HdrAuthorization )
- , ("From" ,HdrFrom )
- , ("Host" ,HdrHost )
- , ("If-Modified-Since" ,HdrIfModifiedSince )
- , ("If-Match" ,HdrIfMatch )
- , ("If-None-Match" ,HdrIfNoneMatch )
- , ("If-Range" ,HdrIfRange )
- , ("If-Unmodified-Since" ,HdrIfUnmodifiedSince )
- , ("Max-Forwards" ,HdrMaxForwards )
- , ("Proxy-Authorization" ,HdrProxyAuthorization)
- , ("Range" ,HdrRange )
- , ("Referer" ,HdrReferer )
- , ("User-Agent" ,HdrUserAgent )
- , ("Age" ,HdrAge )
- , ("Location" ,HdrLocation )
- , ("Proxy-Authenticate" ,HdrProxyAuthenticate )
- , ("Public" ,HdrPublic )
- , ("Retry-After" ,HdrRetryAfter )
- , ("Server" ,HdrServer )
- , ("Vary" ,HdrVary )
- , ("Warning" ,HdrWarning )
- , ("WWW-Authenticate" ,HdrWWWAuthenticate )
- , ("Allow" ,HdrAllow )
- , ("Content-Base" ,HdrContentBase )
- , ("Content-Encoding" ,HdrContentEncoding )
- , ("Content-Language" ,HdrContentLanguage )
- , ("Content-Length" ,HdrContentLength )
- , ("Content-Location" ,HdrContentLocation )
- , ("Content-MD5" ,HdrContentMD5 )
- , ("Content-Range" ,HdrContentRange )
- , ("Content-Type" ,HdrContentType )
- , ("ETag" ,HdrETag )
- , ("Expires" ,HdrExpires )
- , ("Last-Modified" ,HdrLastModified )
- , ("Set-Cookie" ,HdrSetCookie )
- , ("Cookie" ,HdrCookie )
- , ("Expect" ,HdrExpect ) ]
-
-
-instance Show HeaderName where
- show (HdrCustom s) = s
- show x = case filter ((==x).snd) headerMap of
- [] -> error "headerMap incomplete"
- (h:_) -> fst h
-
-
-
-
-
--- | This class allows us to write generic header manipulation functions
--- for both 'Request' and 'Response' data types.
-class HasHeaders x where
- getHeaders :: x -> [Header]
- setHeaders :: x -> [Header] -> x
-
-
-
--- Header manipulation functions
-insertHeader, replaceHeader, insertHeaderIfMissing
- :: HasHeaders a => HeaderName -> String -> a -> a
-
-
--- | Inserts a header with the given name and value.
--- Allows duplicate header names.
-insertHeader name value x = setHeaders x newHeaders
- where
- newHeaders = (Header name value) : getHeaders x
-
-
--- | Adds the new header only if no previous header shares
--- the same name.
-insertHeaderIfMissing name value x = setHeaders x (newHeaders $ getHeaders x)
- where
- newHeaders list@(h@(Header n _): rest)
- | n == name = list
- | otherwise = h : newHeaders rest
- newHeaders [] = [Header name value]
-
-
-
--- | Removes old headers with duplicate name.
-replaceHeader name value x = setHeaders x newHeaders
- where
- newHeaders = Header name value : [ x | x@(Header n v) <- getHeaders x, name /= n ]
-
-
--- | Inserts multiple headers.
-insertHeaders :: HasHeaders a => [Header] -> a -> a
-insertHeaders hdrs x = setHeaders x (getHeaders x ++ hdrs)
-
-
--- | Gets a list of headers with a particular 'HeaderName'.
-retrieveHeaders :: HasHeaders a => HeaderName -> a -> [Header]
-retrieveHeaders name x = filter matchname (getHeaders x)
- where
- matchname (Header n _) | n == name = True
- matchname _ = False
-
-
--- | Lookup presence of specific HeaderName in a list of Headers
--- Returns the value from the first matching header.
-findHeader :: HasHeaders a => HeaderName -> a -> Maybe String
-findHeader n x = lookupHeader n (getHeaders x)
-
--- An anomally really:
-lookupHeader :: HeaderName -> [Header] -> Maybe String
-lookupHeader v (Header n s:t) | v == n = Just s
- | otherwise = lookupHeader v t
-lookupHeader _ _ = Nothing
-
-
-
-
-{-
-instance HasHeaders [Header]
-...requires -fglasgow-exts, and is not really necessary anyway...
--}
-
-
-
------------------------------------------------------------------
------------------ HTTP Messages --------------------------------
-----------------------------------------------------------------
@@ -470,13 +227,15 @@
-- | The HTTP request method, to be used in the 'Request' object.
-- We are missing a few of the stranger methods, but these are
-- not really necessary until we add full TLS.
-data RequestMethod = HEAD | PUT | GET | POST | OPTIONS | TRACE
+data RequestMethod = HEAD | PUT | GET | POST | DELETE | OPTIONS | TRACE
deriving(Show,Eq)
+rqMethodMap :: [(String, RequestMethod)]
rqMethodMap = [("HEAD", HEAD),
("PUT", PUT),
("GET", GET),
("POST", POST),
+ ("DELETE", DELETE),
("OPTIONS", OPTIONS),
("TRACE", TRACE)]
@@ -496,7 +255,6 @@
-
-- Notice that request body is not included,
-- this show function is used to serialise
-- a request for the transport link, we send
@@ -510,15 +268,9 @@
then u { uriPath = '/' : uriPath u }
else u
-
instance HasHeaders Request where
getHeaders = rqHeaders
setHeaders rq hdrs = rq { rqHeaders=hdrs }
-
-
-
-
-
type ResponseCode = (Int,Int,Int)
type ResponseData = (ResponseCode,String,[Header])
@@ -536,8 +288,6 @@
, rspBody :: String
}
-
-
-- This is an invalid representation of a received response,
-- since we have made the assumption that all responses are HTTP/1.1
instance Show Response where
@@ -545,8 +295,6 @@
httpVersion ++ ' ' : map intToDigit [a,b,c] ++ ' ' : reason ++ crlf
++ foldr (++) [] (map show headers) ++ crlf
-
-
instance HasHeaders Response where
getHeaders = rspHeaders
setHeaders rsp hdrs = rsp { rspHeaders=hdrs }
@@ -554,46 +302,6 @@
-----------------------------------------------------------------
------------------ Parsing --------------------------------------
-----------------------------------------------------------------
-
-parseHeader :: String -> Result Header
-parseHeader str =
- case split ':' str of
- Nothing -> Left (ErrorParse $ "Unable to parse header: " ++ str)
- Just (k,v) -> Right $ Header (fn k) (trim $ drop 1 v)
- where
- fn k = case map snd $ filter (match k . fst) headerMap of
- [] -> (HdrCustom k)
- (h:_) -> h
-
- match :: String -> String -> Bool
- match s1 s2 = map toLower s1 == map toLower s2
-
-
-parseHeaders :: [String] -> Result [Header]
-parseHeaders = catRslts [] . map (parseHeader . clean) . joinExtended ""
- where
- -- Joins consecutive lines where the second line
- -- begins with ' ' or '\t'.
- joinExtended old (h : t)
- | not (null h) && (head h == ' ' || head h == '\t')
- = joinExtended (old ++ ' ' : tail h) t
- | otherwise = old : joinExtended h t
- joinExtended old [] = [old]
-
- clean [] = []
- clean (h:t) | h `elem` "\t\r\n" = ' ' : clean t
- | otherwise = h : clean t
-
- -- tollerant of errors? should parse
- -- errors here be reported or ignored?
- -- currently ignored.
- catRslts :: [a] -> [Result a] -> Result [a]
- catRslts list (h:t) =
- case h of
- Left _ -> catRslts list t
- Right v -> catRslts (v:list) t
- catRslts list [] = Right $ reverse list
-
-- Parsing a request
parseRequestHead :: [String] -> Result RequestData
@@ -646,10 +354,6 @@
| Done
| ExpectEntity
| DieHorribly String
-
-
-
-
matchResponse :: RequestMethod -> ResponseCode -> Behaviour
matchResponse rqst rsp =
@@ -926,7 +630,7 @@
= readLine conn >>= \v -> case v of
Left e -> return (Left e)
Right line ->
- let size = ( if null line || (head line) == '0'
+ let size = ( if null line
then 0
else case readHex line of
(n,_):_ -> n
Modified: packages/haskell-http/trunk/Network/HTTP/Base64.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/trunk/Network/HTTP/Base64.hs?rev=876&op=diff
==============================================================================
--- packages/haskell-http/trunk/Network/HTTP/Base64.hs (original)
+++ packages/haskell-http/trunk/Network/HTTP/Base64.hs Sun Dec 30 19:55:10 2007
@@ -14,13 +14,12 @@
--
-----------------------------------------------------------------------------
-module Network.HTTP.Base64 (
- encode,
- decode,
- chop72
-) where
-
-
+module Network.HTTP.Base64
+ ( encode
+ , decode
+ , chop72
+ , Octet
+ ) where
{------------------------------------------------------------------------
This is what RFC2045 had to say:
@@ -135,9 +134,7 @@
delimiters within base64-encoded bodies within multipart entities
because no hyphen characters are used in the base64 encoding.
-
----------------------------------------------------------------------------}
-
{-
@@ -151,18 +148,14 @@
MIME applications might be undesireable.
-
But: The Haskell98 Char type is at least 16bits (and often 32), these implementations assume only
8 significant bits, which is more than enough for US-ASCII.
-}
-
-
-import Data.Array
-import Data.Bits
-import Data.Int
-import Data.Char (chr,ord)
+import Data.Array (Array, array, (!))
+import Data.Bits (shiftL, shiftR, (.&.), (.|.))
+import Data.Char (chr, ord)
import Data.Word (Word8)
type Octet = Word8
@@ -245,6 +238,7 @@
-- Pads a base64 code to a multiple of 4 characters, using the special
-- '=' character.
+quadruplets :: [Char] -> [Char]
quadruplets (a:b:c:d:t) = a:b:c:d:quadruplets t
quadruplets [a,b,c] = [a,b,c,'='] -- 16bit tail unit
quadruplets [a,b] = [a,b,'=','='] -- 8bit tail unit
@@ -255,6 +249,7 @@
enc = quadruplets . map enc1
+dcd :: String -> [Int]
dcd [] = []
dcd (h:t)
| h <= 'Z' && h >= 'A' = ord h - ord 'A' : dcd t
@@ -281,4 +276,4 @@
-}
decode :: String -> [Octet]
-decode = (map (fromIntegral . ord)) . int4_char3 . dcd
+decode = (map (fromIntegral . ord)) . int4_char3 . dcd
Modified: packages/haskell-http/trunk/Network/HTTP/MD5.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/trunk/Network/HTTP/MD5.hs?rev=876&op=diff
==============================================================================
--- packages/haskell-http/trunk/Network/HTTP/MD5.hs (original)
+++ packages/haskell-http/trunk/Network/HTTP/MD5.hs Sun Dec 30 19:55:10 2007
@@ -16,16 +16,17 @@
--
-----------------------------------------------------------------------------
-module Network.HTTP.MD5 (
- -- * Function Types
- hash) where
+module Network.HTTP.MD5
+ ( hash
+ , Octet
+ ) where
-import Data.Char(chr)
-import Data.List(unfoldr)
-import Numeric(readHex)
+import Data.Char (chr)
+import Data.List (unfoldr)
+import Data.Word (Word8)
+import Numeric (readHex)
-import Network.HTTP.MD5Aux
-import Data.Word (Word8)
+import Network.HTTP.MD5Aux (md5s, Str(Str))
type Octet = Word8
@@ -37,8 +38,6 @@
hash xs =
unfoldr f $ md5s $ Str $ map (chr . fromIntegral) xs
where f :: String -> Maybe (Octet,String)
- f [] =
- Nothing
- f (x:y:zs) =
- Just (fromIntegral a,zs)
- where [(a,_)] = readHex (x:y:[])
+ f [] = Nothing
+ f (x:y:zs) = Just (fromIntegral a,zs)
+ where [(a,_)] = readHex (x:y:[])
Modified: packages/haskell-http/trunk/Network/HTTP/MD5Aux.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/trunk/Network/HTTP/MD5Aux.hs?rev=876&op=diff
==============================================================================
--- packages/haskell-http/trunk/Network/HTTP/MD5Aux.hs (original)
+++ packages/haskell-http/trunk/Network/HTTP/MD5Aux.hs Sun Dec 30 19:55:10 2007
@@ -3,27 +3,9 @@
MD5(..), ABCD(..),
Zord64, Str(..), BoolList(..), WordList(..)) where
-import Data.Char
-import Data.Bits
-import Data.Word
-
-{-
-Nasty kludge to create a type Zord64 which is really a Word64 but works
-how we want in hugs ands nhc98 too...
-Also need a rotate left function that actually works.
-
-#ifdef __GLASGOW_HASKELL__
-#define rotL rotateL
-#include "Zord64_EASY.hs"
-#else
-
-> import Zord64_HARD
-
-> rotL :: Word32 -> Rotation -> Word32
-> rotL a s = shiftL a s .|. shiftL a (s-32)
-
-#endif
--}
+import Data.Char (ord, chr)
+import Data.Bits (rotateL, shiftL, shiftR, (.&.), (.|.), xor, complement)
+import Data.Word (Word32, Word64)
rotL x = rotateL x
type Zord64 = Word64
Modified: packages/haskell-http/trunk/Network/Stream.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/trunk/Network/Stream.hs?rev=876&op=diff
==============================================================================
--- packages/haskell-http/trunk/Network/Stream.hs (original)
+++ packages/haskell-http/trunk/Network/Stream.hs Sun Dec 30 19:55:10 2007
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------------
-- |
-- Module : Network.Stream
--- Copyright : (c) Warrick Gray 2002, Bjorn Bringert 2003-2004, Simon Foster 2004
+-- Copyright : (c) Warrick Gray 2002, Bjorn Bringert 2003-2004, Simon Foster 2004, 2007 Robin Bate Boerop
-- License : BSD
--
-- Maintainer : bjorn at bringert.net
@@ -11,36 +11,21 @@
-- An library for creating abstract streams. Originally part of Gray's\/Bringert's
-- HTTP module.
--
+-- * Changes by Robin Bate Boerop <robin at bateboerop.name>:
+-- - Removed unnecessary import statements.
+-- - Moved Debug code to StreamDebugger.hs
+-- - Moved Socket-related code to StreamSocket.hs.
+--
-- * Changes by Simon Foster:
--- - Split module up into to sepearate Network.[Stream,TCP,HTTP] modules
---
+-- - Split Network.HTTPmodule up into to separate
+-- Network.[Stream,TCP,HTTP] modules
-----------------------------------------------------------------------------
-module Network.Stream (
- -- ** Streams
- Debug,
- Stream(..),
- debugStream,
-
- -- ** Errors
- ConnError(..),
- Result,
- handleSocketError,
- bindE,
- myrecv
-
-) where
-
-import Control.Exception as Exception
-import System.IO.Error
-
--- Networking
-import Network (withSocketsDo)
-import Network.BSD
-import Network.URI
-import Network.Socket
-
-import Control.Monad (when,liftM,guard)
-import System.IO
+module Network.Stream
+ ( Stream(..)
+ , ConnError(..)
+ , Result
+ , bindE
+ ) where
data ConnError = ErrorReset
| ErrorClosed
@@ -48,20 +33,13 @@
| ErrorMisc String
deriving(Show,Eq)
--- error propagating:
--- we could've used a monad, but that would lead us
--- into using the "-fglasgow-exts" compile flag.
-bindE :: Either ConnError a -> (a -> Either ConnError b) -> Either ConnError b
+bindE :: Result a -> (a -> Result b) -> Result b
bindE (Left e) _ = Left e
bindE (Right v) f = f v
-- | This is the type returned by many exported network functions.
type Result a = Either ConnError {- error -}
a {- result -}
-
------------------------------------------------------------------
------------------- Gentle Art of Socket Sucking -----------------
------------------------------------------------------------------
-- | Streams should make layering of TLS protocol easier in future,
-- they allow reading/writing to files etc for debugging,
@@ -78,98 +56,3 @@
writeBlock :: x -> String -> IO (Result ())
close :: x -> IO ()
-
-
-
-
--- Exception handler for socket operations
-handleSocketError :: Socket -> Exception -> IO (Result a)
-handleSocketError sk e =
- do { se <- getSocketOption sk SoError
- ; if se == 0
- then throw e
- else return $ if se == 10054 -- reset
- then Left ErrorReset
- else Left $ ErrorMisc $ show se
- }
-
-
-
-
-instance Stream Socket where
- readBlock sk n = (liftM Right $ fn n) `Exception.catch` (handleSocketError sk)
- where
- fn x = do { str <- myrecv sk x
- ; let len = length str
- ; if len < x
- then ( fn (x-len) >>= \more -> return (str++more) )
- else return str
- }
-
- -- Use of the following function is discouraged.
- -- The function reads in one character at a time,
- -- which causes many calls to the kernel recv()
- -- hence causes many context switches.
- readLine sk = (liftM Right $ fn "") `Exception.catch` (handleSocketError sk)
- where
- fn str =
- do { c <- myrecv sk 1 -- like eating through a straw.
- ; if null c || c == "\n"
- then return (reverse str++c)
- else fn (head c:str)
- }
-
- writeBlock sk str = (liftM Right $ fn str) `Exception.catch` (handleSocketError sk)
- where
- fn [] = return ()
- fn x = send sk x >>= \i -> fn (drop i x)
-
- -- This slams closed the connection (which is considered rude for TCP\/IP)
- close sk = shutdown sk ShutdownBoth >> sClose sk
-
-myrecv :: Socket -> Int -> IO String
-myrecv sock len =
- let handler e = if isEOFError e then return [] else ioError e
- in System.IO.Error.catch (recv sock len) handler
-
--- | Allows stream logging.
--- Refer to 'debugStream' below.
-data Debug x = Dbg Handle x
-
-
-instance (Stream x) => Stream (Debug x) where
- readBlock (Dbg h c) n =
- do { val <- readBlock c n
- ; hPutStrLn h ("readBlock " ++ show n ++ ' ' : show val)
- ; return val
- }
-
- readLine (Dbg h c) =
- do { val <- readLine c
- ; hPutStrLn h ("readLine " ++ show val)
- ; return val
- }
-
- writeBlock (Dbg h c) str =
- do { val <- writeBlock c str
- ; hPutStrLn h ("writeBlock " ++ show val ++ ' ' : show str)
- ; return val
- }
-
- close (Dbg h c) =
- do { hPutStrLn h "closing..."
- ; hFlush h
- ; close c
- ; hPutStrLn h "...closed"
- ; hClose h
- }
-
-
--- | Wraps a stream with logging I\/O, the first
--- argument is a filename which is opened in AppendMode.
-debugStream :: (Stream a) => String -> a -> IO (Debug a)
-debugStream file stm =
- do { h <- openFile file AppendMode
- ; hPutStrLn h "File opened for appending."
- ; return (Dbg h stm)
- }
Modified: packages/haskell-http/trunk/Network/TCP.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/trunk/Network/TCP.hs?rev=876&op=diff
==============================================================================
--- packages/haskell-http/trunk/Network/TCP.hs (original)
+++ packages/haskell-http/trunk/Network/TCP.hs Sun Dec 30 19:55:10 2007
@@ -11,33 +11,40 @@
-- An easy access TCP library. Makes the use of TCP in Haskell much easier.
-- This was originally part of Gray's\/Bringert's HTTP module.
--
+-- * Changes by Robin Bate Boerop <robin at bateboerop.name>:
+-- - Made dependencies explicit in import statements.
+-- - Removed false dependencies from import statements.
+-- - Removed unused exported functions.
+--
-- * Changes by Simon Foster:
-- - Split module up into to sepearate Network.[Stream,TCP,HTTP] modules
--
-----------------------------------------------------------------------------
-module Network.TCP (
- -- ** Connections
- Conn(..),
- Connection(..),
- openTCP,
- openTCPPort,
- isConnectedTo
-) where
+module Network.TCP
+ ( Connection
+ , openTCPPort
+ , isConnectedTo
+ ) where
-import Control.Exception as Exception
+import Network.BSD (getHostByName, hostAddresses)
+import Network.Socket
+ ( Socket, SockAddr(SockAddrInet), SocketOption(KeepAlive, SoError)
+ , SocketType(Stream), inet_addr, connect, sendTo
+ , shutdown, ShutdownCmd(ShutdownSend, ShutdownReceive)
+ , sClose, sIsConnected, setSocketOption, getSocketOption
+ , socket, Family(AF_INET)
+ )
+import Network.Stream
+ ( Stream(readBlock, readLine, writeBlock, close)
+ , ConnError(ErrorMisc, ErrorReset, ErrorClosed)
+ , bindE
+ )
+import Network.StreamSocket (myrecv, handleSocketError)
--- Networking
-import Network (withSocketsDo)
-import Network.BSD
-import Network.URI
-import Network.Socket
-import Network.Stream
-
-import Data.List (isPrefixOf,partition,elemIndex)
-import Data.Char
-import Data.IORef
-import Control.Monad (when,liftM,guard)
-import System.IO
+import Control.Exception as Exception (catch, throw)
+import Data.List (elemIndex)
+import Data.Char (toLower)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
-----------------------------------------------------------------
------------------ TCP Connections ------------------------------
@@ -50,9 +57,6 @@
-- implementation of the 'Stream Connection' instance.
newtype Connection = ConnRef {getRef :: IORef Conn}
-
--- | The 'Conn' object allows input buffering, and maintenance of
--- some admin-type data.
data Conn = MkConn { connSock :: ! Socket
, connAddr :: ! SockAddr
, connBffr :: ! String
@@ -60,12 +64,6 @@
}
| ConnClosed
deriving(Eq)
-
-
--- | Open a connection to port 80 on a remote host.
-openTCP :: String -> IO Connection
-openTCP host = openTCPPort host 80
-
-- | This function establishes a connection to a remote
-- host, it uses "getHostByName" which interrogates the
Modified: packages/haskell-http/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/trunk/debian/changelog?rev=876&op=diff
==============================================================================
--- packages/haskell-http/trunk/debian/changelog (original)
+++ packages/haskell-http/trunk/debian/changelog Sun Dec 30 19:55:10 2007
@@ -1,5 +1,6 @@
-haskell-http (30000000-3~pre1) unstable; urgency=low
-
+haskell-http (30010004-1~pre1) unstable; urgency=low
+
+ * New upstream release
* debian/control:
- Rename Xs-Vcs-* fields to Vcs-* field.
- Update build dependency on haskell-devscripts to (>= 0.5.20) which
@@ -17,7 +18,7 @@
- Replace the call to debian/mk-haskell-depends with a call to
dh_haskell_depends.
- -- Arjan Oosting <arjan at debian.org> Mon, 24 Dec 2007 00:23:57 +0100
+ -- Arjan Oosting <arjan at debian.org> Sun, 30 Dec 2007 20:54:39 +0100
haskell-http (30000000-2) unstable; urgency=low
Modified: packages/haskell-http/trunk/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-http/trunk/debian/copyright?rev=876&op=diff
==============================================================================
--- packages/haskell-http/trunk/debian/copyright (original)
+++ packages/haskell-http/trunk/debian/copyright Sun Dec 30 19:55:10 2007
@@ -16,12 +16,14 @@
Copyright:
- Copyright (c) 2002, Warrick Gray
+ 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, Andre Furtado
Copyright (c) 2004-2005, Ganesh Sittampalam
Copyright (c) 2004-2005, Dominic Steinitz
+ Copyright (c) 2007, Robin Bate Boerop
+
All rights reserved.
@@ -56,7 +58,7 @@
Debian packaging copyright:
(C) 2004-2005 Ganesh Sittampalam <ganesh at earth.li>
- (C) 2006 Arjan Oosting <arjanoosting at home.nl>
+ (C) 2006-2007 Arjan Oosting <arjanoosting at home.nl>
The initial Debian packaging was done by Ganesh Sittampalam and did
not have explicit copyright statements. See the Debian changelog for
More information about the Pkg-haskell-commits
mailing list