servant-server 0.2.2 → 0.2.3

raw patch · 5 files changed

+64/−5 lines, 5 filesdep ~eithernew-uploader

Dependency ranges changed: either

Files

• CHANGELOG.md +6/−0
• README.md +18/−0
• servant-server.cabal +6/−2
• src/Servant/Server.hs +3/−0
• src/Servant/Server/Internal.hs +31/−3

@@ -0,0 +1,6 @@+0.2.3+-----++* Fix consuming request body issue+  (https://github.com/haskell-servant/servant/issues/3)+* Make code sample in Servant.Server complete

@@ -0,0 +1,18 @@+# servant-server++[![Build Status](https://secure.travis-ci.org/haskell-servant/servant-server.svg)](http://travis-ci.org/haskell-servant/servant-server)++![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)++This library lets you *implement* an HTTP server with handlers for each endpoint of a servant API, handling most of the boilerplate for you.++## Getting started++We've written a [Getting Started](http://haskell-servant.github.io/getting-started/) guide that introduces the core types and features of servant. After this article, you should be able to write your first servant webservices, learning the rest from the haddocks' examples.++## Repositories and Haddocks++- The core [servant](http://github.com/haskell-servant) package - [docs](http://haskell-servant.github.io/servant/)+- (Haskell) client-side function generation with [servant-client](http://github.com/haskell-servant/servant-client) - [docs](http://haskell-servant.github.io/servant-client/)+- (Javascript) client-side function generation with [servant-jquery](http://github.com/haskell-servant/servant-jquery) - [docs](http://haskell-servant.github.io/servant-jquery/)+- API docs generation with [servant-docs](http://github.com/haskell-servant/servant-docs) - [docs](http://haskell-servant.github.io/servant-docs/)

@@ -1,5 +1,5 @@ name:                servant-server-version:             0.2.2+version:             0.2.3 synopsis:            A family of combinators for defining webservices APIs and serving them description:   A family of combinators for defining webservices APIs and serving them@@ -19,10 +19,14 @@ build-type:          Simple cabal-version:       >=1.10 tested-with:         GHC >= 7.8+extra-source-files:+  CHANGELOG.md+  README.md source-repository head   type: git   location: http://github.com/haskell-servant/servant-server.git + library   exposed-modules:     Servant@@ -34,7 +38,7 @@     , aeson     , attoparsec     , bytestring-    , either+    , either >= 4.3     , http-types     , network-uri >= 2.6     , safe

@@ -29,6 +29,9 @@ -- >   where listAllBooks = ... -- >         postBook book = ... -- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy +-- > -- > app :: Application -- > app = serve myApi server -- >

@@ -10,22 +10,50 @@ import Control.Applicative import Control.Monad.Trans.Either import Data.Aeson+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.IORef import Data.Maybe (catMaybes) import Data.Monoid import Data.Proxy import Data.String import Data.String.Conversions-import Data.Text (Text) import Data.Text.Encoding (decodeUtf8)+import Data.Text (Text) import GHC.TypeLits import Network.HTTP.Types hiding (Header) import Network.Wai import Servant.API import Servant.Common.Text +data ReqBodyState = Uncalled+                  | Called !B.ByteString+                  | Done !B.ByteString+ toApplication :: RoutingApplication -> Application toApplication ra request respond = do-  ra request (routingRespond . routeResult)+  reqBodyRef <- newIORef Uncalled+  -- We may need to consume the requestBody more than once.  In order to+  -- maintain the illusion that 'requestBody' works as expected,+  -- 'ReqBodyState' is introduced, and the complete body is memoized and+  -- returned as many times as requested with empty "Done" marker chunks in+  -- between.+  -- See https://github.com/haskell-servant/servant/issues/3+  let memoReqBody = do+          ior <- readIORef reqBodyRef+          case ior of+            Uncalled -> do+                r <- BL.toStrict <$> strictRequestBody request+                writeIORef reqBodyRef $ Done r+                return r+            Called bs -> do+                writeIORef reqBodyRef $ Done bs+                return bs+            Done bs -> do+                writeIORef reqBodyRef $ Called bs+                return B.empty++  ra request{ requestBody = memoReqBody } (routingRespond . routeResult)  where   routingRespond :: Either RouteMismatch Response -> IO ResponseReceived   routingRespond (Left NotFound) =@@ -44,7 +72,7 @@   | InvalidBody -- ^ an even more informative "your json request body wasn't valid" error   deriving (Eq, Show) --- | +-- | -- @ -- > mempty = NotFound -- >