acme-http 0.1.1 → 0.2.0

raw patch · 7 files changed

+63/−48 lines, 7 filesdep +blaze-buildernew-component:exe:http-echoPVP ok

version bump matches the API change (PVP)

Dependencies added: blaze-builder

API changes (from Hackage documentation)

Files

• Acme/Request.hs +0/−6
• Acme/Response.hs +11/−9
• Acme/Serve.hs +1/−28
• Acme/Types.hs +9/−4
• Echo.hs +21/−0
• Pong.hs +13/−0
• acme-http.cabal +8/−1

@@ -156,9 +156,3 @@           if unsafeIndex bs (i - 1) /= cr              then throw Unexpected              else return $ (unsafeTake (i - 1) bs, unsafeDrop (i + 1) bs)-{--parse :: String -> Pipe ByteString ByteString (ResourceT IO) a -> IO (Maybe a)-parse str parser =-    runResourceT $ runPipe $-        (yield (C.pack str) >> return Nothing) >+> (fmap Just parser) >+> discard--}

@@ -1,9 +1,10 @@ {-# LANGUAGE RecordWildCards, OverloadedStrings #-} module Acme.Response where -import Data.ByteString       (ByteString, append)+import Acme.Types               (Response(..))+import Data.ByteString       (ByteString, concat, append) import Data.ByteString.Char8 () -- instance IsString ByteString-+import Prelude               hiding (concat)  ------------------------------------------------------------------------------ -- send a response@@ -13,13 +14,14 @@ pong send =     do send "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nContent-Length: 4\r\n\r\nPONG" -{--sendResponse :: Response -> (ByteString -> IO-sendResponse _ =-    do -- lift  $ liftIO $ putStrLn "responding..."-       yield $ statusLine rsCode `append` "Content-Length: 4\r\n\r\nPONG"-       return ()--}+sendResponse :: (ByteString -> IO ()) -> Response -> IO ()+sendResponse send PongResponse = pong send+sendResponse send ByteStringResponse{..} =+    send $ concat (statusLine rsCode : (formatHeaders rsHeaders) ++ [rsBody])+    where+      formatHeaders :: [(ByteString, ByteString)] -> [ByteString]+      formatHeaders         [] = ["\r\n"]+      formatHeaders ((f,v):hs) = [ f, ": " , v , "\r\n"] ++ formatHeaders hs  ------------------------------------------------------------------------------ -- Status Lines

@@ -63,32 +63,5 @@     where       go bs =           do (request, bs') <- parseRequest reader bs secure-             pong writer+             sendResponse writer =<< app request              go bs'-{--    runPipe $ reader >+> httpPipe empty >+> writer-    where-      httpPipe :: ByteString -> Pipe ByteString ByteString (ResourceT IO) ()-      httpPipe bs =-          do (request, bs')  <- parseRequest bs secure-             response <- appPipe request-             responsePipe response---             _remaining <- discardBody request-             httpPipe bs'--      discardBody :: Request -> Pipe ByteString ByteString (ResourceT IO) ByteString-      discardBody request = rqBody request >> discard--      appPipe :: Request -> Pipe ByteString ByteString (ResourceT IO) Response-      appPipe req = lift $ app req---hello :: Request -> ResourceT IO Response-hello req = -    do lift $ print (ppRequest req)-       let res = Response { rsCode = 200-                          , rsBody = ResponsePipe $ return ()-                          }-       lift $ print (ppResponse res)-       return $ res--}

@@ -87,18 +87,23 @@ data Response     = PongResponse               -- ^ return PONG in the request body     | ByteStringResponse-      { rsCode  :: !Int-      , rsBody  :: !ByteString+      { rsCode    :: !Int+      , rsHeaders :: ![(ByteString, ByteString)]+      , rsBody    :: !ByteString       }  ppResponse :: Response -> Doc ppResponse PongResponse = text "PongResponse" ppResponse ByteStringResponse{..} =     text "Response {"  $+$-      nest 2 (vcat [ field "rsCode"      (text $ show rsCode)-                   , field "rsBody"      (text $ show rsBody)+      nest 2 (vcat [ field "rsCode"    (text $ show rsCode)+                   , field "rsHeaders" (text $ show rsCode)+                   , field "rsBody"    (text $ show rsBody)                    ])  $+$     text "}"++instance Show Response where+    show = show . ppResponse  ------------------------------------------------------------------------------ -- Exceptions

@@ -0,0 +1,21 @@+{-# Language OverloadedStrings #-}+module Main where++import Acme.Serve+import Acme.Types+import Data.ByteString.Char8 (pack,length)+import Prelude hiding (length)++main :: IO ()+main = serve 8000 echo++echo :: Request -> IO Response+echo r =+    do let body = pack $ show r -- note: this only works correctly for ascii, but I did not want to add a depends on utf8-string+       return $ ByteStringResponse+                  { rsCode    = 200+                  , rsHeaders = [ ("Content-Length", pack (show (length body)))+                                , ("Content-Type"  , "text/plain")+                                ]+                  , rsBody    = body+                  }

@@ -1,7 +1,9 @@+{-# Language OverloadedStrings #-} module Main where  import Acme.Serve import Acme.Types+import Data.ByteString.Char8 ()  main :: IO () main = serve 8000 pong@@ -9,3 +11,14 @@ pong :: Request -> IO Response pong r =     return $ PongResponse++pong2 :: Request -> IO Response+pong2 r =+    return $ ByteStringResponse { rsCode = 200+                                , rsHeaders = [ ("Content-Length", "4")+                                              , ("Content-Type"  , "text/plain")+                                              ]+                                , rsBody    = "PONG"+                                }++

@@ -1,5 +1,5 @@ Name:                acme-http-Version:             0.1.1+Version:             0.2.0 Synopsis:            fastest Haskell PONG server in the world Description:         winning the PONG benchmark at all costs License:             BSD3@@ -23,6 +23,7 @@                      Acme.Types    Build-depends:     base                   < 5,+                     blaze-builder         == 0.3.*,                      bytestring            == 0.9.*,                      extensible-exceptions == 0.1.*,                      mtl                   == 2.0.*,@@ -34,3 +35,9 @@ Executable pong   Main-Is: Pong.hs   GHC-Options: -threaded -O2++Executable http-echo+  Main-Is: Echo.hs+  GHC-Options: -threaded -O2++