wai-handler-snap (empty) → 0.0.0

raw patch · 4 files changed

+149/−0 lines, 4 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, iteratee, snap-core, snap-server, transformers, wai

Files

• LICENSE +25/−0
• Network/Wai/Handler/Snap.hs +85/−0
• Setup.lhs +11/−0
• wai-handler-snap.cabal +28/−0

@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2010, Michael Snoyman. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,85 @@+module Network.Wai.Handler.Snap+    ( run+    ) where++import qualified Network.Wai as W+import Snap.Types+import Snap.Http.Server+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+import Control.Monad.IO.Class+import Data.CIByteString+import Control.Arrow (first, (***))+import qualified Data.Map as Map+import Data.Iteratee.Base hiding (run)+import Data.Iteratee.WrappedByteString++run :: Int -> W.Application -> IO ()+run port = httpServe (S8.pack "*") port (S8.pack "localhost")+                     Nothing Nothing . waiToSnap++waiToSnap :: W.Application -> Snap ()+waiToSnap wapp = do+    sreq <- getRequest+    reqBody <- getRequestBody+    wres <- liftIO $ wapp $ toWaiRequest reqBody sreq+    modifyResponse $ toSnapResponse wres+    case W.responseBody wres of+        W.ResponseFile fp -> sendFile fp+        W.ResponseEnumerator enum ->+            modifyResponse $ setResponseBody $ toSnapEnum enum+        W.ResponseLBS lbs -> writeLBS lbs++toWaiRequest :: L.ByteString -> Request -> W.Request+toWaiRequest reqBody req = W.Request+  {  W.requestMethod  = S8.pack $ show $ rqMethod req+  ,  W.httpVersion    = case rqVersion req of+                            (0, 9) -> W.http09+                            (1, 0) -> W.http10+                            (1, 1) -> W.http11+                            (x, y) -> S8.pack+                                    $ show x ++ "." ++ show y+  ,  W.pathInfo       = rqPathInfo req+  ,  W.queryString    = rqQueryString req+  ,  W.serverName     = rqServerName req+  ,  W.serverPort     = rqServerPort req+  ,  W.requestHeaders = toReqHeaders $ headers req+  ,  W.isSecure       = rqIsSecure req+  ,  W.requestBody    = bsToSource reqBody+  ,  W.errorHandler   = error+  ,  W.remoteHost     = rqRemoteAddr req+  }++toReqHeaders :: Map.Map CIByteString [S8.ByteString]+             -> [(W.RequestHeader, S8.ByteString)]+toReqHeaders =+    concatMap (\(x, y) -> zip (repeat x) y) . map (first go) . Map.toList+  where+    go = W.mkCIByteString . unCI++-- | Unfortunately, Source is not compatible with IterateeG.+bsToSource :: L.ByteString -> W.Source+bsToSource = go . L.toChunks+  where+    go [] = W.Source $ return Nothing+    go (x:xs) = W.Source $ return $ Just (x, go xs)++toSnapResponse :: W.Response -> Response -> Response+toSnapResponse wres =+    setResponseStatus (W.statusCode st) (W.statusMessage st)+  . updateHeaders (const newHeaders)+  where+    st = W.status wres+    newHeaders = Map.fromList $ map (go *** return) $ W.responseHeaders wres+    go = toCI . W.ciOriginal++toSnapEnum :: W.Enumerator -> Enumerator a+toSnapEnum (W.Enumerator enum) initIter =+    either id id `fmap` enum go initIter+  where+    go (IterateeG iter) bs = do+        res <- iter $ Chunk $ WrapBS bs+        case res of+            Done a s -> return $ Left $ IterateeG $ const $ return+                      $ Done a s+            Cont iter' _ -> return $ Right iter'

@@ -0,0 +1,11 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple+> import System.Cmd (system)++> main :: IO ()+> main = defaultMainWithHooks (simpleUserHooks { runTests = runTests' })++> runTests' :: a -> b -> c -> d -> IO ()+> runTests' _ _ _ _ = system "runhaskell -DTEST runtests.hs" >> return ()

@@ -0,0 +1,28 @@+Name:                wai-handler-snap+Version:             0.0.0+Synopsis:            Web Application Interface handler using snap-server.+License:             BSD3+License-file:        LICENSE+Author:              Michael Snoyman+Maintainer:          michael@snoyman.com+Homepage:            http://github.com/snoyberg/wai-handler-snap+Category:            Web+Build-Type:          Simple+Cabal-Version:       >=1.6+Stability:           Stable++Source-repository head+    type:            git+    location:        git://github.com/snoyberg/wai-handler-snap.git++Library+  Build-Depends:     base >= 3 && < 5,+                     bytestring >= 0.9 && < 0.10,+                     wai >= 0.2.0 && < 0.3,+                     snap-core >= 0.2.8.1 && < 0.3,+                     snap-server >= 0.2.8.1 && < 0.3,+                     containers >= 0.2 && < 0.4,+                     transformers >= 0.2.1 && < 0.3,+                     iteratee >= 0.3.5 && < 0.4+  Exposed-modules:   Network.Wai.Handler.Snap+  ghc-options:       -Wall