scotty 0.10.2 → 0.11.0
raw patch · 8 files changed
+257/−21 lines, 8 filesdep +faildep ~aesondep ~data-default-classdep ~hspec-wai
Dependencies added: fail
Dependency ranges changed: aeson, data-default-class, hspec-wai, http-types, transformers, transformers-compat
Files
- Web/Scotty.hs +20/−1
- Web/Scotty/Action.hs +17/−0
- Web/Scotty/Internal/Types.hs +15/−8
- Web/Scotty/Trans.hs +1/−1
- Web/Scotty/Util.hs +2/−1
- changelog.md +8/−0
- scotty.cabal +12/−10
- test/Web/ScottySpec.hs +182/−0
Web/Scotty.hs view
@@ -26,7 +26,7 @@ -- definition, as they completely replace the current 'Response' body. , text, html, file, json, stream, raw -- ** Exceptions- , raise, rescue, next, defaultHandler+ , raise, rescue, next, finish, defaultHandler, liftAndCatchIO -- * Parsing Parameters , Param, Trans.Parsable(..), Trans.readEither -- * Types@@ -111,11 +111,30 @@ next :: ActionM a next = Trans.next +-- | Abort execution of this action. Like an exception, any code after 'finish'+-- is not executed.+--+-- As an example only requests to /foo/special will include in the response+-- content the text message.+--+-- > get "/foo/:bar" $ do+-- > w :: Text <- param "bar"+-- > unless (w == "special") finish+-- > text "You made a request to /foo/special"+--+-- /Since: 0.10.3/+finish :: ActionM a+finish = Trans.finish+ -- | Catch an exception thrown by 'raise'. -- -- > raise "just kidding" `rescue` (\msg -> text msg) rescue :: ActionM a -> (Text -> ActionM a) -> ActionM a rescue = Trans.rescue++-- | Like 'liftIO', but catch any IO exceptions and turn them into Scotty exceptions.+liftAndCatchIO :: IO a -> ActionM a+liftAndCatchIO = Trans.liftAndCatchIO -- | Redirect to given URL. Like throwing an uncatchable exception. Any code after the call to redirect -- will not be run.
Web/Scotty/Action.hs view
@@ -7,9 +7,11 @@ , bodyReader , file , files+ , finish , header , headers , html+ , liftAndCatchIO , json , jsonData , next@@ -33,6 +35,7 @@ import Blaze.ByteString.Builder (fromLazyByteString) +import qualified Control.Exception as E import Control.Monad.Error.Class import Control.Monad.Reader import qualified Control.Monad.State as MS@@ -81,6 +84,7 @@ 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+defH _ Finish = return () -- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions -- turn into HTTP 500 responses.@@ -112,6 +116,12 @@ ActionError err -> h err -- handle errors other -> throwError other -- rethrow internal error types +-- | Like 'liftIO', but catch any IO exceptions and turn them into 'ScottyError's.+liftAndCatchIO :: (ScottyError e, MonadIO m) => IO a -> ActionT e m a+liftAndCatchIO io = ActionT $ do+ r <- liftIO $ liftM Right io `E.catch` (\ e -> return $ Left $ stringError $ show (e :: E.SomeException))+ either throwError return r+ -- | Redirect to given URL. Like throwing an uncatchable exception. Any code after the call to redirect -- will not be run. --@@ -122,6 +132,13 @@ -- > redirect "/foo/bar" redirect :: (ScottyError e, Monad m) => T.Text -> ActionT e m a redirect = throwError . Redirect++-- | Finish the execution of the current action. Like throwing an uncatchable+-- exception. Any code after the call to finish will not be run.+--+-- /Since: 0.10.3/+finish :: (ScottyError e, Monad m) => ActionT e m a+finish = throwError Finish -- | Get the 'Request' object. request :: Monad m => ActionT e m Request
Web/Scotty/Internal/Types.hs view
@@ -1,4 +1,10 @@-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies, DeriveDataTypeable #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} module Web.Scotty.Internal.Types where import Blaze.ByteString.Builder (Builder)@@ -7,6 +13,7 @@ import qualified Control.Exception as E import Control.Monad.Base (MonadBase, liftBase, liftBaseDefault) import Control.Monad.Error.Class+import qualified Control.Monad.Fail as Fail import Control.Monad.Reader import Control.Monad.State import Control.Monad.Trans.Control (MonadBaseControl, StM, liftBaseWith, restoreM, ComposeSt, defaultLiftBaseWith, defaultRestoreM, MonadTransControl, StT, liftWith, restoreT)@@ -73,6 +80,7 @@ ------------------ Scotty Errors -------------------- data ActionError e = Redirect Text | Next+ | Finish | ActionError e -- | In order to use a custom exception type (aside from 'Text'), you must@@ -89,6 +97,7 @@ stringError = ActionError . stringError showError (Redirect url) = url showError Next = pack "Next"+ showError Finish = pack "Finish" showError (ActionError e) = showError e type ErrorHandler e m = Maybe (e -> ActionT e m ())@@ -105,7 +114,7 @@ , getFiles :: [File] } -data RequestBodyState = BodyUntouched +data RequestBodyState = BodyUntouched | BodyCached ByteString [BS.ByteString] -- whole body, chunks left to stream | BodyCorrupted @@ -126,13 +135,16 @@ def = SR status200 [] (ContentBuilder mempty) newtype ActionT e m a = ActionT { runAM :: ExceptT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a }- deriving ( Functor, Applicative )+ deriving ( Functor, Applicative, MonadIO ) instance (Monad m, ScottyError e) => Monad (ActionT e m) where return = ActionT . return ActionT m >>= k = ActionT (m >>= runAM . k) fail = ActionT . throwError . stringError +instance (Monad m, ScottyError e) => Fail.MonadFail (ActionT e m) where+ fail = ActionT . throwError . stringError+ instance ( Monad m, ScottyError e #if !(MIN_VERSION_base(4,8,0)) , Functor m@@ -148,11 +160,6 @@ case a of Left _ -> runExceptT n Right r -> return $ Right r--instance (MonadIO m, ScottyError e) => MonadIO (ActionT e m) where- liftIO io = ActionT $ do- r <- liftIO $ liftM Right io `E.catch` (\ e -> return $ Left $ stringError $ show (e :: E.SomeException))- either throwError return r instance MonadTrans (ActionT e) where lift = ActionT . lift . lift . lift
Web/Scotty/Trans.hs view
@@ -30,7 +30,7 @@ -- definition, as they completely replace the current 'Response' body. , text, html, file, json, stream, raw -- ** Exceptions- , raise, rescue, next, defaultHandler, ScottyError(..)+ , raise, rescue, next, finish, defaultHandler, ScottyError(..), liftAndCatchIO -- * Parsing Parameters , Param, Parsable(..), readEither -- * Types
Web/Scotty/Util.hs view
@@ -20,6 +20,7 @@ import qualified Data.ByteString as B import qualified Data.Text.Lazy as T import qualified Data.Text.Encoding as ES+import qualified Data.Text.Encoding.Error as ES import Web.Scotty.Internal.Types @@ -27,7 +28,7 @@ lazyTextToStrictByteString = ES.encodeUtf8 . T.toStrict strictByteStringToLazyText :: B.ByteString -> T.Text-strictByteStringToLazyText = T.fromStrict . ES.decodeUtf8+strictByteStringToLazyText = T.fromStrict . ES.decodeUtf8With ES.lenientDecode setContent :: Content -> ScottyResponse -> ScottyResponse setContent c sr = sr { srContent = c }
changelog.md view
@@ -1,3 +1,11 @@+## 0.11.0+* IO exceptions are no longer automatically turned into ScottyErrors by+ `liftIO`. Use `liftAndCatchIO` to get that behavior.+* New `finish` function.+* Text values are now leniently decoded from ByteStrings.+* Added `MonadFail` instance for `ScottyT`+* Lots of bound bumps on dependencies.+ ## 0.10.2 * Removed debug statement from routes
scotty.cabal view
@@ -1,13 +1,13 @@ Name: scotty-Version: 0.10.2+Version: 0.11.0 Synopsis: Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp Homepage: https://github.com/scotty-web/scotty Bug-reports: https://github.com/scotty-web/scotty/issues License: BSD3 License-file: LICENSE-Author: Andrew Farmer <afarmer@ittc.ku.edu>-Maintainer: Andrew Farmer <afarmer@ittc.ku.edu>-Copyright: (c) 2012-2014 Andrew Farmer+Author: Andrew Farmer <xichekolas@gmail.com>+Maintainer: Andrew Farmer <xichekolas@gmail.com>+Copyright: (c) 2012-Present Andrew Farmer Category: Web Stability: experimental Build-type: Simple@@ -68,30 +68,32 @@ Web.Scotty.Route Web.Scotty.Util default-language: Haskell2010- build-depends: aeson >= 0.6.2.1 && < 0.10,+ build-depends: aeson >= 0.6.2.1 && < 0.11, base >= 4.3.1 && < 5, blaze-builder >= 0.3.3.0 && < 0.5, bytestring >= 0.10.0.2 && < 0.11, case-insensitive >= 1.0.0.1 && < 1.3, data-default-class >= 0.0.1 && < 0.1,- http-types >= 0.8.2 && < 0.9,+ fail,+ http-types >= 0.8.2 && < 0.10, monad-control >= 1.0.0.3 && < 1.1, mtl >= 2.1.2 && < 2.3, nats >= 0.1 && < 2, network >= 2.6.0.2 && < 2.7, regex-compat >= 0.95.1 && < 0.96, text >= 0.11.3.1 && < 1.3,- transformers >= 0.3.0.0 && < 0.5,+ transformers >= 0.3.0.0 && < 0.6, transformers-base >= 0.4.1 && < 0.5,- transformers-compat >= 0.4 && < 0.5,- wai >= 3.0.0 && < 3.1,+ transformers-compat >= 0.4 && < 0.6,+ wai >= 3.0.0 && < 3.3, wai-extra >= 3.0.0 && < 3.1,- warp >= 3.0.0 && < 3.1+ warp >= 3.0.0 && < 3.3 GHC-options: -Wall -fno-warn-orphans test-suite spec main-is: Spec.hs+ other-modules: Web.ScottySpec type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test
+ test/Web/ScottySpec.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE OverloadedStrings, CPP #-}+module Web.ScottySpec (main, spec) where++import Test.Hspec+import Test.Hspec.Wai+import Network.Wai (Application)++import Control.Applicative+import Control.Monad+import Data.Char+import Data.String+import Network.HTTP.Types+import qualified Control.Exception.Lifted as EL+import qualified Control.Exception as E++import Web.Scotty as Scotty hiding (get, post, put, patch, delete, request, options)+import qualified Web.Scotty as Scotty++#if !defined(mingw32_HOST_OS)+import Control.Concurrent.Async (withAsync)+import Data.Default.Class (def)+import Network (listenOn, PortID(..))+import Network.Socket+import System.Directory (removeFile)+#endif++main :: IO ()+main = hspec spec++availableMethods :: [StdMethod]+availableMethods = [GET, POST, HEAD, PUT, PATCH, DELETE, OPTIONS]++withApp :: ScottyM () -> SpecWith Application -> Spec+withApp = with . scottyApp++spec :: Spec+spec = do+ describe "ScottyM" $ do+ forM_ [+ ("GET", Scotty.get, get)+ , ("POST", Scotty.post, (`post` ""))+ , ("PUT", Scotty.put, (`put` ""))+ , ("PATCH", Scotty.patch, (`patch` ""))+ , ("DELETE", Scotty.delete, delete)+ , ("OPTIONS", Scotty.options, options)+ ] $ \(method, route, makeRequest) -> do+ describe (map toLower method) $ do+ withApp (route "/scotty" $ html "") $ do+ it ("adds route for " ++ method ++ " requests") $ do+ makeRequest "/scotty" `shouldRespondWith` 200++ describe "addroute" $ do+ forM_ availableMethods $ \method -> do+ withApp (addroute method "/scotty" $ html "") $ do+ it ("can be used to add route for " ++ show method ++ " requests") $ do+ request (renderStdMethod method) "/scotty" [] "" `shouldRespondWith` 200++ describe "matchAny" $ do+ withApp (matchAny "/scotty" $ html "") $ do+ forM_ availableMethods $ \method -> do+ it ("adds route that matches " ++ show method ++ " requests") $ do+ request (renderStdMethod method) "/scotty" [] "" `shouldRespondWith` 200++ describe "notFound" $ do+ withApp (notFound $ html "my custom not found page") $ do+ it "adds handler for requests that do not match any route" $ do+ get "/somewhere" `shouldRespondWith` "my custom not found page" {matchStatus = 404}++ withApp (notFound $ status status400 >> html "my custom not found page") $ do+ it "allows to customize the HTTP status code" $ do+ get "/somewhere" `shouldRespondWith` "my custom not found page" {matchStatus = 400}++ context "when not specified" $ do+ withApp (return ()) $ do+ it "returns 404 when no route matches" $ do+ get "/" `shouldRespondWith` "<h1>404: File Not Found!</h1>" {matchStatus = 404}++ describe "defaultHandler" $ do+ withApp (defaultHandler text >> Scotty.get "/" (liftAndCatchIO $ E.throwIO E.DivideByZero)) $ do+ it "sets custom exception handler" $ do+ get "/" `shouldRespondWith` "divide by zero" {matchStatus = 500}++ withApp (defaultHandler (\_ -> status status503) >> Scotty.get "/" (liftAndCatchIO $ E.throwIO E.DivideByZero)) $ do+ it "allows to customize the HTTP status code" $ do+ get "/" `shouldRespondWith` "" {matchStatus = 503}++ context "when not specified" $ do+ withApp (Scotty.get "/" $ liftAndCatchIO $ E.throwIO E.DivideByZero) $ do+ it "returns 500 on exceptions" $ do+ get "/" `shouldRespondWith` "<h1>500 Internal Server Error</h1>divide by zero" {matchStatus = 500}++ describe "ActionM" $ do+ withApp (Scotty.get "/" $ (undefined `EL.catch` ((\_ -> html "") :: E.SomeException -> ActionM ()))) $ do+ it "has a MonadBaseControl instance" $ do+ get "/" `shouldRespondWith` 200++ withApp (Scotty.get "/dictionary" $ empty <|> param "word1" <|> empty <|> param "word2" >>= text) $+ it "has an Alternative instance" $ do+ get "/dictionary?word1=haskell" `shouldRespondWith` "haskell"+ get "/dictionary?word2=scotty" `shouldRespondWith` "scotty"+ get "/dictionary?word1=a&word2=b" `shouldRespondWith` "a"++ describe "param" $ do+ withApp (Scotty.matchAny "/search" $ param "query" >>= text) $ do+ it "returns query parameter with given name" $ do+ get "/search?query=haskell" `shouldRespondWith` "haskell"++ context "when used with application/x-www-form-urlencoded data" $ do+ it "returns POST parameter with given name" $ do+ request "POST" "/search" [("Content-Type","application/x-www-form-urlencoded")] "query=haskell" `shouldRespondWith` "haskell"++ it "replaces non UTF-8 bytes with Unicode replacement character" $ do+ request "POST" "/search" [("Content-Type","application/x-www-form-urlencoded")] "query=\xe9" `shouldRespondWith` "\xfffd"++ describe "text" $ do+ let modernGreekText :: IsString a => a+ modernGreekText = "νέα ελληνικά"++ withApp (Scotty.get "/scotty" $ text modernGreekText) $ do+ it "sets body to given text" $ do+ get "/scotty" `shouldRespondWith` modernGreekText++ it "sets Content-Type header to \"text/plain; charset=utf-8\"" $ do+ get "/scotty" `shouldRespondWith` 200 {matchHeaders = ["Content-Type" <:> "text/plain; charset=utf-8"]}++ withApp (Scotty.get "/scotty" $ setHeader "Content-Type" "text/somethingweird" >> text modernGreekText) $ do+ it "doesn't override a previously set Content-Type header" $ do+ get "/scotty" `shouldRespondWith` 200 {matchHeaders = ["Content-Type" <:> "text/somethingweird"]}++ describe "html" $ do+ let russianLanguageTextInHtml :: IsString a => a+ russianLanguageTextInHtml = "<p>ру́сский язы́к</p>"++ withApp (Scotty.get "/scotty" $ html russianLanguageTextInHtml) $ do+ it "sets body to given text" $ do+ get "/scotty" `shouldRespondWith` russianLanguageTextInHtml++ it "sets Content-Type header to \"text/html; charset=utf-8\"" $ do+ get "/scotty" `shouldRespondWith` 200 {matchHeaders = ["Content-Type" <:> "text/html; charset=utf-8"]}++ withApp (Scotty.get "/scotty" $ setHeader "Content-Type" "text/somethingweird" >> html russianLanguageTextInHtml) $ do+ it "doesn't override a previously set Content-Type header" $ do+ get "/scotty" `shouldRespondWith` 200 {matchHeaders = ["Content-Type" <:> "text/somethingweird"]}++ describe "json" $ do+ withApp (Scotty.get "/scotty" $ setHeader "Content-Type" "text/somethingweird" >> json (Just (5::Int))) $ do+ it "doesn't override a previously set Content-Type header" $ do+ get "/scotty" `shouldRespondWith` 200 {matchHeaders = ["Content-Type" <:> "text/somethingweird"]}++ describe "finish" $ do+ withApp (Scotty.get "/scotty" $ finish) $ do+ it "responds with 200 by default" $ do+ get "/scotty" `shouldRespondWith` 200++ withApp (Scotty.get "/scotty" $ status status400 >> finish >> status status200) $ do+ it "stops the execution of an action" $ do+ get "/scotty" `shouldRespondWith` 400++-- Unix sockets not available on Windows+#if !defined(mingw32_HOST_OS)+ describe "scottySocket" .+ it "works with a unix socket" .+ withServer (Scotty.get "/scotty" $ html "") .+ E.bracket (socket AF_UNIX Stream 0) close $ \sock -> do+ connect sock $ SockAddrUnix socketPath+ _ <- send sock "GET /scotty HTTP/1.1\r\n\n"+ r1 <- recv sock 1024+ _ <- send sock "GET /four-oh-four HTTP/1.1\r\n\n"+ r2 <- recv sock 1024+ (take (length ok) r1, take (length no) r2) `shouldBe` (ok, no)+ where ok = "HTTP/1.1 200 OK"+ no = "HTTP/1.1 404 Not Found"++socketPath :: FilePath+socketPath = "/tmp/scotty-test.socket"++withServer :: ScottyM () -> IO a -> IO a+withServer actions inner = E.bracket+ (listenOn $ UnixSocket socketPath)+ (\sock -> close sock >> removeFile socketPath)+ (\sock -> withAsync (Scotty.scottySocket def sock actions) $ const inner)+#endif