http-pony-serve-wai 0.1.0.2 → 0.1.0.3

raw patch · 6 files changed

+116/−101 lines, 6 filesdep +http-pony-transformer-startlinePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: http-pony-transformer-startline

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−1
• README.md +46/−0
• http-pony-serve-wai.cabal +3/−1
• src/Network/HTTP/Pony/Serve/Wai.hs +55/−64
• src/Network/HTTP/Pony/Serve/Wai/Parser.hs +2/−32
• src/Network/HTTP/Pony/Serve/Wai/Type.hs +4/−3

@@ -1,5 +1,10 @@ # Revision history for http-pony-serve-wai -## 0.1.0.0  -- YYYY-mm-dd+## 0.1.0.0  -- 2016-09-20  * First version. Released on an unsuspecting world.++## 0.1.0.3++* Use http-types to decode uri, this release should be compatible with most+  WAI apps that do not use streaming response.

@@ -0,0 +1,46 @@+# Starting from a WAI app++    {-# LANGUAGE OverloadedStrings #-}++    module Hello where++    import           Network.HTTP.Pony.Serve.Wai (fromWAI)+    import qualified Network.HTTP.Types as HTTP+    import qualified Network.Wai as Wai++    waiApp :: Wai.Application+    waiApp request respond = do++      respond $ Wai.responseLBS+          HTTP.status200+          [("Content-Type", "text/plain")]+          "Hello, WAI!"++    hello = fromWAI waiApp++# Serve with pony++    {-# LANGUAGE OverloadedStrings #-}++    module RunHello where++    import Network.HTTP.Pony.Serve (run)+    import Network.HTTP.Pony.Transformer.HTTP (http)+    import Network.HTTP.Pony.Transformer.StartLine (startLine)+    import Network.HTTP.Pony.Transformer.CaseInsensitive (caseInsensitive)++    import Pipes.Safe (runSafeT)+    import Hello (hello)++    main :: IO ()+    main = ( runSafeT+              . run "localhost" "8080"+              . http+              . startLine+              . caseInsensitive+            ) hello+++# Note++* Streaming response is not implemented.

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                http-pony-serve-wai-version:             0.1.0.2+version:             0.1.0.3 synopsis:            Serve a WAI application with http-pony -- description:          license:             BSD3@@ -13,6 +13,7 @@ category:            Network build-type:          Simple extra-source-files:  ChangeLog.md+                     README.md cabal-version:       >=1.10 Homepage:            https://github.com/nfjinjing/http-pony-serve-wai @@ -33,6 +34,7 @@                      , pipes-bytestring                      , wai                      , http-pony-transformer-http >= 0.1.0.0+                     , http-pony-transformer-startline>= 0.1.0.0                       -- testing                      -- , pipes-safe

