httpd-shed 0.3 → 0.4

raw patch · 3 files changed

+75/−26 lines, 3 filesdep ~basedep ~networknew-component:exe:httpd-shed-testPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, network

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• Network/Shed/Httpd.hs +67/−21
• httpd-shed.cabal +7/−4

@@ -1,4 +1,4 @@-Copyright (c) 2005-2008 Andy Gill+Copyright (c) 2005-2009 Andy Gill All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -14,13 +14,16 @@ -- into a local web server. The user can decide how to interpret -- the requests, and the library is intended for implementing Ajax APIs. ----- initServerLazy (and assocated refactorings) was written by Henning Thielemann. ---+-- initServerLazy (and assocated refactorings), and Chunking support+-- was written by Henning Thielemann.+-- Handling of POST-based payloads was been written by Brandon Moore.+-- initServerBind support was written by John Van Enk.  module Network.Shed.Httpd      ( Server     , initServer     , initServerLazy+    , initServerBind     , Request(..)     , Response(..)     , queryToArguments@@ -40,8 +43,11 @@ import qualified Data.List as List import qualified Data.Char as Char import Numeric (showHex)+import qualified Network as N+import Network.BSD+import Network.Socket -type Server = () -- later, you might have a handle for shutting down a server.+type Server = () -- later, we might have a handle for shutting down a server.  {- | This server transfers documents as one parcel, using the content-length header.@@ -49,11 +55,12 @@  initServer    :: Int 			-- ^ The port number-   -> (Request -> IO Response) 	-- ^ The functionality of the Sever+   -> (Request -> IO Response) 	-- ^ The functionality of the Server    -> IO Server			-- ^ A token for the Server-initServer =+initServer port =   initServerMain      (\body -> ([("Content-Length", show (length body))], body))+     (SockAddrInet (fromIntegral port) iNADDR_ANY)  {- | This server transfers documents in chunked mode@@ -64,36 +71,70 @@ initServerLazy    :: Int 			-- ^ Chunk size    -> Int 			-- ^ The port number-   -> (Request -> IO Response) 	-- ^ The functionality of the Sever+   -> (Request -> IO Response) 	-- ^ The functionality of the Server    -> IO Server			-- ^ A token for the Server-initServerLazy chunkSize =+initServerLazy chunkSize port =   initServerMain      (\body ->         ([("Transfer-Encoding", "chunked")],-         concatMap (\str -> showHex (length str) $ showString "\r\n" $ str) $-         slice chunkSize body ++ [[]]))+         foldr ($) "" $+         map+            (\str ->+               showHex (length str) . showCRLF .+               showString str . showCRLF)+            (slice chunkSize body) +++         -- terminating chunk+         showString "0" . showCRLF :+         -- terminating trailer+         showCRLF :+         []))+     (SockAddrInet (fromIntegral port) iNADDR_ANY)+     +showCRLF :: ShowS+showCRLF = showString "\r\n"  -- cf. Data.List.HT.sliceVertical slice :: Int -> [a] -> [[a]] slice n =   map (take n) . takeWhile (not . null) . iterate (drop n) +{- |+This server transfers documents as one parcel, using the content-length header,+and takes an additional +-}+initServerBind+   :: Int                               -- ^ The port number+   -> HostAddress                       -- ^ The host address+   -> (Request -> IO Response)          -- ^ The functionality of the Server+   -> IO Server                         -- ^ A token for the Server+initServerBind port addr =+  initServerMain+      (\body -> ([("Content-Length", show (length body))], body)) +      (SockAddrInet (fromIntegral port) addr)++ initServerMain    :: (String -> ([(String, String)], String))-   -> Int+   -> SockAddr    -> (Request -> IO Response)    -> IO Server-initServerMain processBody portNo callOut = do+initServerMain processBody sockAddr callOut = do --        installHandler sigPIPE Ignore Nothing    -        sock  <- listenOn (PortNumber $ fromIntegral portNo)+--        sock  <- listenOn (PortNumber $ fromIntegral portNo)+        num <- getProtocolNumber "tcp"+        sock <- socket AF_INET Stream num+        setSocketOption sock ReuseAddr 1+        bindSocket sock sockAddr+        listen sock maxListenQueue+         loopIO  -           (do (h,_nm,_port) <- accept sock-	       forkIO $ do +           (do (h,_nm,_port) <- N.accept sock+               forkIO $ do                   ln <- hGetLine h                  case words ln of-                   [mode,uri,"HTTP/1.1"]  -> +                   [mode,uri,"HTTP/1.1"] ->                        case parseURIReference uri of-                         Just uri' -> readHeaders h mode uri' []+                         Just uri' -> readHeaders h mode uri' [] Nothing                          _ -> do print uri                                   hClose h                    _                      -> hClose h@@ -103,22 +144,27 @@       loopIO m          = do m                              loopIO m -      readHeaders h mode uri hds = do+      readHeaders h mode uri hds clen = do         line <- hGetLine h         case span (/= ':') line of-          ("\r","") -> sendRequest h mode uri hds-          (name,':':rest) -> readHeaders h mode uri (hds ++ [(name,dropWhile Char.isSpace rest)])+          ("\r","") -> sendRequest h mode uri hds clen+          (name@"Content-Length",':':rest) ->+            readHeaders h mode uri (hds ++ [(name,dropWhile Char.isSpace rest)]) (Just (read rest))+          (name,':':rest) -> readHeaders h mode uri (hds ++ [(name,dropWhile Char.isSpace rest)]) clen           _ -> hClose h	-- strange format        message code = show code ++ " " ++                       case lookup code longMessages of                        Just msg -> msg                        Nothing -> "-"-      sendRequest h mode uri hds = do+      sendRequest h mode uri hds clen = do+          reqBody' <- case clen of+            Just l -> fmap (take l) (hGetContents h)+            Nothing -> return ""           resp <- callOut $ Request { reqMethod = mode                                     , reqURI    = uri                                     , reqHeaders = hds-                                    , reqBody   = ""+                                    , reqBody   = reqBody'                                     }            let (additionalHeaders, body) =                 processBody $ resBody resp

@@ -1,26 +1,29 @@ Name:           httpd-shed-Version:        0.3+Version:        0.4 Cabal-Version:  >= 1.2 License:        BSD3 License-File:   LICENSE-Author:         Andy Gill+Author:         Andy Gill, Brandon Moore, Henning Thielemann, John Van Enk. Category:       Network, Web Synopsis:       A simple web-server with an interact style API Description:                     This web server promotes a Request to IO Response function                 into a local web server. The user can decide how to interpret                 the requests, and the library is intended for implementing Ajax APIs.+ Maintainer:     Andy Gill Copyright:      (c) 2009 Andy Gill build-type:     Simple  Library-  Build-Depends:        base, network+  Build-Depends:        base >= 4.0 && < 5.0, network   ghc-options: -Wall   Exposed-modules:     Network.Shed.Httpd -Executable test++-- Trivial test; we need real tests!+Executable httpd-shed-test   Main-Is:        Main.hs   Hs-Source-Dirs: ., test   buildable: True