webby 0.3.1 → 0.4.0
raw patch · 5 files changed
+114/−66 lines, 5 filesdep −fast-loggerdep −monad-logger
Dependencies removed: fast-logger, monad-logger
Files
- README.md +43/−10
- src/Webby.hs +6/−0
- src/Webby/Server.hs +18/−21
- src/Webby/Types.hs +38/−22
- webby.cabal +9/−13
README.md view
@@ -11,27 +11,60 @@ ``` haskell module Main where -import qualified Data.Text as T import qualified Network.Wai.Handler.Warp as W+import qualified Network.Wai as W+import Network.HTTP.Types (status500)+ import UnliftIO (liftIO) import qualified UnliftIO.Exception as E +import Relude hiding (get, put)+import Relude.Print (putTextLn)+import qualified Data.Text as T+ import Webby +-- An example exception handler web-applications can install with webby+appExceptionHandler :: T.Text -> (E.SomeException -> WebbyM appEnv ())+appExceptionHandler appName = \(exception :: E.SomeException) -> do+ setStatus status500+ let msg = appName <> " failed with " <> show exception+ putTextLn msg+ text msg+ main :: IO () main = do- let routes = [ get "/api/a" (text "a")- , get "/api/b" (text "b")- , post "/api/capture/:id" (do idVal :: Int <- getCapture "id"- text $ T.pack $ show idVal- )+ -- Define the API routes handled by your web-application+ let routes = [ get "/api/a" (text "a\n")+ , get "/api/b" (text "b\n")+ , post "/api/capture/:id"+ (do idVal :: Int <- getCapture "id"+ text $ (T.pack (show idVal) `T.append` "\n")+ )+ , get "/api/isOdd/:val"+ (do val :: Integer <- getCapture "val"+ -- if val is odd return the number else we short-circuit the handler+ unless (odd val) finish+ text $ show val+ ) , get "/api/showEnv" (do env <- getAppEnv- json env+ text env ) , get "/aaah" (liftIO $ E.throwString "oops!") ] - webbyApp <- mkWebbyApp (3::Int) routes+ -- Set the routes definition and exception handler for your+ -- web-application+ webbyConfig = setExceptionHandler (appExceptionHandler "MyApp") $+ setRoutes routes $+ defaultWebbyServerConfig++ -- Application environment in this example is a simple Text literal.+ -- Usually, application environment would contain database connections+ -- etc.+ appEnv = "MyEnv" :: T.Text++ webbyApp <- mkWebbyApp appEnv webbyConfig putStrLn "Starting webserver..." W.runEnv 7000 webbyApp ```@@ -55,9 +88,9 @@ $ curl http://localhost:7000/api/showEnv MyEnv $ curl http://localhost:7000/aaah-Control.Exception.Safe.throwString called with:+MyApp failed with Control.Exception.Safe.throwString called with: oops! Called from:- throwString (examples/Basic.hs:32:42 in main:Main)+ throwString (examples/Basic.hs:55:42 in main:Main) ```
src/Webby.hs view
@@ -46,6 +46,12 @@ , getAppEnv , runAppEnv + -- * Webby server configuration+ , WebbyServerConfig+ , defaultWebbyServerConfig+ , setRoutes+ , setExceptionHandler+ -- * Handler flow control , finish
src/Webby/Server.hs view
@@ -1,7 +1,6 @@ module Webby.Server where -import qualified Control.Monad.Logger as Log import qualified Data.Aeson as A import qualified Data.Binary.Builder as Bu import qualified Data.ByteString.Lazy as LB@@ -10,8 +9,6 @@ import qualified Data.Text as T import Network.HTTP.Types.URI (queryToQueryText) import Network.Wai.Internal (getRequestBodyChunk)-import qualified System.Log.FastLogger as FLog-import System.Log.FastLogger.Date (newTimeCache) import qualified UnliftIO.Concurrent as Conc import qualified UnliftIO.Exception as E import Web.HttpApiData@@ -186,23 +183,28 @@ -- defined `appEnv` data type and a list of routes. Routes are matched in the -- given order. If none of the requests match a request, a default 404 response -- is returned.-mkWebbyApp :: appEnv -> [Route appEnv] -> IO Application-mkWebbyApp appEnv routes' = do- lset <- FLog.newStdoutLoggerSet FLog.defaultBufSize- return $ mkApp lset routes' +mkWebbyApp :: env -> WebbyServerConfig env -> IO Application+mkWebbyApp env wsc =+ return $ mkApp where-- mkApp lset routes req respond = do- let defaultHandler = errorResponse404- (cs, handler) = fromMaybe (H.empty, defaultHandler) $- matchRequest req routes+ shortCircuitHandler =+ [ -- Handler for FinishThrown exception to guide+ -- short-circuiting handlers to early completion+ E.Handler (\(ex :: FinishThrown) -> E.throwIO ex)+ ]+ mkApp req respond = do+ let defaultHandler = errorResponse404+ routes = wscRoutes wsc+ exceptionHandlerMay = wscExceptionHandler wsc+ (cs, handler) = fromMaybe (H.empty, defaultHandler) $+ matchRequest req routes - timeFn <- newTimeCache "%Y-%m-%dT%H:%M:%S " wEnv <- do v <- Conc.newMVar defaultWyResp- return $ WEnv v cs req appEnv lset timeFn-- (do runWebbyM wEnv handler+ return $ WEnv v cs req env exceptionHandlerMay+ (do runWebbyM wEnv $ handler `E.catches`+ (shortCircuitHandler+ <> fmap (\(WebbyExceptionHandler e) -> E.Handler e) (maybeToList exceptionHandlerMay)) webbyReply wEnv respond) `E.catches` [ -- Handles Webby' exceptions while parsing parameters -- and request body@@ -217,11 +219,6 @@ -- Handles Webby's finish statement , E.Handler (\(_ :: FinishThrown) -> webbyReply wEnv respond)-- -- Handles any other exception thrown in the handler- , E.Handler (\(ex :: E.SomeException) -> do- Log.runStdoutLoggingT $ Log.logInfoN (show ex)- respond $ responseLBS status500 [] (show ex)) ] webbyReply wEnv respond' = do
src/Webby/Types.hs view
@@ -1,12 +1,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ExistentialQuantification #-} module Webby.Types where -import qualified Control.Monad.Logger as Log import qualified Data.Binary.Builder as Bu import qualified Data.HashMap.Strict as H import qualified Data.Text as T-import System.Log.FastLogger (FormattedTime)-import qualified System.Log.FastLogger as FLog import qualified UnliftIO as U import qualified UnliftIO.Concurrent as Conc @@ -23,15 +21,16 @@ defaultWyResp :: WyResp defaultWyResp = WyResp status200 [] (Right Bu.empty) False +data WebbyExceptionHandler env = forall e . Exception e => WebbyExceptionHandler (e -> (WebbyM env) ())+ -- | The reader environment used by the web framework. It is -- parameterized by the application's environment data type.-data WEnv appEnv = WEnv { weResp :: Conc.MVar WyResp- , weCaptures :: Captures- , weRequest :: Request- , weAppEnv :: appEnv- , weLoggerSet :: FLog.LoggerSet- , weLogTime :: IO FormattedTime- }+data WEnv env = WEnv { weResp :: Conc.MVar WyResp+ , weCaptures :: Captures+ , weRequest :: Request+ , weAppEnv :: env+ , weExceptionHandler :: Maybe (WebbyExceptionHandler env)+ } -- | The main monad transformer stack used in the web-framework. --@@ -39,10 +38,10 @@ -- `appEnv` parameter is used by the web application to store an -- (read-only) environment. For e.g. it can be used to store a -- database connection pool.-newtype WebbyM appEnv a = WebbyM- { unWebbyM :: ReaderT (WEnv appEnv) (ResourceT IO) a+newtype WebbyM env a = WebbyM+ { unWebbyM :: ReaderT (WEnv env) (ResourceT IO) a }- deriving (Functor, Applicative, Monad, MonadIO, MonadReader (WEnv appEnv))+ deriving (Functor, Applicative, Monad, MonadIO, MonadReader (WEnv env)) instance U.MonadUnliftIO (WebbyM appData) where askUnliftIO = WebbyM $ ReaderT $@@ -50,15 +49,6 @@ \u -> return $ U.UnliftIO (U.unliftIO u . flip runReaderT w . unWebbyM) -instance Log.MonadLogger (WebbyM env) where- monadLoggerLog loc src lvl msg = do- lset <- asks weLoggerSet- ltime <- asks weLogTime- tstr <- liftIO ltime- let logstr = Log.toLogStr tstr <>- (Log.defaultLogStr loc src lvl $ Log.toLogStr msg)- liftIO $ FLog.pushLogStr lset logstr- runWebbyM :: WEnv w -> WebbyM w a -> IO a runWebbyM env = runResourceT . flip runReaderT env . unWebbyM @@ -96,3 +86,29 @@ displayException (WebbyMissingCapture capName) = T.unpack $ sformat (st % " missing") capName++data WebbyServerConfig env = WebbyServerConfig+ { wscRoutes :: [Route env]+ , wscExceptionHandler :: Maybe (WebbyExceptionHandler env)+ }++defaultWebbyServerConfig :: WebbyServerConfig env+defaultWebbyServerConfig = WebbyServerConfig+ { wscRoutes = []+ , wscExceptionHandler = Nothing :: Maybe (WebbyExceptionHandler env)+ }++setRoutes :: [Route env]+ -> WebbyServerConfig env+ -> WebbyServerConfig env+setRoutes routes wsc = wsc { wscRoutes = routes+ }++setExceptionHandler :: Exception e+ => (e -> WebbyM env ())+ -> WebbyServerConfig env+ -> WebbyServerConfig env+setExceptionHandler exceptionHandler wsc =+ WebbyServerConfig { wscRoutes = wscRoutes wsc+ , wscExceptionHandler = Just $ WebbyExceptionHandler exceptionHandler+ }
webby.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 65bbfd9f416a142a8a1486ee20e9bf0dc2bb5715c5086ae8f3587951a83de9b8+-- hash: bfb0c373ed44cff2bdb24832b270b756c77829da9cdacc96529b25985b637c95 name: webby-version: 0.3.1+version: 0.4.0 synopsis: A super-simple web server framework description: A super-simple, easy to use web server framework inspired by Scotty. The goals of the project are: (1) Be easy to use (2) Allow@@ -32,6 +32,13 @@ default: False library+ exposed-modules:+ Webby+ other-modules:+ Prelude+ Webby.Server+ Webby.Types+ Paths_webby hs-source-dirs: src default-extensions: FlexibleInstances MultiParamTypeClasses MultiWayIf NoImplicitPrelude OverloadedStrings ScopedTypeVariables TupleSections@@ -41,11 +48,9 @@ , base-noprelude >=4.7 && <5 , binary >=0.8 && <0.9 , bytestring >=0.10 && <0.11- , fast-logger >=2.4 && <2.5 , formatting >=6.3 && <6.4 , http-api-data >=0.3 && <0.5 , http-types >=0.12 && <0.13- , monad-logger >=0.3 && <0.4 , relude , resourcet >=1.2 && <1.3 , text >=1.2 && <1.3@@ -54,13 +59,6 @@ , wai >=3.2 && <3.3 if flag(dev) ghc-options: -Wall -Werror- exposed-modules:- Webby- Prelude- other-modules:- Webby.Server- Webby.Types- Paths_webby default-language: Haskell2010 test-suite webby-test@@ -82,11 +80,9 @@ , base-noprelude >=4.7 && <5 , binary >=0.8 && <0.9 , bytestring >=0.10 && <0.11- , fast-logger >=2.4 && <2.5 , formatting >=6.3 && <6.4 , http-api-data >=0.3 && <0.5 , http-types >=0.12 && <0.13- , monad-logger >=0.3 && <0.4 , relude , resourcet >=1.2 && <1.3 , tasty