packages feed

warped (empty) → 0.0.1

raw patch · 11 files changed

+389/−0 lines, 11 filesdep +basedep +blaze-builderdep +conduitsetup-changed

Dependencies added: base, blaze-builder, conduit, http-types, lifted-async, monad-control, preamble, shakers, uuid, wai, wai-conduit, wai-cors, warp

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (C) 2018 Swift Navigation Inc.++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.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.
+ README.md view
@@ -0,0 +1,53 @@+[![warped][warped-img]][warped]++# [warped][warped]++[![Package version][hackage-img]][hackage]+[![Build status][travis-img]][travis]+[![Dependency status][deps-img]][deps]++Warped is a support library around WAI and the warp server.+++## Development++`warped` has a shakefile/makefile to provide convience around building and testing:++    # build the project's libraries, executables, and tests+    $ ./Shakefile.hs build-tests-error+    +    # test the project+    $ ./Shakefile.hs tests-error+    +    # start an interpreter with the project's libraries, executables, and tests loaded+    $ ./Shakefile.hs ghci-tests+    +    # install the project's executables+    $ ./Shakefile.hs install+    +    # clean the project+    $ ./Shakefile.hs clean+    +    # lint the project source code+    $ ./Shakefile.hs lint+    +    # format the project source code+    $ ./Shakefile.hs format+++## Dependencies++To build, install, run, and test `warped`, the following dependencies may be required:+++ [stack][stack]+++[warped]:      https://github.com/swift-nav/warped+[warped-img]:  https://cloud.githubusercontent.com/assets/60851/8178609/a077a326-13c4-11e5-9d54-3e417fc6dd6c.jpg+[hackage]:     https://hackage.haskell.org/package/warped+[hackage-img]: https://img.shields.io/hackage/v/warped.svg?style=flat+[travis]:      https://travis-ci.org/swift-nav/warped+[travis-img]:  https://img.shields.io/travis/swift-nav/warped/master.svg?style=flat+[deps]:        http://packdeps.haskellers.com/feed?needle=warped+[deps-img]:    https://img.shields.io/hackage-deps/v/warped.svg?style=flat+[stack]:       https://docs.haskellstack.org/en/stable/README/#how-to-install
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Shakefile.hs view
@@ -0,0 +1,45 @@+#!/usr/bin/env stack+{- stack+    runghc+    --package shakers+ -}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Shake makefile for project.+--+import Development.Shakers++-- | Main entry point.+--+main :: IO ()+main = shakeMain $ do+  let pats =+        [ "stack*.yaml"+        , "Shakefile.hs"+        , "src//*.hs"+        ]+      pats' = delete "stack*.yaml" pats++  -- | Haskell rules.+  --+  hsRules "." pats'++  -- | Cabal rules.+  --+  cabalRules "." "warped.cabal"++  -- | Stack rules.+  --+  stackRules "." pats++  -- | sanity+  --+  fake "." pats "sanity" $ const $ do+    need [ "build-error" ]+    need [ "lint", "weed" ]++  -- | Default things to run.+  --+  want [ "sanity", "format" ]
+ src/Network/Warped.hs view
@@ -0,0 +1,8 @@+-- | Public Module+--+module Network.Warped+  ( module Exports+  ) where++import Network.Warped.Application as Exports+import Network.Warped.Types       as Exports
+ src/Network/Warped/Application.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies      #-}++-- | Wai and Warp helpers.+--+module Network.Warped.Application+  ( flushBuilder+  , requestHeader+  , requestQuery+  , warp+  , warpCors+  , route+  , routeMethod+  , routePath+  , raceResponse+  , answer+  , answerStatus+  , answerSource+  , withHeader+  ) where++import Blaze.ByteString.Builder+import Control.Concurrent.Async.Lifted+import Control.Monad.Trans.Control+import Data.Conduit+import Data.UUID                       hiding (fromByteString)+import Network.HTTP.Types+import Network.Wai+import Network.Wai.Conduit+import Network.Wai.Handler.Warp+import Network.Wai.Middleware.Cors+import Network.Warped.Prelude+import Network.Warped.Types++-- | Session-Uid Header+--+hSessionUid :: HeaderName+hSessionUid = "Session-Uid"++-- | A Conduit for converting a ByteString to a Flush Builder.+--+flushBuilder :: Monad m => Conduit ByteString m (Flush Builder)+flushBuilder = awaitForever $ \chunk -> do+  yield $ Chunk $ fromByteString chunk+  yield Flush++-- | Lookup a request header.+--+requestHeader :: HeaderName -> Request -> Maybe ByteString+requestHeader header = lookup header . requestHeaders++-- | Look up a query parameter.+--+requestQuery :: ByteString -> Request -> Maybe ByteString+requestQuery key = join . lookup key . queryString++-- | Run warp with lifted type.+--+warp :: (MonadBaseControl IO m, StM m ResponseReceived ~ ResponseReceived) => Settings -> MonadApplication m -> m ()+warp settings app =+  liftBaseWith $ \runInIO ->+    runSettings settings $ \request response ->+      runInIO $ app request response++-- | Run warp with lifted type.+--+warpCors :: (MonadBaseControl IO m, StM m ResponseReceived ~ ResponseReceived) => Settings -> CorsResourcePolicy -> MonadApplication m -> m ()+warpCors settings policy app =+  liftBaseWith $ \runInIO ->+    runSettings settings $+      cors (const $ pure policy) $ \request response ->+        runInIO $ app request response++-- | Race between source and response - return whoever finishes first.+--+raceResponse :: MonadBaseControl IO m => m ResponseReceived -> m ResponseReceived -> m ResponseReceived+raceResponse a b = race a b >>= either pure pure++-- | General purpose router on requests.+--+route :: (MonadWai c m, Eq a) => (Request -> a) -> m ResponseReceived -> [(a, m ResponseReceived)] -> m ResponseReceived+route a b routes = do+  request <- view wcRequest+  lookupDefault b (a request) routes++-- | Route methods+--+routeMethod :: MonadWai c m => m ResponseReceived -> [(Method, m ResponseReceived)] -> m ResponseReceived+routeMethod = route requestMethod++-- | Route paths.+--+routePath :: MonadWai c m => m ResponseReceived -> [(ByteString, m ResponseReceived)] -> m ResponseReceived+routePath = route rawPathInfo++-- | All responses.+--+answer :: MonadWai c m => Response -> m ResponseReceived+answer response = do+  respond <- view wcRespond+  liftIO $ respond response++-- | Status response.+--+answerStatus :: MonadWai c m => Status -> ResponseHeaders -> m ResponseReceived+answerStatus status headers = do+  sessionUid <- view wcSessionUid+  let headers' = (hSessionUid, toASCIIBytes sessionUid) : headers+  answer $ responseLBS status headers' mempty++-- | Stream response.+--+answerSource :: MonadWai c m => Status -> ResponseHeaders -> Source IO (Flush Builder) -> m ResponseReceived+answerSource status headers response = do+  sessionUid <- view wcSessionUid+  let headers' = (hSessionUid, toASCIIBytes sessionUid) : headers+  answer $ responseSource status headers' response++-- | Lookup header.+--+withHeader :: MonadWai c m => HeaderName -> (HeaderName -> m ResponseReceived) -> (ByteString -> m ResponseReceived) -> m ResponseReceived+withHeader header noaction action = do+  request <- view wcRequest+  maybe (noaction header) action $ requestHeader header request
+ src/Network/Warped/Prelude.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE NoImplicitPrelude #-}++-- | Local Prelude.+--+module Network.Warped.Prelude+  ( module Exports+  , lookupDefault+  ) where++import Preamble as Exports++-- | lookup with a default.+--+lookupDefault :: Eq a => b -> a -> [(a, b)] -> b+lookupDefault b a m = fromMaybe b $ lookup a m
+ src/Network/Warped/Types.hs view
@@ -0,0 +1,8 @@+-- | Export all the modules in the Types directory.+--+module Network.Warped.Types+  ( module Exports+  ) where++import Network.Warped.Types.Alias as Exports+import Network.Warped.Types.Ctx   as Exports
+ src/Network/Warped/Types/Alias.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE ConstraintKinds   #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- | Various alias types.+--+module Network.Warped.Types.Alias+  ( module Network.Warped.Types.Alias+  ) where++import Network.Wai+import Network.Warped.Prelude++-- | Respond+--+type Respond = Response -> IO ResponseReceived++-- | MonadApplication+--+type MonadApplication m = Request -> Respond -> m ResponseReceived
+ src/Network/Warped/Types/Ctx.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE ConstraintKinds   #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell   #-}++-- | Contexts for monad transformers.+--+module Network.Warped.Types.Ctx+  ( module Network.Warped.Types.Ctx+  ) where++import Data.UUID+import Network.Wai+import Network.Warped.Prelude+import Network.Warped.Types.Alias++-- | WaiCtx+--+-- Context containing WAI application.+--+data WaiCtx = WaiCtx+  { _wcSessionUid :: UUID+    -- ^ Session Id.+  , _wcRequest    :: Request+    -- ^ WAI request.+  , _wcRespond    :: Respond+    -- ^ WAI response.+  }++$(makeClassy 'WaiCtx)++type MonadWai c m =+  ( MonadIO m+  , MonadReader c m+  , HasWaiCtx c+  )
+ warped.cabal view
@@ -0,0 +1,48 @@+name:                  warped+version:               0.0.1+synopsis:              Warp and Wai Library.+description:           Library support around WAI and warp server.+homepage:              https://github.com/swift-nav/warped+license:               MIT+license-file:          LICENSE+author:                Swift Navigation Inc.+maintainer:            Mark Fine <dev@swiftnav.com>+copyright:             Copyright (C) 2018 Swift Navigation, Inc.+category:              Network+build-type:            Simple+extra-source-files:    README.md+cabal-version:         >= 1.22++source-repository head+  type:                git+  location:            https://github.com/swift-nav/warped++library+  hs-source-dirs:      src+  exposed-modules:     Network.Warped+  other-modules:       Network.Warped.Application+                     , Network.Warped.Prelude+                     , Network.Warped.Types+                     , Network.Warped.Types.Alias+                     , Network.Warped.Types.Ctx+  ghc-options:         -Wall+  default-language:    Haskell2010+  build-depends:       base >= 4.9 && < 5+                     , blaze-builder+                     , conduit+                     , http-types+                     , lifted-async+                     , monad-control+                     , preamble+                     , uuid+                     , wai+                     , wai-conduit+                     , wai-cors+                     , warp++executable shake-wolf+  main-is:             Shakefile.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:    Haskell2010+  build-depends:       base >= 4.9 && < 5+                     , shakers