scotty 0.5.0 → 0.6.0
raw patch · 15 files changed
+415/−339 lines, 15 filesdep ~aesondep ~blaze-builderdep ~bytestring
Dependency ranges changed: aeson, blaze-builder, bytestring, case-insensitive, conduit, data-default, http-types, mtl, regex-compat, resourcet, text, transformers, wai, wai-extra, warp
Files
- ReleaseNotes.md +15/−1
- Web/Scotty.hs +24/−14
- Web/Scotty/Action.hs +63/−59
- Web/Scotty/Route.hs +24/−26
- Web/Scotty/Trans.hs +16/−10
- Web/Scotty/Types.hs +89/−38
- Web/Scotty/Util.hs +15/−29
- examples/basic.hs +1/−1
- examples/cookies.hs +62/−0
- examples/exceptions.hs +62/−0
- examples/globalstate.hs +20/−12
- examples/json.hs +0/−66
- examples/static/json.js +0/−59
- examples/upload.hs +1/−1
- scotty.cabal +23/−23
ReleaseNotes.md view
@@ -1,3 +1,17 @@+## 0.6.0++* The Scotty transformers (`ScottyT` and `ActionT`) are now parameterized+ over a custom exception type, allowing one to extend Scotty's `ErrorT`+ layer with something richer than `Text` errors. See the `exceptions`+ example for use. `ScottyM` and `ActionM` remain specialized to `Text`+ exceptions for simplicity.++* Both monads are now instances of `Functor` and `Applicative`.++* There is a new `cookies` example.++* Internals brought up-to-date with WAI 2.0 and related packages.+ ## 0.5.0 * The Scotty monads (`ScottyM` and `ActionM`) are now monad transformers,@@ -25,4 +39,4 @@ * `header` split into `setHeader` and `addHeader`. The former replaces a response header (original behavior). The latter adds a header (useful- for multiple `Set-Cookie`s, for instance.+ for multiple `Set-Cookie`s, for instance).
Web/Scotty.hs view
@@ -22,7 +22,7 @@ -- definition, as they completely replace the current 'Response' body. , text, html, file, json, source, raw -- ** Exceptions- , raise, rescue, next+ , raise, rescue, next, defaultHandler -- * Parsing Parameters , Param, Trans.Parsable(..), Trans.readEither -- * Types@@ -36,15 +36,18 @@ import Data.Aeson (FromJSON, ToJSON) import Data.ByteString.Lazy.Char8 (ByteString)-import Data.Conduit (Flush, ResourceT, Source)+import Data.Conduit (Flush, Source) import Data.Text.Lazy (Text) import Network.HTTP.Types (Status, StdMethod) import Network.Wai (Application, Middleware, Request) import Network.Wai.Handler.Warp (Port) -import Web.Scotty.Types (Param, ActionM, ScottyM, RoutePattern, Options, File)+import Web.Scotty.Types (ScottyT, ActionT, Param, RoutePattern, Options, File) +type ScottyM = ScottyT Text IO+type ActionM = ActionT Text IO + -- | Run a scotty application using the warp server. scotty :: Port -> ScottyM () -> IO () scotty p = Trans.scottyT p id id@@ -58,6 +61,13 @@ scottyApp :: ScottyM () -> IO Application scottyApp = Trans.scottyAppT id id +-- | Global handler for uncaught exceptions. +--+-- Uncaught exceptions normally become 500 responses. +-- You can use this to selectively override that behavior.+defaultHandler :: (Text -> ActionM ()) -> ScottyM ()+defaultHandler = Trans.defaultHandler+ -- | Use given middleware. Middleware is nested such that the first declared -- is the outermost middleware (it has first dibs on the request and last action -- on the response). Every middleware is run on each request.@@ -75,14 +85,14 @@ -- As an example, these two routes overlap. The only way the second one will -- ever run is if the first one calls 'next'. ----- > get "/foo/:number" $ do--- > n <- param "number"--- > unless (all isDigit n) $ next--- > text "a number"--- > -- > get "/foo/:bar" $ do--- > bar <- param "bar"--- > text "not a number"+-- > w :: Text <- param "bar"+-- > unless (w == "special") next+-- > text "You made a request to /foo/special"+-- >+-- > get "/foo/:baz" $ do+-- > w <- param "baz"+-- > text $ "You made a request to: " <> w next :: ActionM a next = Trans.next @@ -161,7 +171,7 @@ html = Trans.html -- | Send a file as the response. Doesn't set the \"Content-Type\" header, so you probably--- want to do that on your own with 'header'.+-- want to do that on your own with 'setHeader'. file :: FilePath -> ActionM () file = Trans.file @@ -172,12 +182,12 @@ -- | Set the body of the response to a Source. Doesn't set the -- \"Content-Type\" header, so you probably want to do that on your--- own with 'header'.-source :: Source (ResourceT IO) (Flush Builder) -> ActionM ()+-- own with 'setHeader'.+source :: Source IO (Flush Builder) -> ActionM () source = Trans.source -- | Set the body of the response to the given 'BL.ByteString' value. Doesn't set the--- \"Content-Type\" header, so you probably want to do that on your own with 'header'.+-- \"Content-Type\" header, so you probably want to do that on your own with 'setHeader'. raw :: ByteString -> ActionM () raw = Trans.raw
Web/Scotty/Action.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, RankNTypes #-} module Web.Scotty.Action ( addHeader , body@@ -37,11 +37,12 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.CaseInsensitive as CI-import Data.Conduit (Flush, ResourceT, Source)+import Data.Conduit (Flush, Source) import Data.Default (def)-import Data.Monoid (mconcat, (<>))+import Data.Monoid (mconcat)+import qualified Data.Text as ST import qualified Data.Text.Lazy as T-import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8)+import Data.Text.Lazy.Encoding (encodeUtf8) import Network.HTTP.Types import Network.Wai@@ -51,27 +52,29 @@ -- Nothing indicates route failed (due to Next) and pattern matching should continue. -- Just indicates a successful response.-runAction :: Monad m => ActionEnv -> ActionT m () -> m (Maybe Response)-runAction env action = do+runAction :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionEnv -> ActionT e m () -> m (Maybe Response)+runAction h env action = do (e,r) <- flip MS.runStateT def $ flip runReaderT env $ runErrorT $ runAM- $ action `catchError` defaultHandler- return $ either (const Nothing) (const $ Just r) e+ $ action `catchError` (defH h)+ return $ either (const Nothing) (const $ Just $ mkResponse r) e -defaultHandler :: Monad m => ActionError -> ActionT m ()-defaultHandler (Redirect url) = do+-- | Default error handler for all actions.+defH :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionError e -> ActionT e m ()+defH _ (Redirect url) = do status status302 setHeader "Location" url-defaultHandler (ActionError msg) = do+defH Nothing (ActionError e) = do status status500- html $ mconcat ["<h1>500 Internal Server Error</h1>", msg]-defaultHandler Next = next+ html $ mconcat ["<h1>500 Internal Server Error</h1>", showError e]+defH h@(Just f) (ActionError e) = f e `catchError` (defH h) -- so handlers can throw exceptions themselves+defH _ Next = next -- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions -- turn into HTTP 500 responses.-raise :: Monad m => T.Text -> ActionT m a+raise :: (ScottyError e, Monad m) => e -> ActionT e m a raise = throwError . ActionError -- | Abort execution of this action and continue pattern matching routes.@@ -80,24 +83,24 @@ -- As an example, these two routes overlap. The only way the second one will -- ever run is if the first one calls 'next'. ----- > get "/foo/:number" $ do--- > n <- param "number"--- > unless (all isDigit n) $ next--- > text "a number"--- > -- > get "/foo/:bar" $ do--- > bar <- param "bar"--- > text "not a number"-next :: Monad m => ActionT m a+-- > w :: Text <- param "bar"+-- > unless (w == "special") next+-- > text "You made a request to /foo/special"+-- >+-- > get "/foo/:baz" $ do+-- > w <- param "baz"+-- > text $ "You made a request to: " <> w+next :: (ScottyError e, Monad m) => ActionT e m a next = throwError Next -- | Catch an exception thrown by 'raise'. -- -- > raise "just kidding" `rescue` (\msg -> text msg)-rescue :: Monad m => ActionT m a -> (T.Text -> ActionT m a) -> ActionT m a-rescue action handler = catchError action $ \e -> case e of- ActionError msg -> handler msg -- handle errors- other -> throwError other -- rethrow redirects and nexts+rescue :: (ScottyError e, Monad m) => ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a+rescue action h = catchError action $ \e -> case e of+ ActionError err -> h err -- handle errors+ other -> throwError other -- rethrow internal error types -- | Redirect to given URL. Like throwing an uncatchable exception. Any code after the call to redirect -- will not be run.@@ -107,32 +110,32 @@ -- OR -- -- > redirect "/foo/bar"-redirect :: Monad m => T.Text -> ActionT m a+redirect :: (ScottyError e, Monad m) => T.Text -> ActionT e m a redirect = throwError . Redirect -- | Get the 'Request' object.-request :: Monad m => ActionT m Request-request = liftM getReq ask+request :: (ScottyError e, Monad m) => ActionT e m Request+request = ActionT $ liftM getReq ask -- | Get list of uploaded files.-files :: Monad m => ActionT m [File]-files = liftM getFiles ask+files :: (ScottyError e, Monad m) => ActionT e m [File]+files = ActionT $ liftM getFiles ask -- | Get a request header. Header name is case-insensitive.-reqHeader :: Monad m => T.Text -> ActionT m (Maybe T.Text)+reqHeader :: (ScottyError e, Monad m) => T.Text -> ActionT e m (Maybe T.Text) reqHeader k = do hs <- liftM requestHeaders request return $ fmap strictByteStringToLazyText $ lookup (CI.mk (lazyTextToStrictByteString k)) hs -- | Get the request body.-body :: Monad m => ActionT m BL.ByteString-body = liftM getBody ask+body :: (ScottyError e, Monad m) => ActionT e m BL.ByteString+body = ActionT $ liftM getBody ask -- | Parse the request body as a JSON object and return it. Raises an exception if parse is unsuccessful.-jsonData :: (A.FromJSON a, Monad m) => ActionT m a+jsonData :: (A.FromJSON a, ScottyError e, Monad m) => ActionT e m a jsonData = do b <- body- maybe (raise $ "jsonData - no parse: " <> decodeUtf8 b) return $ A.decode b+ maybe (raise $ stringError $ "jsonData - no parse: " ++ BL.unpack b) return $ A.decode b -- | Get a parameter. First looks in captures, then form data, then query parameters. --@@ -141,16 +144,16 @@ -- * If parameter is found, but 'read' fails to parse to the correct type, 'next' is called. -- This means captures are somewhat typed, in that a route won't match if a correctly typed -- capture cannot be parsed.-param :: (Parsable a, Monad m) => T.Text -> ActionT m a+param :: (Parsable a, ScottyError e, Monad m) => T.Text -> ActionT e m a param k = do- val <- liftM (lookup k . getParams) ask+ val <- ActionT $ liftM (lookup k . getParams) ask case val of- Nothing -> raise $ mconcat ["Param: ", k, " not found!"]+ Nothing -> raise $ stringError $ "Param: " ++ T.unpack k ++ " not found!" Just v -> either (const next) return $ parseParam v -- | Get all parameters from capture, form and query (in that order).-params :: Monad m => ActionT m [Param]-params = liftM getParams ask+params :: (ScottyError e, Monad m) => ActionT e m [Param]+params = ActionT $ liftM getParams ask -- | Minimum implemention: 'parseParam' class Parsable a where@@ -165,6 +168,7 @@ -- No point using 'read' for Text, ByteString, Char, and String. instance Parsable T.Text where parseParam = Right+instance Parsable ST.Text where parseParam = Right . T.toStrict instance Parsable B.ByteString where parseParam = Right . lazyTextToStrictByteString -- | Overrides default 'parseParamList' to parse String. instance Parsable Char where@@ -195,52 +199,52 @@ _ -> Left "readEither: ambiguous parse" -- | Set the HTTP response status. Default is 200.-status :: Monad m => Status -> ActionT m ()-status = MS.modify . setStatus+status :: (ScottyError e, Monad m) => Status -> ActionT e m ()+status = ActionT . MS.modify . setStatus -- | Add to the response headers. Header names are case-insensitive.-addHeader :: Monad m => T.Text -> T.Text -> ActionT m ()-addHeader k v = MS.modify $ setHeaderWith $ add (CI.mk $ lazyTextToStrictByteString k) (lazyTextToStrictByteString v)+addHeader :: (ScottyError e, Monad m) => T.Text -> T.Text -> ActionT e m ()+addHeader k v = ActionT . MS.modify $ setHeaderWith $ add (CI.mk $ lazyTextToStrictByteString k) (lazyTextToStrictByteString v) -- | Set one of the response headers. Will override any previously set value for that header. -- Header names are case-insensitive.-setHeader :: Monad m => T.Text -> T.Text -> ActionT m ()-setHeader k v = MS.modify $ setHeaderWith $ replace (CI.mk $ lazyTextToStrictByteString k) (lazyTextToStrictByteString v)+setHeader :: (ScottyError e, Monad m) => T.Text -> T.Text -> ActionT e m ()+setHeader k v = ActionT . MS.modify $ setHeaderWith $ replace (CI.mk $ lazyTextToStrictByteString k) (lazyTextToStrictByteString v) -- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\" -- header to \"text/plain\".-text :: Monad m => T.Text -> ActionT m ()+text :: (ScottyError e, Monad m) => T.Text -> ActionT e m () text t = do setHeader "Content-Type" "text/plain" raw $ encodeUtf8 t -- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\" -- header to \"text/html\".-html :: Monad m => T.Text -> ActionT m ()+html :: (ScottyError e, Monad m) => T.Text -> ActionT e m () html t = do setHeader "Content-Type" "text/html" raw $ encodeUtf8 t -- | Send a file as the response. Doesn't set the \"Content-Type\" header, so you probably--- want to do that on your own with 'header'.-file :: Monad m => FilePath -> ActionT m ()-file = MS.modify . setContent . ContentFile+-- want to do that on your own with 'setHeader'.+file :: (ScottyError e, Monad m) => FilePath -> ActionT e m ()+file = ActionT . MS.modify . setContent . ContentFile -- | Set the body of the response to the JSON encoding of the given value. Also sets \"Content-Type\" -- header to \"application/json\".-json :: (A.ToJSON a, Monad m) => a -> ActionT m ()+json :: (A.ToJSON a, ScottyError e, Monad m) => a -> ActionT e m () json v = do setHeader "Content-Type" "application/json" raw $ A.encode v -- | Set the body of the response to a Source. Doesn't set the -- \"Content-Type\" header, so you probably want to do that on your--- own with 'header'.-source :: Monad m => Source (ResourceT IO) (Flush Builder) -> ActionT m ()-source = MS.modify . setContent . ContentSource+-- own with 'setHeader'.+source :: (ScottyError e, Monad m) => Source IO (Flush Builder) -> ActionT e m ()+source = ActionT . MS.modify . setContent . ContentSource -- | Set the body of the response to the given 'BL.ByteString' value. Doesn't set the -- \"Content-Type\" header, so you probably want to do that on your--- own with 'header'.-raw :: Monad m => BL.ByteString -> ActionT m ()-raw = MS.modify . setContent . ContentBuilder . fromLazyByteString+-- own with 'setHeader'.+raw :: (ScottyError e, Monad m) => BL.ByteString -> ActionT e m ()+raw = ActionT . MS.modify . setContent . ContentBuilder . fromLazyByteString
Web/Scotty/Route.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, FlexibleInstances, ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings, FlexibleContexts, FlexibleInstances, RankNTypes #-} module Web.Scotty.Route ( get, post, put, delete, patch, addroute, matchAny, notFound, capture, regex, function, literal@@ -7,7 +7,7 @@ import Control.Arrow ((***)) import Control.Monad.Error import qualified Control.Monad.State as MS-import Control.Monad.Trans.Resource (ResourceT, transResourceT)+import Control.Monad.Trans.Resource (runResourceT, withInternalState, MonadBaseControl) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL@@ -32,32 +32,32 @@ import Web.Scotty.Util -- | get = 'addroute' 'GET'-get :: MonadIO m => RoutePattern -> ActionT m () -> ScottyT m ()+get :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m () get = addroute GET -- | post = 'addroute' 'POST'-post :: MonadIO m => RoutePattern -> ActionT m () -> ScottyT m ()+post :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m () post = addroute POST -- | put = 'addroute' 'PUT'-put :: MonadIO m => RoutePattern -> ActionT m () -> ScottyT m ()+put :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m () put = addroute PUT -- | delete = 'addroute' 'DELETE'-delete :: MonadIO m => RoutePattern -> ActionT m () -> ScottyT m ()+delete :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m () delete = addroute DELETE -- | patch = 'addroute' 'PATCH'-patch :: MonadIO m => RoutePattern -> ActionT m () -> ScottyT m ()+patch :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m () patch = addroute PATCH -- | Add a route that matches regardless of the HTTP verb.-matchAny :: MonadIO m => RoutePattern -> ActionT m () -> ScottyT m ()+matchAny :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m () matchAny pattern action = mapM_ (\v -> addroute v pattern action) [minBound..maxBound] -- | Specify an action to take if nothing else is found. Note: this _always_ matches, -- so should generally be the last route specified.-notFound :: MonadIO m => ActionT m () -> ScottyT m ()+notFound :: (ScottyError e, MonadIO m) => ActionT e m () -> ScottyT e m () notFound action = matchAny (Function (\req -> Just [("path", path req)])) (status status404 >> action) -- | Define a route with a 'StdMethod', 'T.Text' value representing the path spec,@@ -74,29 +74,26 @@ -- -- >>> curl http://localhost:3000/foo/something -- something-addroute :: MonadIO m => StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()-addroute method pat action = MS.modify $ addRoute $ route method pat action+addroute :: (ScottyError e, MonadIO m) => StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()+addroute method pat action = ScottyT $ MS.modify $ \s -> addRoute (route (handler s) method pat action) s -route :: MonadIO m => StdMethod -> RoutePattern -> ActionT m () -> Middleware m-route method pat action app req =+route :: (ScottyError e, MonadIO m) => ErrorHandler e m -> StdMethod -> RoutePattern -> ActionT e m () -> Middleware m+route h method pat action app req = let tryNext = app req in if Right method == parseMethod (requestMethod req) then case matchRoute pat req of Just captures -> do env <- mkEnv req captures- res <- lift $ runAction env action+ res <- runAction h env action maybe tryNext return res Nothing -> tryNext else tryNext matchRoute :: RoutePattern -> Request -> Maybe [Param]--matchRoute (Literal pat) req | pat == path req = Just []- | otherwise = Nothing-+matchRoute (Literal pat) req | pat == path req = Just []+ | otherwise = Nothing matchRoute (Function fun) req = fun req--matchRoute (Capture pat) req = go (T.split (=='/') pat) (T.split (=='/') $ path req) []+matchRoute (Capture pat) req = go (T.split (=='/') pat) (T.split (=='/') $ path req) [] where go [] [] prs = Just prs -- request string and pattern match! go [] r prs | T.null (mconcat r) = Just prs -- in case request has trailing slashes | otherwise = Nothing -- request string is longer than pattern@@ -112,21 +109,22 @@ path = T.fromStrict . TS.cons '/' . TS.intercalate "/" . pathInfo -- Stolen from wai-extra, modified to accept body as lazy ByteString-parseRequestBody :: MonadIO m+parseRequestBody :: (MonadBaseControl IO m, MonadIO m) => BL.ByteString -> Parse.BackEnd y -> Request- -> ResourceT m ([Parse.Param], [Parse.File y])+ -> m ([Parse.Param], [Parse.File y]) parseRequestBody b s r = case Parse.getRequestBodyType r of Nothing -> return ([], [])- Just rbt -> transResourceT liftIO $ liftM partitionEithers $ sourceLbs b $$ Parse.conduitRequestBody s rbt =$ consume+ Just rbt -> runResourceT $ withInternalState $ \ is -> + liftIO $ liftM partitionEithers $ sourceLbs b $$ Parse.conduitRequestBody is s rbt =$ consume -mkEnv :: MonadIO m => Request -> [Param] -> ResourceT m ActionEnv+mkEnv :: MonadIO m => Request -> [Param] -> m ActionEnv mkEnv req captures = do- b <- transResourceT liftIO $ liftM BL.fromChunks $ lazyConsume (requestBody req)+ b <- liftIO $ liftM BL.fromChunks $ lazyConsume (requestBody req) - (formparams, fs) <- transResourceT liftIO $ parseRequestBody b Parse.lbsBackEnd req+ (formparams, fs) <- liftIO $ parseRequestBody b Parse.lbsBackEnd req let convert (k, v) = (strictByteStringToLazyText k, strictByteStringToLazyText v) parameters = captures ++ map convert formparams ++ queryparams
Web/Scotty/Trans.hs view
@@ -26,11 +26,11 @@ -- definition, as they completely replace the current 'Response' body. , text, html, file, json, source, raw -- ** Exceptions- , raise, rescue, next+ , raise, rescue, next, defaultHandler, ScottyError(..) -- * Parsing Parameters , Param, Parsable(..), readEither -- * Types- , ScottyM, ActionM, RoutePattern, File+ , RoutePattern, File -- * Monad Transformers , ScottyT, ActionT ) where@@ -39,7 +39,6 @@ import Control.Monad (when) import Control.Monad.State (execStateT, modify)-import Control.Monad.Trans.Resource (transResourceT) import Control.Monad.IO.Class import Data.Default (def)@@ -59,7 +58,7 @@ => Port -> (forall a. m a -> n a) -- ^ Run monad 'm' into monad 'n', called once at 'ScottyT' level. -> (m Response -> IO Response) -- ^ Run monad 'm' into 'IO', called at each action.- -> ScottyT m ()+ -> ScottyT e m () -> n () scottyT p = scottyOptsT $ def { settings = (settings def) { settingsPort = p } } @@ -69,7 +68,7 @@ => Options -> (forall a. m a -> n a) -- ^ Run monad 'm' into monad 'n', called once at 'ScottyT' level. -> (m Response -> IO Response) -- ^ Run monad 'm' into 'IO', called at each action.- -> ScottyT m ()+ -> ScottyT e m () -> n () scottyOptsT opts runM runActionToIO s = do when (verbose opts > 0) $@@ -82,19 +81,26 @@ scottyAppT :: (Monad m, Monad n) => (forall a. m a -> n a) -- ^ Run monad 'm' into monad 'n', called once at 'ScottyT' level. -> (m Response -> IO Response) -- ^ Run monad 'm' into 'IO', called at each action.- -> ScottyT m ()+ -> ScottyT e m () -> n Application scottyAppT runM runActionToIO defs = do s <- runM $ execStateT (runS defs) def- let rapp = transResourceT runActionToIO . foldl (flip ($)) notFoundApp (routes s)+ let rapp = runActionToIO . foldl (flip ($)) notFoundApp (routes s) return $ foldl (flip ($)) rapp (middlewares s) notFoundApp :: Monad m => Scotty.Application m-notFoundApp _ = return $ ResponseBuilder status404 [("Content-Type","text/html")]+notFoundApp _ = return $ responseBuilder status404 [("Content-Type","text/html")] $ fromByteString "<h1>404: File Not Found!</h1>" +-- | Global handler for uncaught exceptions. +--+-- Uncaught exceptions normally become 500 responses. +-- You can use this to selectively override that behavior.+defaultHandler :: Monad m => (e -> ActionT e m ()) -> ScottyT e m ()+defaultHandler f = ScottyT $ modify $ addHandler $ Just f+ -- | Use given middleware. Middleware is nested such that the first declared -- is the outermost middleware (it has first dibs on the request and last action -- on the response). Every middleware is run on each request.-middleware :: Monad m => Middleware -> ScottyT m ()-middleware = modify . addMiddleware+middleware :: Monad m => Middleware -> ScottyT e m ()+middleware = ScottyT . modify . addMiddleware
Web/Scotty/Types.hs view
@@ -1,21 +1,28 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses #-} module Web.Scotty.Types where -import Control.Monad.Error-import Control.Monad.Reader-import Control.Monad.State+import Blaze.ByteString.Builder (Builder) -import Data.ByteString.Lazy.Char8 (ByteString)-import Data.Default (Default, def)-import Data.String (IsString(..))-import Data.Text.Lazy (Text, pack)+import Control.Applicative+import Control.Monad.Error+import Control.Monad.Reader+import Control.Monad.State +import Data.ByteString.Lazy.Char8 (ByteString) import qualified Data.Conduit as C-import Network.Wai hiding (Middleware, Application)+import Data.Default (Default, def)+import Data.Monoid (mempty)+import Data.String (IsString(..))+import Data.Text.Lazy (Text, pack)++import Network.HTTP.Types++import Network.Wai hiding (Middleware, Application) import qualified Network.Wai as Wai-import Network.Wai.Handler.Warp (Settings, defaultSettings)-import Network.Wai.Parse (FileInfo)+import Network.Wai.Handler.Warp (Settings, defaultSettings)+import Network.Wai.Parse (FileInfo) +--------------------- Options ----------------------- data Options = Options { verbose :: Int -- ^ 0 = silent, 1(def) = startup banner , settings :: Settings -- ^ Warp 'Settings' }@@ -23,55 +30,99 @@ instance Default Options where def = Options 1 defaultSettings -data ScottyState m = ScottyState { middlewares :: [Wai.Middleware]- , routes :: [Middleware m]- }-+----- Transformer Aware Applications/Middleware ----- type Middleware m = Application m -> Application m-type Application m = Request -> C.ResourceT m Response+type Application m = Request -> m Response -addMiddleware :: Wai.Middleware -> ScottyState m -> ScottyState m+--------------- Scotty Applications -----------------+data ScottyState e m = + ScottyState { middlewares :: [Wai.Middleware]+ , routes :: [Middleware m]+ , handler :: ErrorHandler e m+ }++instance Monad m => Default (ScottyState e m) where+ def = ScottyState [] [] Nothing++addMiddleware :: Wai.Middleware -> ScottyState e m -> ScottyState e m addMiddleware m s@(ScottyState {middlewares = ms}) = s { middlewares = m:ms } -addRoute :: Monad m => Middleware m -> ScottyState m -> ScottyState m+addRoute :: Monad m => Middleware m -> ScottyState e m -> ScottyState e m addRoute r s@(ScottyState {routes = rs}) = s { routes = r:rs } -instance Default (ScottyState m) where- def = ScottyState [] []+addHandler :: ErrorHandler e m -> ScottyState e m -> ScottyState e m+addHandler h s = s { handler = h } -newtype ScottyT m a = ScottyT { runS :: StateT (ScottyState m) m a }- deriving (Monad, MonadIO, Functor, MonadState (ScottyState m))+newtype ScottyT e m a = ScottyT { runS :: StateT (ScottyState e m) m a }+ deriving ( Functor, Applicative, Monad, MonadIO ) -instance MonadTrans ScottyT where+instance MonadTrans (ScottyT e) where lift = ScottyT . lift -type ScottyM a = ScottyT IO a+------------------ Scotty Errors --------------------+data ActionError e = Redirect Text+ | Next+ | ActionError e -type Param = (Text, Text)+-- | In order to use a custom exception type (aside from 'Text'), you must+-- define an instance of 'ScottyError' for that type. +class ScottyError e where+ stringError :: String -> e+ showError :: e -> Text -data ActionError = Redirect Text- | ActionError Text- | Next- deriving (Eq,Show)+instance ScottyError Text where+ stringError = pack+ showError = id -instance Error ActionError where- strMsg = ActionError . pack+instance ScottyError e => ScottyError (ActionError e) where+ stringError = ActionError . stringError+ showError (Redirect url) = url+ showError Next = pack "Next"+ showError (ActionError e) = showError e +instance ScottyError e => Error (ActionError e) where + strMsg = stringError++type ErrorHandler e m = Maybe (e -> ActionT e m ())++------------------ Scotty Actions -------------------+type Param = (Text, Text)+ type File = (Text, FileInfo ByteString) -data ActionEnv = Env { getReq :: Request, getParams :: [Param], getBody :: ByteString, getFiles :: [File] }+data ActionEnv = Env { getReq :: Request+ , getParams :: [Param]+ , getBody :: ByteString+ , getFiles :: [File] + } -newtype ActionT m a = ActionT { runAM :: ErrorT ActionError (ReaderT ActionEnv (StateT Response m)) a }- deriving ( Monad, MonadIO, Functor- , MonadReader ActionEnv, MonadState Response, MonadError ActionError)+data Content = ContentBuilder Builder+ | ContentFile FilePath+ | ContentSource (C.Source IO (C.Flush Builder)) -instance MonadTrans ActionT where+data ScottyResponse = SR { srStatus :: Status+ , srHeaders :: ResponseHeaders+ , srContent :: Content+ }++instance Default ScottyResponse where+ def = SR status200 [] (ContentBuilder mempty)++newtype ActionT e m a = ActionT { runAM :: ErrorT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a }+ deriving ( Functor, Applicative, Monad, MonadIO )++instance ScottyError e => MonadTrans (ActionT e) where lift = ActionT . lift . lift . lift -type ActionM a = ActionT IO a+instance (ScottyError e, Monad m) => MonadError (ActionError e) (ActionT e m) where+ throwError = ActionT . throwError + catchError (ActionT m) f = ActionT (catchError m (runAM . f))++------------------ Scotty Routes -------------------- data RoutePattern = Capture Text | Literal Text | Function (Request -> Maybe [Param]) -instance IsString RoutePattern where fromString = Capture . pack+instance IsString RoutePattern where + fromString = Capture . pack
Web/Scotty/Util.hs view
@@ -4,7 +4,7 @@ , setContent , setHeaderWith , setStatus- , Content(..)+ , mkResponse , replace , add ) where@@ -13,17 +13,11 @@ import Network.HTTP.Types -import Blaze.ByteString.Builder (Builder)-import Data.Conduit (Flush, Source, ResourceT)-import Data.Default-import Data.Monoid- import qualified Data.ByteString as B import qualified Data.Text.Lazy as T import qualified Data.Text.Encoding as ES -instance Default Response where- def = ResponseBuilder status200 [] mempty+import Web.Scotty.Types lazyTextToStrictByteString :: T.Text -> B.ByteString lazyTextToStrictByteString = ES.encodeUtf8 . T.toStrict@@ -31,30 +25,22 @@ strictByteStringToLazyText :: B.ByteString -> T.Text strictByteStringToLazyText = T.fromStrict . ES.decodeUtf8 -data Content = ContentBuilder Builder- | ContentFile FilePath- | ContentSource (Source (ResourceT IO) (Flush Builder))+setContent :: Content -> ScottyResponse -> ScottyResponse+setContent c sr = sr { srContent = c } -setContent :: Content -> Response -> Response-setContent (ContentBuilder b) (ResponseBuilder s h _) = ResponseBuilder s h b-setContent (ContentBuilder b) (ResponseFile s h _ _) = ResponseBuilder s h b-setContent (ContentBuilder b) (ResponseSource s h _) = ResponseBuilder s h b-setContent (ContentFile f) (ResponseBuilder s h _) = ResponseFile s h f Nothing-setContent (ContentFile f) (ResponseFile s h _ _) = ResponseFile s h f Nothing-setContent (ContentFile f) (ResponseSource s h _) = ResponseFile s h f Nothing-setContent (ContentSource src) (ResponseBuilder s h _) = ResponseSource s h src-setContent (ContentSource src) (ResponseFile s h _ _) = ResponseSource s h src-setContent (ContentSource src) (ResponseSource s h _) = ResponseSource s h src+setHeaderWith :: ([(HeaderName, B.ByteString)] -> [(HeaderName, B.ByteString)]) -> ScottyResponse -> ScottyResponse+setHeaderWith f sr = sr { srHeaders = f (srHeaders sr) } -setHeaderWith :: ([(HeaderName, B.ByteString)] -> [(HeaderName, B.ByteString)]) -> Response -> Response-setHeaderWith g (ResponseBuilder s h b) = ResponseBuilder s (g h) b-setHeaderWith g (ResponseFile s h f fp) = ResponseFile s (g h) f fp-setHeaderWith g (ResponseSource s h cs) = ResponseSource s (g h) cs+setStatus :: Status -> ScottyResponse -> ScottyResponse+setStatus s sr = sr { srStatus = s } -setStatus :: Status -> Response -> Response-setStatus s (ResponseBuilder _ h b) = ResponseBuilder s h b-setStatus s (ResponseFile _ h f fp) = ResponseFile s h f fp-setStatus s (ResponseSource _ h cs) = ResponseSource s h cs+mkResponse :: ScottyResponse -> Response+mkResponse sr = case srContent sr of+ ContentBuilder b -> responseBuilder s h b+ ContentFile f -> responseFile s h f Nothing+ ContentSource src -> responseSource s h src+ where s = srStatus sr+ h = srHeaders sr -- Note: we assume headers are not sensitive to order here (RFC 2616 specifies they are not) replace :: (Eq a) => a -> b -> [(a,b)] -> [(a,b)]
examples/basic.hs view
@@ -38,7 +38,7 @@ -- You can set status and headers directly. get "/redirect-custom" $ do status status302- header "Location" "http://www.google.com"+ setHeader "Location" "http://www.google.com" -- note first arg to header is NOT case-sensitive -- redirects preempt execution
+ examples/cookies.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}+-- This examples requires you to: cabal install cookie+-- and: cabal install blaze-html+import Control.Monad (forM_)+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.Encoding as T+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Blaze.ByteString.Builder as B++import qualified Text.Blaze.Html5 as H+import Text.Blaze.Html5.Attributes+import Text.Blaze.Html.Renderer.Text (renderHtml)+import Web.Scotty+import Web.Cookie++makeCookie :: BS.ByteString -> BS.ByteString -> SetCookie+makeCookie n v = def { setCookieName = n, setCookieValue = v }++renderSetCookie' :: SetCookie -> Text+renderSetCookie' = T.decodeUtf8 . B.toLazyByteString . renderSetCookie++setCookie :: BS.ByteString -> BS.ByteString -> ActionM ()+setCookie n v = setHeader "Set-Cookie" (renderSetCookie' (makeCookie n v))++getCookies :: ActionM (Maybe CookiesText)+getCookies =+ fmap (fmap (parseCookiesText . lazyToStrict . T.encodeUtf8)) $+ reqHeader "Cookie"+ where+ lazyToStrict = BS.concat . BSL.toChunks++renderCookiesTable :: CookiesText -> H.Html+renderCookiesTable cs =+ H.table $ do+ H.tr $ do+ H.th "name"+ H.th "value"+ forM_ cs $ \(name, val) -> do+ H.tr $ do+ H.td (H.toMarkup name)+ H.td (H.toMarkup val)++main :: IO ()+main = scotty 3000 $ do+ get "/" $ do+ cookies <- getCookies+ html $ renderHtml $ do+ case cookies of+ Just cs -> renderCookiesTable cs+ Nothing -> return ()+ H.form H.! method "post" H.! action "/set-a-cookie" $ do+ H.input H.! type_ "text" H.! name "name"+ H.input H.! type_ "text" H.! name "value"+ H.input H.! type_ "submit" H.! value "set a cookie"++ post "/set-a-cookie" $ do+ name <- param "name"+ value <- param "value"+ setCookie name value+ redirect "/"
+ examples/exceptions.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}+module Main where++import Control.Applicative+import Control.Monad.Error++import Data.Monoid+import Data.String (fromString)++import Network.HTTP.Types+import Network.Wai.Middleware.RequestLogger+import Network.Wai++import System.Random++import Web.Scotty.Trans++-- Define a custom exception type.+data Except = Forbidden | NotFound Int | StringEx String+ deriving (Show, Eq)++-- The type must be an instance of 'ScottyError'.+-- 'ScottyError' is essentially a combination of 'Error' and 'Show'.+instance ScottyError Except where+ stringError = StringEx+ showError = fromString . show++-- Handler for uncaught exceptions.+handleEx :: Monad m => Except -> ActionT Except m ()+handleEx Forbidden = do+ status status403+ html "<h1>Scotty Says No</h1>"+handleEx (NotFound i) = do+ status status404+ html $ fromString $ "<h1>Can't find " ++ show i ++ ".</h1>"++main :: IO ()+main = scottyT 3000 id id $ do -- note, we aren't using any additional transformer layers+ -- so we can just use 'id' for the runners.+ middleware logStdoutDev++ defaultHandler handleEx -- define what to do with uncaught exceptions++ get "/" $ do+ html $ mconcat ["<a href=\"/switch/1\">Option 1 (Not Found)</a>"+ ,"<br/>"+ ,"<a href=\"/switch/2\">Option 2 (Forbidden)</a>"+ ,"<br/>"+ ,"<a href=\"/random\">Option 3 (Random)</a>"+ ]++ get "/switch/:val" $ do+ v <- param "val"+ if even v then raise Forbidden else raise (NotFound v)+ text "this will never be reached"++ get "/random" $ do+ rBool <- liftIO randomIO+ i <- liftIO randomIO+ let catchOne Forbidden = html "<h1>Forbidden was randomly thrown, but we caught it."+ catchOne other = raise other+ raise (if rBool then Forbidden else NotFound i) `rescue` catchOne
examples/globalstate.hs view
@@ -13,7 +13,8 @@ import Control.Monad.Reader import Data.Default-import Data.Text.Lazy (pack)+import Data.String+import Data.Text.Lazy (Text) import Network.Wai.Middleware.RequestLogger @@ -58,16 +59,23 @@ -- 'runActionToIO' is called once per action. runActionToIO = runM - scottyT 3000 runM runActionToIO $ do- middleware logStdoutDev- get "/" $ do- c <- webM $ gets tickCount- text $ pack $ show c+ scottyT 3000 runM runActionToIO app - get "/plusone" $ do- webM $ modify $ \ st -> st { tickCount = tickCount st + 1 }- redirect "/"+-- This app doesn't use raise/rescue, so the exception+-- type is ambiguous. We can fix it by putting a type+-- annotation just about anywhere. In this case, we'll+-- just do it on the entire app.+app :: ScottyT Text WebM ()+app = do+ middleware logStdoutDev+ get "/" $ do+ c <- webM $ gets tickCount+ text $ fromString $ show c - get "/plustwo" $ do- webM $ modify $ \ st -> st { tickCount = tickCount st + 2 }- redirect "/"+ get "/plusone" $ do+ webM $ modify $ \ st -> st { tickCount = tickCount st + 1 }+ redirect "/"++ get "/plustwo" $ do+ webM $ modify $ \ st -> st { tickCount = tickCount st + 2 }+ redirect "/"
− examples/json.hs
@@ -1,66 +0,0 @@-{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}-import Data.Aeson.TH (deriveJSON)--import qualified Data.Text.Lazy as T--import Network.Wai.Middleware.RequestLogger-import Network.Wai.Middleware.Static--import qualified Text.Blaze.Html5 as H-import Text.Blaze.Html5 ((!))-import Text.Blaze.Html5.Attributes as A-import Text.Blaze.Html.Renderer.Text (renderHtml)--import Web.Scotty---- A rather contrived example to test round-tripping JSON through Scotty-data Foo = Quux- | Bar Int- | Baz (Float, String)- deriving (Eq, Show)--$(deriveJSON Prelude.id ''Foo)--main :: IO ()-main = scotty 3000 $ do- middleware logStdoutDev- middleware $ staticPolicy (noDots >-> addBase "static")-- get "/" $ do- html $ wrapper $ do- H.form ! A.id "fooform" ! method "post" ! action "#" $ do- H.h5 "Select a constructor: "- H.input ! type_ "radio" ! A.id "fooquux" ! name "con" ! value "Quux"- H.label ! for "fooquux" $ "Quux"- H.input ! type_ "radio" ! A.id "foobar" ! name "con" ! value "Bar"- H.label ! for "foobar" $ "Bar"- H.input ! type_ "radio" ! A.id "foobaz" ! name "con" ! value "Baz"- H.label ! for "foobaz" $ "Baz"- H.br- H.h5 "Enter an int: "- H.input ! type_ "text" ! class_ "barfields" ! name "Barint"- H.br- H.h5 "Enter a float: "- H.input ! type_ "text" ! class_ "bazfields" ! name "Bazfloat"- H.h5 "Enter a string: "- H.input ! type_ "text" ! class_ "bazfields" ! name "Bazstring"- H.br- H.input ! type_ "submit"- H.div ! A.id "foolog" $ ""-- post "/foo" $ do- v <- jsonData- json $ case v of- Quux -> Quux- Bar i -> Bar $ i + 1- Baz (f,s) -> Baz (f + 0.5, s)--wrapper :: H.Html -> T.Text-wrapper content' = renderHtml- $ H.html $ do- H.header $ do- -- the first two are libraries, the last is our custom code- H.script ! type_ "text/javascript" ! src "jquery.js" $ ""- H.script ! type_ "text/javascript" ! src "jquery-json.js" $ ""- H.script ! type_ "text/javascript" ! src "json.js" $ ""- H.body content'
− examples/static/json.js
@@ -1,59 +0,0 @@-$(document).ready(function() {- alert("here!");-- $("#fooquux").click(function () {- $(".barfields").prop("disabled", true);- $(".bazfields").prop("disabled", true);- });-- $("#foobar").click(function () {- $(".barfields").prop("disabled", false);- $(".bazfields").prop("disabled", true);- });-- $("#foobaz").click(function () {- $(".bazfields").prop("disabled", false);- $(".barfields").prop("disabled", true);- });-- // Some things to note:- // The result coming back (res) is a javascript object, so we must turn it to a string to view it.- // Errors will fail silently, since we haven't declared an error handler.- // JSON.stringify is broke-sauce... use $.toJSON from the jquery-json plugin.- $("#fooform").submit(function () {- var con = $(this).children('[name="con"]:checked').val();- var inputs = $(this).children('[name^="' + con + '"]');- var fields = $.map(inputs, function(v) { return $(v).val(); });- $.ajax({ url: "/foo",- type: "POST",- data: mkCon(con,fields),- contentType: "application/json; charset=utf-8",- success: function(res) {- $("#foolog").append($.toJSON(res) + "</br>");- },- dataType: "json"}); // desired response type- return false; // prevent default submission action- });-});--function mkCon(con, fields) {- // All user input is a string at first,- // and we need to recover the numeric types- if (con == 'Bar') {- fields[0] = parseInt(fields[0]);- } else if (con == 'Baz') {- fields[0] = parseFloat(fields[0]);- }-- // now build our object- // Aeson seems to be inconsistent here (maybe it's the JSON spec?)- // Constructors with zero or more than one fields become lists,- // but Constructors with exactly on field become values.- var o = {};- if (fields.length == 1) {- o[con] = fields[0];- } else {- o[con] = fields;- }- return $.toJSON(o);-}
examples/upload.hs view
@@ -19,7 +19,7 @@ main :: IO () main = scotty 3000 $ do middleware logStdoutDev- middleware $ staticPolicy (addBase "uploads")+ middleware $ staticPolicy (noDots >-> addBase "uploads") get "/" $ do html $ renderHtml
scotty.cabal view
@@ -1,13 +1,13 @@ Name: scotty-Version: 0.5.0+Version: 0.6.0 Synopsis: Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp-Homepage: https://github.com/ku-fpg/scotty-Bug-reports: https://github.com/ku-fpg/scotty/issues+Homepage: https://github.com/scotty-web/scotty+Bug-reports: https://github.com/scotty-web/scotty/issues License: BSD3 License-file: LICENSE Author: Andrew Farmer <anfarmer@ku.edu> Maintainer: Andrew Farmer <anfarmer@ku.edu>-Copyright: (c) 2012 Andrew Farmer+Copyright: (c) 2012-2013 Andrew Farmer Category: Web Stability: experimental Build-type: Simple@@ -50,15 +50,15 @@ ReleaseNotes.md examples/404.html examples/basic.hs+ examples/cookies.hs+ examples/exceptions.hs examples/globalstate.hs examples/gzip.hs- examples/json.hs examples/options.hs examples/upload.hs examples/urlshortener.hs examples/static/jquery.js examples/static/jquery-json.js- examples/static/json.js Library Exposed-modules: Web.Scotty@@ -68,25 +68,25 @@ Web.Scotty.Types Web.Scotty.Util default-language: Haskell2010- build-depends: aeson >= 0.6.0.2,- base >= 4.3.1 && < 5,- blaze-builder >= 0.3.1.0,- bytestring >= 0.9.1,- case-insensitive >= 0.4.0.3,- conduit >= 0.5.2.7,- data-default >= 0.5.0,- http-types >= 0.8.0,- mtl >= 2.1.2,- regex-compat >= 0.95.1,- resourcet >= 0.4.0.2,- text >= 0.11.2.3,- transformers >= 0.3.0.0,- wai >= 1.3.0.1,- wai-extra >= 1.3.0.3,- warp >= 1.3.4.1+ build-depends: aeson >= 0.6.2.1 && < 0.7,+ base >= 4.3.1 && < 5,+ blaze-builder >= 0.3.3.0 && < 0.4,+ bytestring >= 0.10.0.2 && < 0.11,+ case-insensitive >= 1.0.0.1 && < 1.2,+ conduit >= 1.0.9.3 && < 1.1,+ data-default >= 0.5.3 && < 0.6,+ http-types >= 0.8.2 && < 0.9,+ mtl >= 2.1.2 && < 2.2,+ regex-compat >= 0.95.1 && < 0.96,+ resourcet >= 0.4.7.2 && < 0.5,+ text >= 0.11.3.1 && < 0.12,+ transformers >= 0.3.0.0 && < 0.4,+ wai >= 2.0.0 && < 2.1,+ wai-extra >= 2.0.0.1 && < 2.1,+ warp >= 2.0.0.1 && < 2.1 GHC-options: -Wall -fno-warn-orphans source-repository head type: git- location: git://github.com/ku-fpg/scotty.git+ location: git://github.com/scotty-web/scotty.git