packages feed

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 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