http-server 1 → 1.0.1

raw patch · 11 files changed

+117/−108 lines, 11 filesdep ~HTTPPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: HTTP

API changes (from Hackage documentation)

Files

• LICENSE +16/−5
• Network/HTTP/Server.hs +12/−13
• Network/HTTP/Server/HtmlForm.hs +0/−1
• Network/HTTP/Server/Logger.hs +0/−3
• Network/HTTP/Server/Response.hs +3/−5
• Network/HTTP/Server/Utils.hs +18/−0
• example/LICENSE +0/−7
• example/README +5/−7
• example/SimpleWeb.cabal +23/−23
• example/SimpleWeb.hs +9/−11
• http-server.cabal +31/−33

@@ -1,8 +1,19 @@-Copyright (c) 2007 Galois Inc-Copyright (c) 2009 Iavor S. Diatchki+Copyright (c) 2007 Galois Inc Copyright (c) 2009 Iavor S. Diatchki -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:+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 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.+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.

@@ -65,7 +65,7 @@ server_init conf = withSocketsDo $   do #ifdef _OS_UNIX-     P.installHandler P.sigPIPE P.Ignore Nothing+     _ <- P.installHandler P.sigPIPE P.Ignore Nothing #endif      let host_name = srvHost conf          lg        = srvLog conf@@ -87,13 +87,13 @@ -- It is a variation on string of some sort (e.g., String, ByteString, etc.) type Handler a = SockAddr -> URL -> Request a -> IO (Response a) --- | Start a server with the default configureation, and the given handler.---  Requests are handled in separete threads.+-- | Start a server with the default configuration, and the given handler.+--  Requests are handled in separate threads. server :: HStream a => Handler a -> IO () server = serverWith defaultConfig  -- | Start a server with the given configuration and handler.---  Requests are handled in separete threads.+--  Requests are handled in separate threads. serverWith :: HStream a => Config -> Handler a -> IO () serverWith conf handler = withSocketsDo $   do s <- server_init conf@@ -104,7 +104,7 @@   lg = srvLog conf    loop s = do (client_sock,sock_addr) <- accept s-              forkIO (client client_sock sock_addr)+              _ <- forkIO (client client_sock sock_addr)               loop s    -- get_request :: HandleStream a -> IO (Maybe (URL, Request a))@@ -122,15 +122,16 @@     client sock addr =-    do let name = ppSockAddr addr ""-       logInfo lg 0 ("Accepted connection from " ++ name)-       conn <- socketConnection name sock    -- XXX: name?-       setStreamHooks conn nullHooks { hook_close = -          logInfo lg 0 ("Closing  connection to " ++ ppSockAddr addr "")+    do let client_host = ppHostAddr addr+       let portnum = portFromSockAddr addr+       let client_addr = ppSockAddr addr ""    +       logInfo lg 0 ("Accepted connection from " ++ client_addr)+       conn <- socketConnection client_host portnum sock+       setStreamHooks conn nullHooks { hook_close =+          logInfo lg 0 ("Closing  connection to " ++ client_addr)              }        client_interact addr conn -   -- client_interact :: SockAddr -> HandleStream a -> IO ()   client_interact addr conn =     do mbreq <- get_request conn@@ -182,5 +183,3 @@            (Just x, Just y) -> x ++ ":" ++ y            (Just x, Nothing) -> x            _ -> ""--

@@ -73,4 +73,3 @@   = let hdrs = map (\ (Header a b) -> (show a, b)) (rqHeaders req)         body = rqBody req     in parseMIMEBody hdrs body-

@@ -91,6 +91,3 @@                               Just n -> take n allItems                               _ -> allItems   where allItems = filter (choose . item_type) ls---

