scotty 0.9.1 → 0.10.0
raw patch · 16 files changed
+309/−159 lines, 16 filesdep +asyncdep +data-default-classdep +directorydep −data-defaultdep ~bytestringdep ~hspec-waidep ~monad-controlnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: async, data-default-class, directory, network, transformers-compat
Dependencies removed: data-default
Dependency ranges changed: bytestring, hspec-wai, monad-control
API changes (from Hackage documentation)
- Web.Scotty.Internal.Types: instance (Monad m, Functor m) => Applicative (ScottyT e m)
- Web.Scotty.Internal.Types: instance Functor m => Functor (ScottyT e m)
- Web.Scotty.Internal.Types: instance Monad m => Default (ScottyState e m)
- Web.Scotty.Internal.Types: instance Monad m => Monad (ScottyT e m)
- Web.Scotty.Internal.Types: instance MonadIO m => MonadIO (ScottyT e m)
- Web.Scotty.Internal.Types: instance MonadTrans (ScottyT e)
- Web.Scotty.Internal.Types: instance ScottyError e => Error (ActionError e)
- Web.Scotty.Internal.Types: instance ScottyError e => MonadTrans (ActionT e)
- Web.Scotty.Internal.Types: instance ScottyError e => MonadTransControl (ActionT e)
+ Web.Scotty: bodyReader :: ActionM (IO ByteString)
+ Web.Scotty: options :: RoutePattern -> ActionM () -> ScottyM ()
+ Web.Scotty: scottySocket :: Options -> Socket -> ScottyM () -> IO ()
+ Web.Scotty.Internal.Types: BodyCached :: ByteString -> [ByteString] -> RequestBodyState
+ Web.Scotty.Internal.Types: BodyCorrupted :: RequestBodyState
+ Web.Scotty.Internal.Types: BodyPartiallyStreamed :: BodyPartiallyStreamed
+ Web.Scotty.Internal.Types: BodyUntouched :: RequestBodyState
+ Web.Scotty.Internal.Types: data BodyPartiallyStreamed
+ Web.Scotty.Internal.Types: data RequestBodyState
+ Web.Scotty.Internal.Types: getBodyChunk :: ActionEnv -> IO ByteString
+ Web.Scotty.Internal.Types: instance (Monad m, ScottyError e) => MonadPlus (ActionT e m)
+ Web.Scotty.Internal.Types: instance (Monad m, ScottyError e, Functor m) => Alternative (ActionT e m)
+ Web.Scotty.Internal.Types: instance Applicative (ScottyT e m)
+ Web.Scotty.Internal.Types: instance Default (ScottyState e m)
+ Web.Scotty.Internal.Types: instance Exception BodyPartiallyStreamed
+ Web.Scotty.Internal.Types: instance Functor (ScottyT e m)
+ Web.Scotty.Internal.Types: instance Monad (ScottyT e m)
+ Web.Scotty.Internal.Types: instance MonadTrans (ActionT e)
+ Web.Scotty.Internal.Types: instance MonadTransControl (ActionT e)
+ Web.Scotty.Internal.Types: instance Show BodyPartiallyStreamed
+ Web.Scotty.Internal.Types: instance Typeable BodyPartiallyStreamed
+ Web.Scotty.Trans: bodyReader :: Monad m => ActionT e m (IO ByteString)
+ Web.Scotty.Trans: options :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
+ Web.Scotty.Trans: scottySocketT :: (Monad m, MonadIO n) => Options -> Socket -> (m Response -> IO Response) -> ScottyT e m () -> n ()
- Web.Scotty.Internal.Types: ActionT :: ErrorT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a -> ActionT e m a
+ Web.Scotty.Internal.Types: ActionT :: ExceptT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a -> ActionT e m a
- Web.Scotty.Internal.Types: Env :: Request -> [Param] -> ByteString -> [File] -> ActionEnv
+ Web.Scotty.Internal.Types: Env :: Request -> [Param] -> IO ByteString -> IO ByteString -> [File] -> ActionEnv
- Web.Scotty.Internal.Types: ScottyT :: StateT (ScottyState e m) m a -> ScottyT e m a
+ Web.Scotty.Internal.Types: ScottyT :: State (ScottyState e m) a -> ScottyT e m a
- Web.Scotty.Internal.Types: addRoute :: Monad m => Middleware m -> ScottyState e m -> ScottyState e m
+ Web.Scotty.Internal.Types: addRoute :: Middleware m -> ScottyState e m -> ScottyState e m
- Web.Scotty.Internal.Types: getBody :: ActionEnv -> ByteString
+ Web.Scotty.Internal.Types: getBody :: ActionEnv -> IO ByteString
- Web.Scotty.Internal.Types: runAM :: ActionT e m a -> ErrorT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
+ Web.Scotty.Internal.Types: runAM :: ActionT e m a -> ExceptT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a
- Web.Scotty.Internal.Types: runS :: ScottyT e m a -> StateT (ScottyState e m) m a
+ Web.Scotty.Internal.Types: runS :: ScottyT e m a -> State (ScottyState e m) a
- Web.Scotty.Trans: addHeader :: (ScottyError e, Monad m) => Text -> Text -> ActionT e m ()
+ Web.Scotty.Trans: addHeader :: Monad m => Text -> Text -> ActionT e m ()
- Web.Scotty.Trans: body :: (ScottyError e, Monad m) => ActionT e m ByteString
+ Web.Scotty.Trans: body :: (ScottyError e, MonadIO m) => ActionT e m ByteString
- Web.Scotty.Trans: file :: (ScottyError e, Monad m) => FilePath -> ActionT e m ()
+ Web.Scotty.Trans: file :: Monad m => FilePath -> ActionT e m ()
- Web.Scotty.Trans: files :: (ScottyError e, Monad m) => ActionT e m [File]
+ Web.Scotty.Trans: files :: Monad m => ActionT e m [File]
- Web.Scotty.Trans: jsonData :: (FromJSON a, ScottyError e, Monad m) => ActionT e m a
+ Web.Scotty.Trans: jsonData :: (FromJSON a, ScottyError e, MonadIO m) => ActionT e m a
- Web.Scotty.Trans: params :: (ScottyError e, Monad m) => ActionT e m [Param]
+ Web.Scotty.Trans: params :: Monad m => ActionT e m [Param]
- Web.Scotty.Trans: raw :: (ScottyError e, Monad m) => ByteString -> ActionT e m ()
+ Web.Scotty.Trans: raw :: Monad m => ByteString -> ActionT e m ()
- Web.Scotty.Trans: request :: (ScottyError e, Monad m) => ActionT e m Request
+ Web.Scotty.Trans: request :: Monad m => ActionT e m Request
- Web.Scotty.Trans: scottyAppT :: (Monad m, Monad n) => (forall a. m a -> n a) -> (m Response -> IO Response) -> ScottyT e m () -> n Application
+ Web.Scotty.Trans: scottyAppT :: (Monad m, Monad n) => (m Response -> IO Response) -> ScottyT e m () -> n Application
- Web.Scotty.Trans: scottyOptsT :: (Monad m, MonadIO n) => Options -> (forall a. m a -> n a) -> (m Response -> IO Response) -> ScottyT e m () -> n ()
+ Web.Scotty.Trans: scottyOptsT :: (Monad m, MonadIO n) => Options -> (m Response -> IO Response) -> ScottyT e m () -> n ()
- Web.Scotty.Trans: scottyT :: (Monad m, MonadIO n) => Port -> (forall a. m a -> n a) -> (m Response -> IO Response) -> ScottyT e m () -> n ()
+ Web.Scotty.Trans: scottyT :: (Monad m, MonadIO n) => Port -> (m Response -> IO Response) -> ScottyT e m () -> n ()
- Web.Scotty.Trans: setHeader :: (ScottyError e, Monad m) => Text -> Text -> ActionT e m ()
+ Web.Scotty.Trans: setHeader :: Monad m => Text -> Text -> ActionT e m ()
- Web.Scotty.Trans: status :: (ScottyError e, Monad m) => Status -> ActionT e m ()
+ Web.Scotty.Trans: status :: Monad m => Status -> ActionT e m ()
- Web.Scotty.Trans: stream :: (ScottyError e, Monad m) => StreamingBody -> ActionT e m ()
+ Web.Scotty.Trans: stream :: Monad m => StreamingBody -> ActionT e m ()
Files
- Web/Scotty.hs +25/−6
- Web/Scotty/Action.hs +25/−23
- Web/Scotty/Internal/Types.hs +48/−33
- Web/Scotty/Route.hs +53/−15
- Web/Scotty/Trans.hs +31/−17
- Web/Scotty/Util.hs +14/−1
- changelog.md +35/−5
- examples/basic.hs +6/−5
- examples/cookies.hs +8/−7
- examples/exceptions.hs +7/−7
- examples/globalstate.hs +8/−7
- examples/gzip.hs +2/−0
- examples/options.hs +5/−3
- examples/upload.hs +3/−0
- examples/urlshortener.hs +8/−4
- scotty.cabal +31/−26
Web/Scotty.hs view
@@ -7,17 +7,17 @@ -- the comments on each of these functions for more information. module Web.Scotty ( -- * scotty-to-WAI- scotty, scottyApp, scottyOpts, Options(..)+ scotty, scottyApp, scottyOpts, scottySocket, Options(..) -- * Defining Middleware and Routes -- -- | 'Middleware' and routes are run in the order in which they -- are defined. All middleware is run first, followed by the first -- route that matches. If no route matches, a 404 response is given.- , middleware, get, post, put, delete, patch, addroute, matchAny, notFound+ , middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound -- ** Route Patterns , capture, regex, function, literal -- ** Accessing the Request, Captures, and Query Parameters- , request, header, headers, body, param, params, jsonData, files+ , request, header, headers, body, bodyReader, param, params, jsonData, files -- ** Modifying the Response and Redirecting , status, addHeader, setHeader, redirect -- ** Setting Response Body@@ -37,9 +37,11 @@ import qualified Web.Scotty.Trans as Trans import Data.Aeson (FromJSON, ToJSON)+import qualified Data.ByteString as BS import Data.ByteString.Lazy.Char8 (ByteString) import Data.Text.Lazy (Text) +import Network (Socket) import Network.HTTP.Types (Status, StdMethod) import Network.Wai (Application, Middleware, Request, StreamingBody) import Network.Wai.Handler.Warp (Port)@@ -51,16 +53,23 @@ -- | Run a scotty application using the warp server. scotty :: Port -> ScottyM () -> IO ()-scotty p = Trans.scottyT p id id+scotty p = Trans.scottyT p id -- | Run a scotty application using the warp server, passing extra options. scottyOpts :: Options -> ScottyM () -> IO ()-scottyOpts opts = Trans.scottyOptsT opts id id+scottyOpts opts = Trans.scottyOptsT opts id +-- | Run a scotty application using the warp server, passing extra options,+-- and listening on the provided socket. This allows the user to provide, for+-- example, a Unix named socket, which can be used when reverse HTTP proxying+-- into your application.+scottySocket :: Options -> Socket -> ScottyM () -> IO ()+scottySocket opts sock = Trans.scottySocketT opts sock id+ -- | Turn a scotty application into a WAI 'Application', which can be -- run with any WAI handler. scottyApp :: ScottyM () -> IO Application-scottyApp = Trans.scottyAppT id id+scottyApp = Trans.scottyAppT id -- | Global handler for uncaught exceptions. --@@ -139,6 +148,12 @@ body :: ActionM ByteString body = Trans.body +-- | Get an IO action that reads body chunks+--+-- * This is incompatible with 'body' since 'body' consumes all chunks.+bodyReader :: ActionM (IO BS.ByteString)+bodyReader = Trans.bodyReader+ -- | Parse the request body as a JSON object and return it. Raises an exception if parse is unsuccessful. jsonData :: FromJSON a => ActionM a jsonData = Trans.jsonData@@ -220,6 +235,10 @@ -- | patch = 'addroute' 'PATCH' patch :: RoutePattern -> ActionM () -> ScottyM () patch = Trans.patch++-- | options = 'addroute' 'OPTIONS'+options :: RoutePattern -> ActionM () -> ScottyM ()+options = Trans.options -- | Add a route that matches regardless of the HTTP verb. matchAny :: RoutePattern -> ActionM () -> ScottyM ()
Web/Scotty/Action.hs view
@@ -4,6 +4,7 @@ module Web.Scotty.Action ( addHeader , body+ , bodyReader , file , files , header@@ -32,20 +33,19 @@ import Blaze.ByteString.Builder (fromLazyByteString) -#if MIN_VERSION_mtl(2,2,1)-import Control.Monad.Except-#else-import Control.Monad.Error-#endif+import Control.Monad.Error.Class import Control.Monad.Reader import qualified Control.Monad.State as MS+import Control.Monad.Trans.Except import qualified Data.Aeson as A import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.CaseInsensitive as CI-import Data.Default (def)+import Data.Default.Class (def)+#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid (mconcat)+#endif import qualified Data.Text as ST import qualified Data.Text.Lazy as T import Data.Text.Lazy.Encoding (encodeUtf8)@@ -62,11 +62,7 @@ runAction h env action = do (e,r) <- flip MS.runStateT def $ flip runReaderT env-#if MIN_VERSION_mtl(2,2,1) $ runExceptT-#else- $ runErrorT-#endif $ runAM $ action `catchError` (defH h) return $ either (const Nothing) (const $ Just $ mkResponse r) e@@ -124,11 +120,11 @@ redirect = throwError . Redirect -- | Get the 'Request' object.-request :: (ScottyError e, Monad m) => ActionT e m Request+request :: Monad m => ActionT e m Request request = ActionT $ liftM getReq ask -- | Get list of uploaded files.-files :: (ScottyError e, Monad m) => ActionT e m [File]+files :: Monad m => ActionT e m [File] files = ActionT $ liftM getFiles ask -- | Get a request header. Header name is case-insensitive.@@ -146,11 +142,17 @@ | (k,v) <- hs ] -- | Get the request body.-body :: (ScottyError e, Monad m) => ActionT e m BL.ByteString-body = ActionT $ liftM getBody ask+body :: (ScottyError e, MonadIO m) => ActionT e m BL.ByteString+body = ActionT ask >>= (liftIO . getBody) +-- | Get an IO action that reads body chunks+--+-- * This is incompatible with 'body' since 'body' consumes all chunks.+bodyReader :: Monad m => ActionT e m (IO B.ByteString)+bodyReader = ActionT $ getBodyChunk `liftM` ask+ -- | Parse the request body as a JSON object and return it. Raises an exception if parse is unsuccessful.-jsonData :: (A.FromJSON a, ScottyError e, Monad m) => ActionT e m a+jsonData :: (A.FromJSON a, ScottyError e, MonadIO m) => ActionT e m a jsonData = do b <- body either (\e -> raise $ stringError $ "jsonData - no parse: " ++ e ++ ". Data was:" ++ BL.unpack b) return $ A.eitherDecode b@@ -170,7 +172,7 @@ Just v -> either (const next) return $ parseParam v -- | Get all parameters from capture, form and query (in that order).-params :: (ScottyError e, Monad m) => ActionT e m [Param]+params :: Monad m => ActionT e m [Param] params = ActionT $ liftM getParams ask -- | Minimum implemention: 'parseParam'@@ -225,11 +227,11 @@ _ -> Left "readEither: ambiguous parse" -- | Set the HTTP response status. Default is 200.-status :: (ScottyError e, Monad m) => Status -> ActionT e m ()+status :: Monad m => Status -> ActionT e m () status = ActionT . MS.modify . setStatus -- Not exported, but useful in the functions below.-changeHeader :: (ScottyError e, Monad m)+changeHeader :: Monad m => (CI.CI B.ByteString -> B.ByteString -> [(HeaderName, B.ByteString)] -> [(HeaderName, B.ByteString)]) -> T.Text -> T.Text -> ActionT e m () changeHeader f k = ActionT@@ -239,12 +241,12 @@ . lazyTextToStrictByteString -- | Add to the response headers. Header names are case-insensitive.-addHeader :: (ScottyError e, Monad m) => T.Text -> T.Text -> ActionT e m ()+addHeader :: Monad m => T.Text -> T.Text -> ActionT e m () addHeader = changeHeader add -- | Set one of the response headers. Will override any previously set value for that header. -- Header names are case-insensitive.-setHeader :: (ScottyError e, Monad m) => T.Text -> T.Text -> ActionT e m ()+setHeader :: Monad m => T.Text -> T.Text -> ActionT e m () setHeader = changeHeader replace -- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"@@ -263,7 +265,7 @@ -- | Send a file as the response. Doesn't set the \"Content-Type\" header, so you probably -- want to do that on your own with 'setHeader'.-file :: (ScottyError e, Monad m) => FilePath -> ActionT e m ()+file :: 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\"@@ -276,11 +278,11 @@ -- | 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 'setHeader'.-stream :: (ScottyError e, Monad m) => StreamingBody -> ActionT e m ()+stream :: Monad m => StreamingBody -> ActionT e m () stream = ActionT . MS.modify . setContent . ContentStream -- | 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 'setHeader'.-raw :: (ScottyError e, Monad m) => BL.ByteString -> ActionT e m ()+raw :: Monad m => BL.ByteString -> ActionT e m () raw = ActionT . MS.modify . setContent . ContentBuilder . fromLazyByteString
Web/Scotty/Internal/Types.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies #-}+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies, DeriveDataTypeable #-} module Web.Scotty.Internal.Types where import Blaze.ByteString.Builder (Builder)@@ -6,21 +6,21 @@ import Control.Applicative import qualified Control.Exception as E import Control.Monad.Base (MonadBase, liftBase, liftBaseDefault)-#if MIN_VERSION_mtl(2,2,1)-import Control.Monad.Except-#else-import Control.Monad.Error-#endif+import Control.Monad.Error.Class import Control.Monad.Reader import Control.Monad.State import Control.Monad.Trans.Control (MonadBaseControl, StM, liftBaseWith, restoreM, ComposeSt, defaultLiftBaseWith, defaultRestoreM, MonadTransControl, StT, liftWith, restoreT)-+import Control.Monad.Trans.Except +import qualified Data.ByteString as BS import Data.ByteString.Lazy.Char8 (ByteString)-import Data.Default (Default, def)+import Data.Default.Class (Default, def)+#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid (mempty)+#endif import Data.String (IsString(..)) import Data.Text.Lazy (Text, pack)+import Data.Typeable (Typeable) import Network.HTTP.Types @@ -54,23 +54,21 @@ , handler :: ErrorHandler e m } -instance Monad m => Default (ScottyState e m) where+instance 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 e m -> ScottyState e m+addRoute :: Middleware m -> ScottyState e m -> ScottyState e m addRoute r s@(ScottyState {routes = rs}) = s { routes = r:rs } addHandler :: ErrorHandler e m -> ScottyState e m -> ScottyState e m addHandler h s = s { handler = h } -newtype ScottyT e m a = ScottyT { runS :: StateT (ScottyState e m) m a }- deriving ( Functor, Applicative, Monad, MonadIO )+newtype ScottyT e m a = ScottyT { runS :: State (ScottyState e m) a }+ deriving ( Functor, Applicative, Monad ) -instance MonadTrans (ScottyT e) where- lift = ScottyT . lift ------------------ Scotty Errors -------------------- data ActionError e = Redirect Text@@ -93,11 +91,6 @@ showError Next = pack "Next" showError (ActionError e) = showError e -#if !MIN_VERSION_mtl(2,2,1)-instance ScottyError e => Error (ActionError e) where- strMsg = stringError-#endif- type ErrorHandler e m = Maybe (e -> ActionT e m ()) ------------------ Scotty Actions -------------------@@ -105,12 +98,21 @@ type File = (Text, FileInfo ByteString) -data ActionEnv = Env { getReq :: Request- , getParams :: [Param]- , getBody :: ByteString- , getFiles :: [File]+data ActionEnv = Env { getReq :: Request+ , getParams :: [Param]+ , getBody :: IO ByteString+ , getBodyChunk :: IO BS.ByteString+ , getFiles :: [File] } +data RequestBodyState = BodyUntouched + | BodyCached ByteString [BS.ByteString] -- whole body, chunks left to stream+ | BodyCorrupted++data BodyPartiallyStreamed = BodyPartiallyStreamed deriving (Show, Typeable)++instance E.Exception BodyPartiallyStreamed+ data Content = ContentBuilder Builder | ContentFile FilePath | ContentStream StreamingBody@@ -123,19 +125,36 @@ instance Default ScottyResponse where def = SR status200 [] (ContentBuilder mempty) -#if MIN_VERSION_mtl(2,2,1) newtype ActionT e m a = ActionT { runAM :: ExceptT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a }-#else-newtype ActionT e m a = ActionT { runAM :: ErrorT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a }+ deriving ( Functor, Applicative )++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+#if !(MIN_VERSION_base(4,8,0))+ , Functor m #endif- deriving ( Functor, Applicative, Monad )+ ) => Alternative (ActionT e m) where+ empty = mzero+ (<|>) = mplus +instance (Monad m, ScottyError e) => MonadPlus (ActionT e m) where+ mzero = ActionT . ExceptT . return $ Left Next+ ActionT m `mplus` ActionT n = ActionT . ExceptT $ do+ a <- runExceptT m+ 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 ScottyError e => MonadTrans (ActionT e) where+instance MonadTrans (ActionT e) where lift = ActionT . lift . lift . lift instance (ScottyError e, Monad m) => MonadError (ActionError e) (ActionT e m) where@@ -148,12 +167,8 @@ liftBase = liftBaseDefault -instance ScottyError e => MonadTransControl (ActionT e) where-#if MIN_VERSION_mtl(2,2,1)+instance MonadTransControl (ActionT e) where type StT (ActionT e) a = StT (StateT ScottyResponse) (StT (ReaderT ActionEnv) (StT (ExceptT (ActionError e)) a))-#else- type StT (ActionT e) a = StT (StateT ScottyResponse) (StT (ReaderT ActionEnv) (StT (ErrorT (ActionError e)) a))-#endif liftWith = \f -> ActionT $ liftWith $ \run -> liftWith $ \run' ->
Web/Scotty/Route.hs view
@@ -1,23 +1,22 @@ {-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, OverloadedStrings, RankNTypes, ScopedTypeVariables #-} module Web.Scotty.Route- ( get, post, put, delete, patch, addroute, matchAny, notFound,+ ( get, post, put, delete, patch, options, addroute, matchAny, notFound, capture, regex, function, literal ) where import Control.Arrow ((***)) import Control.Concurrent.MVar-#if MIN_VERSION_mtl(2,2,1)-import Control.Monad.Except-#else-import Control.Monad.Error-#endif+import Control.Exception (throw)+import Control.Monad.IO.Class import qualified Control.Monad.State as MS import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, isJust)+#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid (mconcat)+#endif import Data.String (fromString) import qualified Data.Text.Lazy as T import qualified Data.Text as TS@@ -52,6 +51,10 @@ patch :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m () patch = addroute PATCH +-- | options = 'addroute' 'OPTIONS'+options :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()+options = addroute OPTIONS+ -- | Add a route that matches regardless of the HTTP verb. matchAny :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m () matchAny pattern action = mapM_ (\v -> addroute v pattern action) [minBound..maxBound]@@ -131,19 +134,54 @@ mkEnv :: forall m. MonadIO m => Request -> [Param] -> m ActionEnv mkEnv req captures = do+ bodyState <- liftIO $ newMVar BodyUntouched+ let rbody = requestBody req- takeAll :: ([B.ByteString] -> m [B.ByteString]) -> m [B.ByteString]- takeAll prefix = liftIO rbody >>= \ b -> if B.null b then prefix [] else takeAll (prefix . (b:))- bs <- takeAll return+ takeAll :: ([B.ByteString] -> IO [B.ByteString]) -> IO [B.ByteString]+ takeAll prefix = rbody >>= \b -> if B.null b then prefix [] else takeAll (prefix . (b:)) - (formparams, fs) <- liftIO $ parseRequestBody bs Parse.lbsBackEnd req+ safeBodyReader :: IO B.ByteString+ safeBodyReader = do+ state <- takeMVar bodyState+ let direct = putMVar bodyState BodyCorrupted >> rbody+ case state of + s@(BodyCached _ []) -> + do putMVar bodyState s + return B.empty+ BodyCached b (chunk:rest) -> + do putMVar bodyState $ BodyCached b rest+ return chunk+ BodyUntouched -> direct+ BodyCorrupted -> direct - let convert (k, v) = (strictByteStringToLazyText k, strictByteStringToLazyText v)- parameters = captures ++ map convert formparams ++ queryparams+ bs :: IO BL.ByteString+ bs = do+ state <- takeMVar bodyState+ case state of + s@(BodyCached b _) -> + do putMVar bodyState s+ return b+ BodyCorrupted -> throw BodyPartiallyStreamed+ BodyUntouched -> + do chunks <- takeAll return+ let b = BL.fromChunks chunks+ putMVar bodyState $ BodyCached b chunks+ return b++ shouldParseBody = isJust $ Parse.getRequestBodyType req++ (formparams, fs) <- if shouldParseBody+ then liftIO $ do putStrLn "consuming body"+ wholeBody <- BL.toChunks `fmap` bs+ parseRequestBody wholeBody Parse.lbsBackEnd req+ else return ([], [])++ let + convert (k, v) = (strictByteStringToLazyText k, strictByteStringToLazyText v)+ parameters = captures ++ map convert formparams ++ queryparams queryparams = parseEncodedParams $ rawQueryString req- b = BL.fromChunks bs - return $ Env req parameters b [ (strictByteStringToLazyText k, fi) | (k,fi) <- fs ]+ return $ Env req parameters bs safeBodyReader [ (strictByteStringToLazyText k, fi) | (k,fi) <- fs ] parseEncodedParams :: B.ByteString -> [Param] parseEncodedParams bs = [ (T.fromStrict k, T.fromStrict $ fromMaybe "" v) | (k,v) <- parseQueryText bs ]
Web/Scotty/Trans.hs view
@@ -11,17 +11,17 @@ -- the comments on each of these functions for more information. module Web.Scotty.Trans ( -- * scotty-to-WAI- scottyT, scottyAppT, scottyOptsT, Options(..)+ scottyT, scottyAppT, scottyOptsT, scottySocketT, Options(..) -- * Defining Middleware and Routes -- -- | 'Middleware' and routes are run in the order in which they -- are defined. All middleware is run first, followed by the first -- route that matches. If no route matches, a 404 response is given.- , middleware, get, post, put, delete, patch, addroute, matchAny, notFound+ , middleware, get, post, put, delete, patch, options, addroute, matchAny, notFound -- ** Route Patterns , capture, regex, function, literal -- ** Accessing the Request, Captures, and Query Parameters- , request, header, headers, body, param, params, jsonData, files+ , request, header, headers, body, bodyReader, param, params, jsonData, files -- ** Modifying the Response and Redirecting , status, addHeader, setHeader, redirect -- ** Setting Response Body@@ -42,53 +42,67 @@ import Blaze.ByteString.Builder (fromByteString) import Control.Monad (when)-import Control.Monad.State (execStateT, modify)+import Control.Monad.State (execState, modify) import Control.Monad.IO.Class -import Data.Default (def)+import Data.Default.Class (def) +import Network (Socket) import Network.HTTP.Types (status404, status500) import Network.Wai-import Network.Wai.Handler.Warp (Port, runSettings, setPort, getPort)+import Network.Wai.Handler.Warp (Port, runSettings, runSettingsSocket, setPort, getPort) import Web.Scotty.Action import Web.Scotty.Route import Web.Scotty.Internal.Types hiding (Application, Middleware)+import Web.Scotty.Util (socketDescription) import qualified Web.Scotty.Internal.Types as Scotty -- | Run a scotty application using the warp server.--- NB: scotty p === scottyT p id id+-- NB: scotty p === scottyT p id scottyT :: (Monad m, MonadIO n) => 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 e m () -> n () scottyT p = scottyOptsT $ def { settings = setPort p (settings def) } -- | Run a scotty application using the warp server, passing extra options.--- NB: scottyOpts opts === scottyOptsT opts id id+-- NB: scottyOpts opts === scottyOptsT opts id scottyOptsT :: (Monad m, MonadIO n) => 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 e m () -> n ()-scottyOptsT opts runM runActionToIO s = do+scottyOptsT opts runActionToIO s = do when (verbose opts > 0) $ liftIO $ putStrLn $ "Setting phasers to stun... (port " ++ show (getPort (settings opts)) ++ ") (ctrl-c to quit)"- liftIO . runSettings (settings opts) =<< scottyAppT runM runActionToIO s+ liftIO . runSettings (settings opts) =<< scottyAppT runActionToIO s +-- | Run a scotty application using the warp server, passing extra options, and+-- listening on the provided socket.+-- NB: scottySocket opts sock === scottySocketT opts sock id+scottySocketT :: (Monad m, MonadIO n)+ => Options+ -> Socket+ -> (m Response -> IO Response)+ -> ScottyT e m ()+ -> n ()+scottySocketT opts sock runActionToIO s = do+ when (verbose opts > 0) $ do+ d <- liftIO $ socketDescription sock+ liftIO $ putStrLn $ "Setting phasers to stun... (" ++ d ++ ") (ctrl-c to quit)"+ liftIO . runSettingsSocket (settings opts) sock =<< scottyAppT runActionToIO s+ -- | Turn a scotty application into a WAI 'Application', which can be -- run with any WAI handler.--- NB: scottyApp === scottyAppT id id+-- NB: scottyApp === scottyAppT id 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.+ => (m Response -> IO Response) -- ^ Run monad 'm' into 'IO', called at each action. -> ScottyT e m () -> n Application-scottyAppT runM runActionToIO defs = do- s <- runM $ execStateT (runS defs) def+scottyAppT runActionToIO defs = do+ let s = execState (runS defs) def let rapp req callback = runActionToIO (foldl (flip ($)) notFoundApp (routes s) req) >>= callback return $ foldl (flip ($)) rapp (middlewares s)
Web/Scotty/Util.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Web.Scotty.Util ( lazyTextToStrictByteString , strictByteStringToLazyText@@ -8,8 +9,10 @@ , replace , add , addIfNotPresent+ , socketDescription ) where +import Network (Socket, PortID(..), socketPort) import Network.Wai import Network.HTTP.Types@@ -50,7 +53,7 @@ replace :: Eq a => a -> b -> [(a,b)] -> [(a,b)] replace k v = add k v . filter ((/= k) . fst) -add :: Eq a => a -> b -> [(a,b)] -> [(a,b)]+add :: a -> b -> [(a,b)] -> [(a,b)] add k v m = (k,v):m addIfNotPresent :: Eq a => a -> b -> [(a,b)] -> [(a,b)]@@ -59,3 +62,13 @@ go l@((x,y):r) | x == k = l | otherwise = (x,y) : go r++-- Assemble a description from the Socket's PortID.+socketDescription :: Socket -> IO String+socketDescription = fmap d . socketPort+ where d p = case p of+ Service s -> "service " ++ s+ PortNumber n -> "port " ++ show n+#if !defined(mingw32_HOST_OS)+ UnixSocket u -> "unix socket " ++ u+#endif
changelog.md view
@@ -1,12 +1,42 @@-## 0.9.1+## 0.10.0 -* `Parsable` instance for lazy bytestrings+* The monad parameters to `ScottyT` have been decoupled, causing the type+ of the `ScottyT` constructor to change. As a result, `ScottyT` is no+ longer a `MonadTrans` instance, and the type signatures of`scottyT`,+ `scottyAppT`, and `scottyOptsT` have been simplified. [ehamberg] -* `jsonData` now returns decoding error message+* `socketDescription` no longer uses the deprecated `PortNum` constructor.+ Instead, it uses the `Show` instance for `PortNumber`. This changes the+ bytes from host to network order, so the output of `socketDescription`+ could change. [ehamberg] -* text/html/json only set Content-Type header when not already set+* `Alternative`, `MonadPlus` instances for `ActionT` -* Bump `monad-control` to 1.0.0.0+* `scotty` now depends on `transformers-compat`. As a result, `ActionT` now+ uses `ExceptT`, regardless of which version of `transformers` is used.+ As a result, several functions in `Web.Scotty.Trans` no longer require a+ `ScottyError` constraint, since `ExceptT` does not require an `Error`+ constraint (unlike `ErrorT`).++* Added support for OPTIONS routes via the `options` function [alvare]++* Add `scottySocket` and `scottySocketT`, exposing Warp Unix socket support+ [hakujin]++* `Parsable` instance for lazy `ByteString` [tattsun]++* Added streaming uploads via the `bodyReader` function, which retrieves chunks+ of the request body. [edofic]+ - `ActionEnv` had a `getBodyChunk` field added (in + `Web.Scotty.Internal.Types`)+ - `RequestBodyState` and `BodyPartiallyStreamed` added to+ `Web.Scotty.Internal.Types`++* `jsonData` uses `aeson`'s `eitherDecode` instead of just `decode` [k-bx]++## 0.9.1++* text/html/json only set Content-Type header when not already set ## 0.9.0
examples/basic.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}+module Main (main) where+ import Web.Scotty import Network.Wai.Middleware.RequestLogger -- install wai-extra if you don't have this@@ -9,11 +11,10 @@ import System.Random (newStdGen, randomRs) import Network.HTTP.Types (status302)-import Network.Wai-import qualified Data.Text.Lazy as T import Data.Text.Lazy.Encoding (decodeUtf8) import Data.String (fromString)+import Prelude main :: IO () main = scotty 3000 $ do@@ -45,12 +46,12 @@ -- redirects preempt execution get "/redirect" $ do- redirect "http://www.google.com"+ void $ redirect "http://www.google.com" raise "this error is never reached" -- Of course you can catch your own errors. get "/rescue" $ do- (do raise "a rescued error"; redirect "http://www.we-never-go-here.com")+ (do void $ raise "a rescued error"; redirect "http://www.we-never-go-here.com") `rescue` (\m -> text $ "we recovered from " `mappend` m) -- Parts of the URL that start with a colon match@@ -65,7 +66,7 @@ -- You can stop execution of this action and keep pattern matching routes. get "/random" $ do- next+ void next redirect "http://www.we-never-go-here.com" -- You can do IO with liftIO, and you can return JSON content.
examples/cookies.hs view
@@ -1,9 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -- This examples requires you to: cabal install cookie -- and: cabal install blaze-html+module Main (main) where+ 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@@ -27,7 +28,7 @@ getCookies :: ActionM (Maybe CookiesText) getCookies = fmap (fmap (parseCookiesText . lazyToStrict . T.encodeUtf8)) $- reqHeader "Cookie"+ header "Cookie" where lazyToStrict = BS.concat . BSL.toChunks @@ -37,9 +38,9 @@ H.tr $ do H.th "name" H.th "value"- forM_ cs $ \(name, val) -> do+ forM_ cs $ \(name', val) -> do H.tr $ do- H.td (H.toMarkup name)+ H.td (H.toMarkup name') H.td (H.toMarkup val) main :: IO ()@@ -56,7 +57,7 @@ H.input H.! type_ "submit" H.! value "set a cookie" post "/set-a-cookie" $ do- name <- param "name"- value <- param "value"- setCookie name value+ name' <- param "name"+ value' <- param "value"+ setCookie name' value' redirect "/"
examples/exceptions.hs view
@@ -1,16 +1,16 @@ {-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}-module Main where+module Main (main) where -import Control.Applicative-import Control.Monad.Error+import Control.Monad.IO.Class import Data.Monoid import Data.String (fromString) import Network.HTTP.Types import Network.Wai.Middleware.RequestLogger-import Network.Wai +import Prelude+ import System.Random import Web.Scotty.Trans@@ -35,8 +35,8 @@ 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.+main = scottyT 3000 id $ do -- note, we aren't using any additional transformer layers+ -- so we can just use 'id' for the runner. middleware logStdoutDev defaultHandler handleEx -- define what to do with uncaught exceptions@@ -51,7 +51,7 @@ get "/switch/:val" $ do v <- param "val"- if even v then raise Forbidden else raise (NotFound v)+ _ <- if even v then raise Forbidden else raise (NotFound v) text "this will never be reached" get "/random" $ do
examples/globalstate.hs view
@@ -7,17 +7,20 @@ -- is IO itself. The types of 'scottyT' and 'scottyAppT' are -- general enough to allow a Scotty application to be -- embedded into any MonadIO monad.-module Main where+module Main (main) where +import Control.Applicative import Control.Concurrent.STM import Control.Monad.Reader -import Data.Default+import Data.Default.Class import Data.String import Data.Text.Lazy (Text) import Network.Wai.Middleware.RequestLogger +import Prelude+ import Web.Scotty.Trans newtype AppState = AppState { tickCount :: Int }@@ -36,7 +39,7 @@ -- Also note: your monad must be an instance of 'MonadIO' for -- Scotty to use it. newtype WebM a = WebM { runWebM :: ReaderT (TVar AppState) IO a }- deriving (Monad, MonadIO, MonadReader (TVar AppState))+ deriving (Applicative, Functor, Monad, MonadIO, MonadReader (TVar AppState)) -- Scotty's monads are layered on top of our custom monad. -- We define this synonym for lift in order to be explicit@@ -54,12 +57,10 @@ main :: IO () main = do sync <- newTVarIO def- -- Note that 'runM' is only called once, at startup.- let runM m = runReaderT (runWebM m) sync -- 'runActionToIO' is called once per action.- runActionToIO = runM+ let runActionToIO m = runReaderT (runWebM m) sync - scottyT 3000 runM runActionToIO app+ scottyT 3000 runActionToIO app -- This app doesn't use raise/rescue, so the exception -- type is ambiguous. We can fix it by putting a type
examples/gzip.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}+module Main (main) where+ import Network.Wai.Middleware.RequestLogger import Network.Wai.Middleware.Gzip
examples/options.hs view
@@ -1,15 +1,17 @@ {-# LANGUAGE OverloadedStrings #-}+module Main (main) where+ import Web.Scotty import Network.Wai.Middleware.RequestLogger -- install wai-extra if you don't have this -import Data.Default (def)-import Network.Wai.Handler.Warp (settingsPort)+import Data.Default.Class (def)+import Network.Wai.Handler.Warp (setPort) -- Set some Scotty settings opts :: Options opts = def { verbose = 0- , settings = (settings def) { settingsPort = 4000 }+ , settings = setPort 4000 $ settings def } -- This won't display anything at startup, and will listen on localhost:4000
examples/upload.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}+module Main (main) where+ import Web.Scotty import Control.Monad.IO.Class@@ -15,6 +17,7 @@ import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Char8 as BS import System.FilePath ((</>))+import Prelude main :: IO () main = scotty 3000 $ do
examples/urlshortener.hs view
@@ -1,15 +1,19 @@ {-# LANGUAGE OverloadedStrings #-}+module Main (main) where+ import Web.Scotty import Control.Concurrent.MVar import Control.Monad.IO.Class import qualified Data.Map as M-import Data.Monoid (mconcat)+import Data.Monoid import qualified Data.Text.Lazy as T import Network.Wai.Middleware.RequestLogger import Network.Wai.Middleware.Static +import Prelude+ import qualified Text.Blaze.Html5 as H import Text.Blaze.Html5.Attributes -- Note:@@ -23,11 +27,11 @@ -- Add links main :: IO ()-main = scotty 3000 $ do+main = do+ m <- newMVar (0::Int,M.empty :: M.Map Int T.Text)+ scotty 3000 $ do middleware logStdoutDev middleware static-- m <- liftIO $ newMVar (0::Int,M.empty :: M.Map Int T.Text) get "/" $ do html $ renderHtml
scotty.cabal view
@@ -1,5 +1,5 @@ Name: scotty-Version: 0.9.1+Version: 0.10.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@@ -68,23 +68,25 @@ Web.Scotty.Route Web.Scotty.Util default-language: Haskell2010- build-depends: aeson >= 0.6.2.1 && < 0.9,- 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.3,- data-default >= 0.5.3 && < 0.6,- http-types >= 0.8.2 && < 0.9,- mtl >= 2.1.2 && < 2.3,- monad-control >= 1.0.0.0 && < 1.1,- regex-compat >= 0.95.1 && < 0.96,- text >= 0.11.3.1 && < 1.3,- transformers >= 0.3.0.0 && < 0.5,- transformers-base >= 0.4.1 && < 0.5,- wai >= 3.0.0 && < 3.1,- wai-extra >= 3.0.0 && < 3.1,- warp >= 3.0.0 && < 3.1-+ build-depends: aeson >= 0.6.2.1 && < 0.10,+ 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,+ monad-control >= 1.0.0.3 && < 1.1,+ mtl >= 2.1.2 && < 2.3,+ 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-base >= 0.4.1 && < 0.5,+ transformers-compat >= 0.4 && < 0.5,+ wai >= 3.0.0 && < 3.1,+ wai-extra >= 3.0.0 && < 3.1,+ warp >= 3.0.0 && < 3.1+ GHC-options: -Wall -fno-warn-orphans test-suite spec@@ -92,16 +94,19 @@ type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test- build-depends: base,- bytestring,- text,+ build-depends: async,+ base,+ data-default-class,+ directory,+ hspec == 2.*,+ hspec-wai >= 0.6.3, http-types, lifted-base,- wai,- hspec == 2.*,- hspec-wai >= 0.5,- scotty- GHC-options: -Wall -fno-warn-orphans+ network,+ scotty,+ text,+ wai+ GHC-options: -Wall -threaded -fno-warn-orphans source-repository head type: git