diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,42 @@ +wai-middleware-verbs +==================== + +Route to different Wai middleware based on the incoming HTTP verb +detected. + +## Usage + +This library depends on the [wai-transformers](https://hackage.haskell.org/package/wai-transformers) +package - we expect middleware to already be lifted to `MiddlewareT m`. + +As an example, here could be your application: + +```haskell +import Network.Wai.Trans +import Network.Wai.Middleware.Verbs + + +myMid1 :: MiddlewareT (ReaderT Env m) +myMid2 :: Middleware + +uploader :: Request -> m (Maybe u) +uploader _ = return Nothing + +uploadResponse :: Maybe u -> MiddlewareT m +uploadResponse _ = liftMiddleware (\t -> runReaderT t config) myMid2 + +verbRoutes :: VerbListenerT (MiddlewareT m) u m () +verbRoutes = do + get myMid1 + post uploader uploadResponse +``` + +Then, to use your newly assembled verb-router, turn the Verbs into a Middleware: + +```haskell +verbMid :: MiddlewareT (ReaderT Env m) +verbMid = verbsToMiddleware verbRoutes +``` + +From there, you can deconstruct your monolithic monad stack back down to `IO`, +and plug-it-in to your existing middleware. diff --git a/examples/Example.hs b/examples/Example.hs deleted file mode 100644 --- a/examples/Example.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-# LANGUAGE - OverloadedStrings - , DeriveDataTypeable - #-} - -module Main where - -import Network.Wai.Handler.Warp -import Network.Wai.Middleware.Verbs -import Network.Wai.Middleware.ContentType (textOnly) -import Network.Wai.Trans -import Network.HTTP.Types -import qualified Data.Text.Lazy as LT -import Data.Monoid -import Data.Typeable -import Control.Monad.IO.Class -import Control.Monad.Catch - - -theEmbeddedApp :: ( MonadIO m - ) => LT.Text -> ApplicationT m -theEmbeddedApp v _ respond = - respond $ textOnly (v <> " Verb accepted!") status200 [] - - -data UploadError = UploadFailed - deriving (Show, Typeable) - -instance Exception UploadError - -myListener :: ( MonadIO m - , MonadThrow m - ) => VerbListenerT (ApplicationT m) m () -myListener = do - get $ theEmbeddedApp "GET" - put $ readingRequest uploadFail - $ theEmbeddedApp "PUT" -- should never work - post $ readingRequest uploadSucceed - $ theEmbeddedApp "POST" - delete $ theEmbeddedApp "DELETE" - where - uploadFail _ = throwM UploadFailed - uploadSucceed _ = return () - -handleError :: ( MonadIO m - ) => UploadError -> ApplicationT m -handleError UploadFailed _ respond = - respond $ textOnly "Upload Failed!" status500 [] - - -myApp :: ( MonadIO m - , MonadCatch m - ) => MiddlewareT m -myApp app req respond = - findResponse `catch` (\e -> handleError e req respond) - where - findResponse = do - xs <- execVerbListenerT myListener - case lookupVerb (getVerb req) xs of - Nothing -> app req respond - Just r -> r req respond - - -main :: IO () -main = run 3000 (myApp defApp) - where - defApp :: Application - defApp _ respond = respond $ textOnly "404" status404 [] - - diff --git a/src/Network/Wai/Middleware/Verbs.hs b/src/Network/Wai/Middleware/Verbs.hs --- a/src/Network/Wai/Middleware/Verbs.hs +++ b/src/Network/Wai/Middleware/Verbs.hs @@ -54,27 +54,29 @@ import Network.Wai (Request (..)) -import Network.HTTP.Types +import Network.HTTP.Types (StdMethod (..), Method, methodDelete, methodPut, methodPost, methodGet) import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HM -import Data.Monoid -import Data.Hashable -import Control.Applicative -import Control.Monad.Trans -import Control.Monad.State hiding (get, put) -import qualified Control.Monad.State as S -import Control.Monad.Reader -import Control.Monad.Writer -import Control.Monad.Cont -import Control.Monad.Base -import Control.Monad.Catch -import Control.Monad.Trans.Resource -import Control.Monad.Except -import Control.Monad.Logger -import Control.Error +import Data.Monoid ((<>)) +import Data.Hashable (Hashable) +import Data.Maybe (fromMaybe) +import Control.Applicative (Alternative) +import Control.Monad (MonadPlus) +import Control.Monad.Fix (MonadFix) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Trans (MonadTrans (lift)) +import Control.Monad.State (MonadState, StateT (..), modify', execStateT) +import Control.Monad.Reader (MonadReader) +import Control.Monad.Writer (MonadWriter) +import Control.Monad.Cont (MonadCont) +import Control.Monad.Base (MonadBase) +import Control.Monad.Catch (MonadCatch, MonadThrow, MonadMask) +import Control.Monad.Trans.Resource (MonadResource) +import Control.Monad.Except (MonadError) +import Control.Monad.Logger (MonadLogger) -import GHC.Generics +import GHC.Generics (Generic) -- * Types diff --git a/wai-middleware-verbs.cabal b/wai-middleware-verbs.cabal --- a/wai-middleware-verbs.cabal +++ b/wai-middleware-verbs.cabal @@ -1,67 +1,50 @@ -Name: wai-middleware-verbs -Version: 0.3.2 -Author: Athan Clark -Maintainer: Athan Clark -License: BSD3 -License-File: LICENSE -Synopsis: Route different middleware responses based on the incoming HTTP verb. --- Description: -Cabal-Version: >= 1.10 -Build-Type: Simple -Category: Web +-- This file has been generated from package.yaml by hpack version 0.21.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 9c43d7c8db95eb21d2d5a3d86cdce709454c42de2d61fe27cb471a0c92115f4a -Flag Example - Description: Build a simple example - Default: False +name: wai-middleware-verbs +version: 0.3.2.1 +synopsis: Route Wai middlewares based on HTTP verbs +description: Please see the README on Github at +category: Web +homepage: https://github.com/athanclark/wai-middleware-verbs#readme +bug-reports: https://github.com/athanclark/wai-middleware-verbs/issues +author: Athan Clark +maintainer: athan.clark@localcooking.com +copyright: 2018 Athan Clark +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 -Library - Default-Language: Haskell2010 - HS-Source-Dirs: src - GHC-Options: -Wall - Exposed-Modules: Network.Wai.Middleware.Verbs - Build-Depends: base >= 4.8 && < 5 - , exceptions - , errors - , hashable - , http-types - , monad-logger - , mmorph - , mtl - , resourcet - , transformers - , transformers-base - , unordered-containers - , wai +extra-source-files: + README.md -Executable example - if flag(Example) - Buildable: True - else - Buildable: False - Default-Language: Haskell2010 - HS-Source-Dirs: src - , examples - GHC-Options: -Wall - Main-Is: Example.hs - Other-Modules: Network.Wai.Middleware.Verbs - Build-Depends: base >= 4.8 && < 5 - , exceptions - , errors - , hashable - , http-types - , monad-logger - , mmorph - , mtl - , resourcet - , text - , transformers - , transformers-base - , unordered-containers - , wai - , wai-transformers >= 0.0.5 - , wai-middleware-content-type >= 0.2.1 - , warp +source-repository head + type: git + location: https://github.com/athanclark/wai-middleware-verbs -Source-Repository head - Type: git - Location: https://github.com/athanclark/wai-middleware-verbs +library + exposed-modules: + Network.Wai.Middleware.Verbs + other-modules: + Paths_wai_middleware_verbs + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + base >=4.8 && <5 + , exceptions + , hashable + , http-types + , mmorph + , monad-logger + , mtl + , resourcet + , transformers + , transformers-base + , unordered-containers + , wai >=3.2.1 + default-language: Haskell2010