@@ -28,13 +28,13 @@   --- | Make a simple response with the given staus and body.--- Intended to be used for (bad) erros.+-- | Make a simple response with the given status and body.+-- Intended to be used for (bad) errors. -- Adds a "close" header. err_response :: BufferType a => StatusCode -> Response a err_response code = insertHeader HdrConnection "close" (respond code) --- | Make a simple response with the given staus and body.+-- | Make a simple response with the given status and body. -- No headers or body. respond :: BufferType a => StatusCode -> Response a respond code = Response@@ -68,5 +68,3 @@   Conflict            -> (4,0,9)   InternalServerError -> (5,0,0)   NotImplemented      -> (5,0,1)--

@@ -55,4 +55,22 @@ ppSockAddr (SockAddrUnix sock) = showString "unix/" . showString sock #endif +-- |Extract the host address from a SockAddr and pretty print+ppHostAddr :: SockAddr -> String+ppHostAddr (SockAddrInet _ addr) = ppHostAddress addr ""+#ifdef _OS_UNIX+ppHostAddr (SockAddrInet6 _ _ addr _) = ppHostAddress6 addr ""+ppHostAddr a@(SockAddrUnix _) = ppSockAddr a ""+#endif +-- |Extract the port number from a SockAddr+portFromSockAddr :: SockAddr -> Int+portFromSockAddr (SockAddrInet port _) = fromInteger $ toInteger port+#ifdef _OS_UNIX+portFromSockAddr (SockAddrInet6 port _ _ _) = fromInteger $ toInteger port+portFromSockAddr (SockAddrUnix _) = -1 -- according to documentation+                                       -- of Network.accept, "When+                                       -- using AF_UNIX, HostName will+                                       -- be set to the path of the+                                       -- socet and PortNumber of -1.+#endif

@@ -1,7 +0,0 @@-Copyright (c) 2009 Iavor S. Diatchki--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.

@@ -1,8 +1,6 @@-Here we have a simple server that demonstrates how one-could use the http-server library.--NOTE:-The version of jQuery in this directory is used to illustrate how a-client may send ajax requests to the server.  This is just for demo-purposes.  We are using jQuery with its MIT license.+Here we have a simple server that demonstrates how one could use the+http-server library. +NOTE: The version of jQuery in this directory is used to illustrate how a+client may send AJAX requests to the server. This is just for demo purposes.+We are using jQuery with its MIT license.

@@ -1,26 +1,26 @@-Name:           SimpleWeb-Version:        0.1-License:        BSD3-License-file:   LICENSE-Author:         Iavor S. Diatchki-Maintainer:     diatchki@galois.com-Homepage:       http://code.galois.com/-Category:       Network-Synopsis:       An example of using the http-package-Description:    An example of using the http-package-Build-type:     Simple-Cabal-version: >= 1.2+name:          SimpleWeb+version:       0.1+category:      Network+synopsis:      An example of using the http-server library.+description:   An example of using the http-server library.+author:        Iavor S. Diatchki+maintainer:    diatchki@galois.com+license:       BSD3+license-file:  LICENSE+homepage:      http://code.galois.com/+cabal-version: >= 1.2+build-type:    Simple -Executable SimpleWeb-  Main-is:       SimpleWeb.hs-  Build-depends:-    base >= 4,-    http-server >= 0.2,-    filepath,-    json,-    xhtml,-    utf8-string,-    url >= 2.1-  GHC-options: -O -Wall+executable SimpleWeb+  main-is: SimpleWeb.hs +  build-depends:+    base        >= 4    && < 5,+    filepath    >= 1    && < 2,+    http-server >= 0.2  && < 2,+    json        >= 0.4  && < 1,+    url         >= 2.1  && < 3,+    utf8-string >= 0.3  && < 1,+    xhtml       >= 3000 && < 3001 +  ghc-options: -Wall -O2