@@ -18,47 +18,43 @@ import           Pipes.ByteString (fromLazy)  import           Network.HTTP.Pony.Serve.Wai.Helper ((-))-import           Network.HTTP.Pony.Serve.Wai.Parser (parseRequestURITokens-                                                    , requestLineTokens)+import           Network.HTTP.Pony.Serve.Wai.Parser (parseRequestURITokens) import           Network.HTTP.Pony.Serve.Wai.Type (Request, Response, App) import           Prelude hiding ((-))  --parseRequest :: Request -> IO (Either String Wai.Request)-parseRequest ((requestLine, headers), body) = do+parseRequest :: Request -> IO Wai.Request+parseRequest (((method, uri, version), headers), body) = do   bodyRef <- newIORef (Just body) -  let eitherRequest =-        do-          (method, uri, version) <- eitherResult (parse requestLineTokens requestLine)-          (pathInfo, queryString) <- parseRequestURITokens uri--          pure - Wai.defaultRequest-                  {-                    Wai.requestMethod = method-                  , Wai.httpVersion = version-                  , Wai.rawPathInfo = pathInfo-                  , Wai.requestHeaders = headers-                  , Wai.rawQueryString = queryString-                  , Wai.requestBody = do-                      bodyC <- readIORef bodyRef-                      case bodyC of-                        Just _body -> do-                          r <- next _body-                          case r of-                            Right (x, bodyC) -> do-                              writeIORef bodyRef (Just bodyC)-                              pure x+  let (rawPathInfo, rawQueryString) = parseRequestURITokens uri+      (pathInfo, queryString) = HTTP.decodePath uri -                            _ -> do-                              writeIORef bodyRef Nothing-                              pure mempty+  pure Wai.defaultRequest+    {+      Wai.requestMethod = method+    , Wai.httpVersion = version+    , Wai.rawPathInfo = rawPathInfo+    , Wai.rawQueryString = rawQueryString+    , Wai.requestHeaders = headers+    , Wai.pathInfo = pathInfo+    , Wai.queryString = queryString+    , Wai.requestBody = do+        bodyC <- readIORef bodyRef+        case bodyC of+          Just _body -> do+            r <- next _body+            case r of+              Right (x, bodyC) -> do+                writeIORef bodyRef (Just bodyC)+                pure x -                        _ -> pure mempty-                  }+              _ -> do+                writeIORef bodyRef Nothing+                pure mempty -  pure (eitherRequest :: Either String Wai.Request)+          _ -> pure mempty+    }   @@ -68,42 +64,37 @@                 -> IO ResponseReceived               ) -> App fromWAI app r = do-  eitherWaiRequest <- parseRequest r-  case eitherWaiRequest of-    Right waiRequest -> do-      let waiC :: (Wai.Response -> IO ResponseReceived) -> IO ResponseReceived-          waiC = app waiRequest+  waiRequest <- parseRequest r -      responseRef <- newIORef Nothing+  let waiC :: (Wai.Response -> IO ResponseReceived) -> IO ResponseReceived+      waiC = app waiRequest -      let callback :: HTTP.HttpVersion -> Wai.Response -> IO ResponseReceived-          callback version waiResponse = do-            let (HTTP.Status code message) = Wai.responseStatus waiResponse-                headers = Wai.responseHeaders waiResponse-                responseLine =-                  B.pack (show version)-                    <> " "-                    <> B.pack (show code)-                    <> " "-                    <> message+  responseRef <- newIORef Nothing -            case waiResponse of-              ResponseBuilder _ _ builder -> do+  let version = Wai.httpVersion waiRequest -                let p = fromLazy (toLazyByteString builder)-                writeIORef responseRef (Just ((responseLine, headers), p))-                pure ResponseReceived-              _ -> do-                pure ResponseReceived+  let callback :: Wai.Response -> IO ResponseReceived+      callback waiResponse = do+        let status = Wai.responseStatus waiResponse+            headers = Wai.responseHeaders waiResponse+            responseLine = (version, status) -      waiC - callback (Wai.httpVersion waiRequest)+        case waiResponse of+          ResponseBuilder _ _ builder -> do -      maybeResponse <- readIORef responseRef+            let p = fromLazy (toLazyByteString builder)+            writeIORef responseRef (Just ((responseLine, headers), p))+            pure ResponseReceived+          _ -> do+            pure ResponseReceived -      case maybeResponse of-        Just response -> do-          pure response-        _ -> do-          pure mempty-    Left err -> do-      pure mempty+  waiC - callback++  maybeResponse <- readIORef responseRef++  case maybeResponse of+    Just response -> do+      pure response+    _ -> do+      pure (((version, HTTP.status500), mempty), mempty)+

@@ -4,35 +4,10 @@  module Network.HTTP.Pony.Serve.Wai.Parser where -import           Data.Attoparsec.ByteString (Parser) import qualified Data.Attoparsec.ByteString.Char8 as Char import           Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B-import qualified Data.CaseInsensitive as CI-import           Data.Char (ord)-import qualified Network.HTTP.Types as HTTP-import           Pipes (Producer) -type RequestURI = ByteString--requestLineTokens :: Parser (HTTP.Method, RequestURI, HTTP.HttpVersion)-requestLineTokens = do-  method <- Char.takeTill (== ' ')-  Char.char ' '-  requestURI <- Char.takeTill (== ' ')-  Char.char ' '-  Char.string "HTTP/"--  let minusZero = (+) (- ord '0')-      charToInt = minusZero . ord-      digit = fmap charToInt Char.digit--  httpVersionMajor<- digit-  Char.char '.'-  httpVersionMinor <- digit--  pure (method, requestURI, HTTP.HttpVersion httpVersionMajor httpVersionMinor)- -- requestURITokens :: Parser (ByteString, ByteString) -- requestURITokens = do --   ( (,) <$> Char.takeTill (== '?')@@ -45,10 +20,5 @@ --         <*> pure mempty --     ) -parseRequestURITokens :: ByteString -> Either String (ByteString, ByteString)-parseRequestURITokens x = pure $-  let pathInfo = B.takeWhile (/= '?') x-      queryString = B.dropWhile (== '?') . B.dropWhile (/= '?') $  x-  in--  (pathInfo, queryString)+parseRequestURITokens :: ByteString -> (ByteString, ByteString)+parseRequestURITokens = B.break (== '?')

@@ -4,10 +4,11 @@ import Data.ByteString (ByteString) import Data.CaseInsensitive (CI) import qualified Network.HTTP.Pony.Transformer.HTTP.Type as HTTP+import qualified Network.HTTP.Pony.Transformer.StartLine.Type as StartLine -type MessageType = (ByteString, [(CI ByteString, ByteString)])+type MessageType a = (a, [(CI ByteString, ByteString)]) -type Request = HTTP.Request MessageType ByteString IO ()-type Response = HTTP.Response MessageType ByteString IO ()+type Request = HTTP.Request (MessageType StartLine.RequestLine) ByteString IO ()+type Response = HTTP.Response (MessageType StartLine.ResponseLine) ByteString IO ()  type App = Request -> IO Response