@@ -27,10 +27,10 @@                thehtml $ concatHtml                  [ thead noHtml                  , body $ concatHtml-                    [ toHtml "I could not find"-                    , toHtml (url_path url)-                    , toHtml ", so I made this with xhtml combinators. "-                    , toHtml $ hotlink "example.html" (toHtml "Try this.")+                    [ toHtml "I could not find "+                    , toHtml $ exportURL url { url_type = HostRelative }+                    , toHtml ", so I made this with XHTML combinators. "+                    , toHtml $ hotlink "example.html" (toHtml "Try this instead.")                     ]                  ] @@ -50,7 +50,7 @@               hotlink "example.html" (toHtml "back")             Nothing -> sendHTML BadRequest $               toHtml "Could not understand URL encoded form data"- +           | "multipart/form-data" `isPrefixOf` ty ->           case Form.fromRequest request of             Just fields -> sendHTML OK $@@ -59,21 +59,21 @@               hotlink "example.html" (toHtml "back")             Nothing -> sendHTML BadRequest $               toHtml "Could not understand multipart form data"-    +           | "application/json" `isPrefixOf` ty ->           case runGetJSON readJSValue txt of             Right val -> sendJSON OK $               JSObject $ toJSObject [("success", JSString $ toJSString "hello")]-            Left err  -> sendJSON BadRequest $+            Left err -> sendJSON BadRequest $               JSObject $ toJSObject [("error", JSString $ toJSString err)]-           +         x -> sendHTML BadRequest $              toHtml $ "I don't know how to deal with POSTed content" ++                       " of type " ++ show x          -- we assume UTF8 encoding         where txt = decodeString (rqBody request)-    +     _ -> return $ sendHTML BadRequest $ toHtml "I don't understand"  @@ -96,5 +96,3 @@ sendScript     :: StatusCode -> String -> Response String sendScript s v  = insertHeader HdrContentType "application/x-javascript"                 $ sendText s v--

@@ -1,51 +1,49 @@-Name:           http-server-Version:        1-License:        BSD3-License-file:   LICENSE-Author:         Galois Inc-Maintainer:     diatchki@galois.com-Homepage:       http://code.galois.com/-Category:       Network-Synopsis:       A library fro writing Haskell web servers.-Description:    A library fro writing Haskell web servers.-Build-type:     Simple-Cabal-version: >= 1.6-+name:          http-server+version:       1.0.1+category:      Network+synopsis:      A library for writing Haskell web servers.+description:   A library for writing Haskell web servers.+author:        Galois, Inc.+maintainer:    diatchki@galois.com+license:       BSD3+license-file:  LICENSE+homepage:      http://code.galois.com/+cabal-version: >= 1.6+build-type:    Simple -Extra-source-files:+extra-source-files:   example/README-  example/LICENSE   example/*.js   example/*.hs   example/*.cabal -Library-  Exposed-modules:+library+  exposed-modules:     Network.HTTP.Server+    Network.HTTP.Server.HtmlForm     Network.HTTP.Server.Logger     Network.HTTP.Server.Response-    Network.HTTP.Server.HtmlForm-  Other-modules:+  other-modules:     Network.HTTP.Server.Utils -  Extensions:+  extensions:     CPP     UndecidableInstances -  -- Why the commas?-  Build-depends:-    base    >= 4          && < 5,-    network >= 2          && < 3,-    url     >= 2          && < 3,-    HTTP    >= 4000.0.7   && < 5000,-    utf8-string >= 0.3.4  && < 2,-    mime    >= 0.3        && < 2+  build-depends:+    HTTP        >= 4000.2.0 && < 5000,+    base        >= 4        && < 5,+    mime        >= 0.3      && < 2,+    network     >= 2        && < 3,+    url         >= 2        && < 3,+    utf8-string >= 0.3.4    && < 2    if !os(windows)-    Build-depends:  unix  >= 2 && < 3-    CPP-options:    -D_OS_UNIX--  GHC-options:    -O2 -Wall-+    build-depends: unix >= 2 && < 3+    CPP-options:   -D_OS_UNIX +  ghc-options: -Wall -O2 +source-repository head+  type:     git+  location: git://code.galois.com/http-server.git