scotty-0.12/ 0000755 0000000 0000000 00000000000 07346545000 011152 5 ustar 00 0000000 0000000 scotty-0.12/LICENSE 0000644 0000000 0000000 00000002767 07346545000 012173 0 ustar 00 0000000 0000000 Copyright (c) 2012-2017 Andrew Farmer
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Andrew Farmer nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
scotty-0.12/README.md 0000755 0000000 0000000 00000002377 07346545000 012445 0 ustar 00 0000000 0000000 # Scotty [](https://travis-ci.org/scotty-web/scotty)
A Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp.
```haskell
{-# LANGUAGE OverloadedStrings #-}
import Web.Scotty
import Data.Monoid (mconcat)
main = scotty 3000 $
get "/:word" $ do
beam <- param "word"
html $ mconcat ["
Scotty, ", beam, " me up!
"]
```
Scotty is the cheap and cheerful way to write RESTful, declarative web applications.
* A page is as simple as defining the verb, URL pattern, and Text content.
* It is template-language agnostic. Anything that returns a Text value will do.
* Conforms to the [web application interface (WAI)](https://github.com/yesodweb/wai/).
* Uses the very fast Warp webserver by default.
See examples/basic.hs to see Scotty in action. (basic.hs needs the wai-extra package)
```bash
> runghc examples/basic.hs
Setting phasers to stun... (port 3000) (ctrl-c to quit)
(visit localhost:3000/somepath)
```
As for the name: Sinatra + Warp = Scotty.
### More Information
Tutorials and related projects can be found in the [Scotty wiki](https://github.com/scotty-web/scotty/wiki).
### Development & Support
Open an issue on GitHub.
Copyright (c) 2012-2019 Andrew Farmer
scotty-0.12/Setup.hs 0000644 0000000 0000000 00000000056 07346545000 012607 0 ustar 00 0000000 0000000 import Distribution.Simple
main = defaultMain
scotty-0.12/Web/ 0000755 0000000 0000000 00000000000 07346545000 011667 5 ustar 00 0000000 0000000 scotty-0.12/Web/Scotty.hs 0000644 0000000 0000000 00000027245 07346545000 013522 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings, RankNTypes #-}
-- | It should be noted that most of the code snippets below depend on the
-- OverloadedStrings language pragma.
--
-- Scotty is set up by default for development mode. For production servers,
-- you will likely want to modify 'Trans.settings' and the 'defaultHandler'. See
-- the comments on each of these functions for more information.
module Web.Scotty
( -- * scotty-to-WAI
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, options, addroute, matchAny, notFound
-- ** Route Patterns
, capture, regex, function, literal
-- ** Accessing the Request, Captures, and Query Parameters
, request, header, headers, body, bodyReader, param, params, jsonData, files
-- ** Modifying the Response and Redirecting
, status, addHeader, setHeader, redirect
-- ** Setting Response Body
--
-- | Note: only one of these should be present in any given route
-- definition, as they completely replace the current 'Response' body.
, text, html, file, json, stream, raw
-- ** Exceptions
, raise, raiseStatus, rescue, next, finish, defaultHandler, liftAndCatchIO
-- * Parsing Parameters
, Param, Trans.Parsable(..), Trans.readEither
-- * Types
, ScottyM, ActionM, RoutePattern, File
) where
-- With the exception of this, everything else better just import types.
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.HTTP.Types (Status, StdMethod)
import Network.Socket (Socket)
import Network.Wai (Application, Middleware, Request, StreamingBody)
import Network.Wai.Handler.Warp (Port)
import Web.Scotty.Internal.Types (ScottyT, ActionT, Param, RoutePattern, Options, File)
type ScottyM = ScottyT Text IO
type ActionM = ActionT Text IO
-- | Run a scotty application using the warp server.
scotty :: Port -> ScottyM () -> IO ()
scotty p = Trans.scottyT p id
-- | Run a scotty application using the warp server, passing extra options.
scottyOpts :: Options -> ScottyM () -> IO ()
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
-- | Global handler for uncaught exceptions.
--
-- Uncaught exceptions normally become 500 responses.
-- You can use this to selectively override that behavior.
--
-- Note: IO exceptions are lifted into Scotty exceptions by default.
-- This has security implications, so you probably want to provide your
-- own defaultHandler in production which does not send out the error
-- strings as 500 responses.
defaultHandler :: (Text -> ActionM ()) -> ScottyM ()
defaultHandler = Trans.defaultHandler
-- | Use given middleware. Middleware is nested such that the first declared
-- is the outermost middleware (it has first dibs on the request and last action
-- on the response). Every middleware is run on each request.
middleware :: Middleware -> ScottyM ()
middleware = Trans.middleware
-- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions
-- turn into HTTP 500 responses.
raise :: Text -> ActionM a
raise = Trans.raise
-- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions turn into HTTP responses corresponding to the given status.
raiseStatus :: Status -> Text -> ActionM a
raiseStatus = Trans.raiseStatus
-- | Abort execution of this action and continue pattern matching routes.
-- Like an exception, any code after 'next' is not executed.
--
-- As an example, these two routes overlap. The only way the second one will
-- ever run is if the first one calls 'next'.
--
-- > get "/foo/:bar" $ do
-- > w :: Text <- param "bar"
-- > unless (w == "special") next
-- > text "You made a request to /foo/special"
-- >
-- > get "/foo/:baz" $ do
-- > w <- param "baz"
-- > text $ "You made a request to: " <> w
next :: ActionM a
next = Trans.next
-- | 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.
--
-- > redirect "http://www.google.com"
--
-- OR
--
-- > redirect "/foo/bar"
redirect :: Text -> ActionM a
redirect = Trans.redirect
-- | Get the 'Request' object.
request :: ActionM Request
request = Trans.request
-- | Get list of uploaded files.
files :: ActionM [File]
files = Trans.files
-- | Get a request header. Header name is case-insensitive.
header :: Text -> ActionM (Maybe Text)
header = Trans.header
-- | Get all the request headers. Header names are case-insensitive.
headers :: ActionM [(Text, Text)]
headers = Trans.headers
-- | Get the request body.
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
-- | Get a parameter. First looks in captures, then form data, then query parameters.
--
-- * Raises an exception which can be caught by 'rescue' if parameter is not found.
--
-- * If parameter is found, but 'read' fails to parse to the correct type, 'next' is called.
-- This means captures are somewhat typed, in that a route won't match if a correctly typed
-- capture cannot be parsed.
param :: Trans.Parsable a => Text -> ActionM a
param = Trans.param
-- | Get all parameters from capture, form and query (in that order).
params :: ActionM [Param]
params = Trans.params
-- | Set the HTTP response status. Default is 200.
status :: Status -> ActionM ()
status = Trans.status
-- | Add to the response headers. Header names are case-insensitive.
addHeader :: Text -> Text -> ActionM ()
addHeader = Trans.addHeader
-- | Set one of the response headers. Will override any previously set value for that header.
-- Header names are case-insensitive.
setHeader :: Text -> Text -> ActionM ()
setHeader = Trans.setHeader
-- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\"
-- header to \"text/plain; charset=utf-8\" if it has not already been set.
text :: Text -> ActionM ()
text = Trans.text
-- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\"
-- header to \"text/html; charset=utf-8\" if it has not already been set.
html :: Text -> ActionM ()
html = Trans.html
-- | Send a file as the response. Doesn't set the \"Content-Type\" header, so you probably
-- want to do that on your own with 'setHeader'.
file :: FilePath -> ActionM ()
file = Trans.file
-- | Set the body of the response to the JSON encoding of the given value. Also sets \"Content-Type\"
-- header to \"application/json; charset=utf-8\" if it has not already been set.
json :: ToJSON a => a -> ActionM ()
json = Trans.json
-- | Set the body of the response to a StreamingBody. Doesn't set the
-- \"Content-Type\" header, so you probably want to do that on your
-- own with 'setHeader'.
stream :: StreamingBody -> ActionM ()
stream = Trans.stream
-- | 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 :: ByteString -> ActionM ()
raw = Trans.raw
-- | get = 'addroute' 'GET'
get :: RoutePattern -> ActionM () -> ScottyM ()
get = Trans.get
-- | post = 'addroute' 'POST'
post :: RoutePattern -> ActionM () -> ScottyM ()
post = Trans.post
-- | put = 'addroute' 'PUT'
put :: RoutePattern -> ActionM () -> ScottyM ()
put = Trans.put
-- | delete = 'addroute' 'DELETE'
delete :: RoutePattern -> ActionM () -> ScottyM ()
delete = Trans.delete
-- | 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 ()
matchAny = Trans.matchAny
-- | Specify an action to take if nothing else is found. Note: this _always_ matches,
-- so should generally be the last route specified.
notFound :: ActionM () -> ScottyM ()
notFound = Trans.notFound
-- | Define a route with a 'StdMethod', 'Text' value representing the path spec,
-- and a body ('Action') which modifies the response.
--
-- > addroute GET "/" $ text "beam me up!"
--
-- The path spec can include values starting with a colon, which are interpreted
-- as /captures/. These are named wildcards that can be looked up with 'param'.
--
-- > addroute GET "/foo/:bar" $ do
-- > v <- param "bar"
-- > text v
--
-- >>> curl http://localhost:3000/foo/something
-- something
addroute :: StdMethod -> RoutePattern -> ActionM () -> ScottyM ()
addroute = Trans.addroute
-- | Match requests using a regular expression.
-- Named captures are not yet supported.
--
-- > get (regex "^/f(.*)r$") $ do
-- > path <- param "0"
-- > cap <- param "1"
-- > text $ mconcat ["Path: ", path, "\nCapture: ", cap]
--
-- >>> curl http://localhost:3000/foo/bar
-- Path: /foo/bar
-- Capture: oo/ba
--
regex :: String -> RoutePattern
regex = Trans.regex
-- | Standard Sinatra-style route. Named captures are prepended with colons.
-- This is the default route type generated by OverloadedString routes. i.e.
--
-- > get (capture "/foo/:bar") $ ...
--
-- and
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > ...
-- > get "/foo/:bar" $ ...
--
-- are equivalent.
capture :: String -> RoutePattern
capture = Trans.capture
-- | Build a route based on a function which can match using the entire 'Request' object.
-- 'Nothing' indicates the route does not match. A 'Just' value indicates
-- a successful match, optionally returning a list of key-value pairs accessible
-- by 'param'.
--
-- > get (function $ \req -> Just [("version", pack $ show $ httpVersion req)]) $ do
-- > v <- param "version"
-- > text v
--
-- >>> curl http://localhost:3000/
-- HTTP/1.1
--
function :: (Request -> Maybe [Param]) -> RoutePattern
function = Trans.function
-- | Build a route that requires the requested path match exactly, without captures.
literal :: String -> RoutePattern
literal = Trans.literal
scotty-0.12/Web/Scotty/ 0000755 0000000 0000000 00000000000 07346545000 013154 5 ustar 00 0000000 0000000 scotty-0.12/Web/Scotty/Action.hs 0000644 0000000 0000000 00000033415 07346545000 014733 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Web.Scotty.Action
( addHeader
, body
, bodyReader
, file
, files
, finish
, header
, headers
, html
, liftAndCatchIO
, json
, jsonData
, next
, param
, params
, raise
, raiseStatus
, raw
, readEither
, redirect
, request
, rescue
, setHeader
, status
, stream
, text
, Param
, Parsable(..)
-- private to Scotty
, runAction
) where
import Blaze.ByteString.Builder (fromLazyByteString)
import qualified Control.Exception as E
import Control.Monad.Error.Class
import Control.Monad.Reader hiding (mapM)
import qualified Control.Monad.State.Strict 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.Class (def)
import Data.Int
import qualified Data.Text as ST
import qualified Data.Text.Encoding as STE
import qualified Data.Text.Lazy as T
import Data.Text.Lazy.Encoding (encodeUtf8)
import Data.Word
import Network.HTTP.Types
-- not re-exported until version 0.11
#if !MIN_VERSION_http_types(0,11,0)
import Network.HTTP.Types.Status
#endif
import Network.Wai
import Numeric.Natural
import Prelude ()
import Prelude.Compat
import Web.Scotty.Internal.Types
import Web.Scotty.Util
-- Nothing indicates route failed (due to Next) and pattern matching should continue.
-- Just indicates a successful response.
runAction :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionEnv -> ActionT e m () -> m (Maybe Response)
runAction h env action = do
(e,r) <- flip MS.runStateT def
$ flip runReaderT env
$ runExceptT
$ runAM
$ action `catchError` (defH h)
return $ either (const Nothing) (const $ Just $ mkResponse r) e
-- | Default error handler for all actions.
defH :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionError e -> ActionT e m ()
defH _ (Redirect url) = do
status status302
setHeader "Location" url
defH Nothing (ActionError s e) = do
status s
let code = T.pack $ show $ statusCode s
let msg = T.fromStrict $ STE.decodeUtf8 $ statusMessage s
html $ mconcat ["", code, " ", msg, "
", 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.
raise :: (ScottyError e, Monad m) => e -> ActionT e m a
raise = raiseStatus status500
-- | Throw an exception, which can be caught with 'rescue'. Uncaught exceptions turn into HTTP responses corresponding to the given status.
raiseStatus :: (ScottyError e, Monad m) => Status -> e -> ActionT e m a
raiseStatus s = throwError . ActionError s
-- | Abort execution of this action and continue pattern matching routes.
-- Like an exception, any code after 'next' is not executed.
--
-- As an example, these two routes overlap. The only way the second one will
-- ever run is if the first one calls 'next'.
--
-- > get "/foo/:bar" $ do
-- > w :: Text <- param "bar"
-- > unless (w == "special") next
-- > text "You made a request to /foo/special"
-- >
-- > get "/foo/:baz" $ do
-- > w <- param "baz"
-- > text $ "You made a request to: " <> w
next :: (ScottyError e, Monad m) => ActionT e m a
next = throwError Next
-- | Catch an exception thrown by 'raise'.
--
-- > raise "just kidding" `rescue` (\msg -> text msg)
rescue :: (ScottyError e, Monad m) => ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
rescue action h = catchError action $ \e -> case e of
ActionError _ err -> h err -- handle errors
other -> throwError other -- rethrow internal error types
-- | 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.
--
-- > redirect "http://www.google.com"
--
-- OR
--
-- > 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
request = ActionT $ liftM getReq ask
-- | Get list of uploaded files.
files :: Monad m => ActionT e m [File]
files = ActionT $ liftM getFiles ask
-- | Get a request header. Header name is case-insensitive.
header :: (ScottyError e, Monad m) => T.Text -> ActionT e m (Maybe T.Text)
header k = do
hs <- liftM requestHeaders request
return $ fmap strictByteStringToLazyText $ lookup (CI.mk (lazyTextToStrictByteString k)) hs
-- | Get all the request headers. Header names are case-insensitive.
headers :: (ScottyError e, Monad m) => ActionT e m [(T.Text, T.Text)]
headers = do
hs <- liftM requestHeaders request
return [ ( strictByteStringToLazyText (CI.original k)
, strictByteStringToLazyText v)
| (k,v) <- hs ]
-- | Get the request body.
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.
--
-- If the JSON object is malformed, this sets the status to
-- 400 Bad Request, and throws an exception.
--
-- If the JSON fails to parse, this sets the status to
-- 422 Unprocessable Entity.
--
-- These status codes are as per https://www.restapitutorial.com/httpstatuscodes.html.
jsonData :: (A.FromJSON a, ScottyError e, MonadIO m) => ActionT e m a
jsonData = do
b <- body
when (b == "") $ do
let htmlError = "jsonData - No data was provided."
raiseStatus status400 $ stringError htmlError
case A.eitherDecode b of
Left err -> do
let htmlError = "jsonData - malformed."
`mappend` " Data was: " `mappend` BL.unpack b
`mappend` " Error was: " `mappend` err
raiseStatus status400 $ stringError htmlError
Right value -> case A.fromJSON value of
A.Error err -> do
let htmlError = "jsonData - failed parse."
`mappend` " Data was: " `mappend` BL.unpack b `mappend` "."
`mappend` " Error was: " `mappend` err
raiseStatus status422 $ stringError htmlError
A.Success a -> do
return a
-- | Get a parameter. First looks in captures, then form data, then query parameters.
--
-- * Raises an exception which can be caught by 'rescue' if parameter is not found.
--
-- * If parameter is found, but 'read' fails to parse to the correct type, 'next' is called.
-- This means captures are somewhat typed, in that a route won't match if a correctly typed
-- capture cannot be parsed.
param :: (Parsable a, ScottyError e, Monad m) => T.Text -> ActionT e m a
param k = do
val <- ActionT $ liftM (lookup k . getParams) ask
case val of
Nothing -> raise $ stringError $ "Param: " ++ T.unpack k ++ " not found!"
Just v -> either (const next) return $ parseParam v
-- | Get all parameters from capture, form and query (in that order).
params :: Monad m => ActionT e m [Param]
params = ActionT $ liftM getParams ask
-- | Minimum implemention: 'parseParam'
class Parsable a where
-- | Take a 'T.Text' value and parse it as 'a', or fail with a message.
parseParam :: T.Text -> Either T.Text a
-- | Default implementation parses comma-delimited lists.
--
-- > parseParamList t = mapM parseParam (T.split (== ',') t)
parseParamList :: T.Text -> Either T.Text [a]
parseParamList t = mapM parseParam (T.split (== ',') t)
-- No point using 'read' for Text, ByteString, Char, and String.
instance Parsable T.Text where parseParam = Right
instance Parsable ST.Text where parseParam = Right . T.toStrict
instance Parsable B.ByteString where parseParam = Right . lazyTextToStrictByteString
instance Parsable BL.ByteString where parseParam = Right . encodeUtf8
-- | Overrides default 'parseParamList' to parse String.
instance Parsable Char where
parseParam t = case T.unpack t of
[c] -> Right c
_ -> Left "parseParam Char: no parse"
parseParamList = Right . T.unpack -- String
-- | Checks if parameter is present and is null-valued, not a literal '()'.
-- If the URI requested is: '/foo?bar=()&baz' then 'baz' will parse as (), where 'bar' will not.
instance Parsable () where
parseParam t = if T.null t then Right () else Left "parseParam Unit: no parse"
instance (Parsable a) => Parsable [a] where parseParam = parseParamList
instance Parsable Bool where
parseParam t = if t' == T.toCaseFold "true"
then Right True
else if t' == T.toCaseFold "false"
then Right False
else Left "parseParam Bool: no parse"
where t' = T.toCaseFold t
instance Parsable Double where parseParam = readEither
instance Parsable Float where parseParam = readEither
instance Parsable Int where parseParam = readEither
instance Parsable Int8 where parseParam = readEither
instance Parsable Int16 where parseParam = readEither
instance Parsable Int32 where parseParam = readEither
instance Parsable Int64 where parseParam = readEither
instance Parsable Integer where parseParam = readEither
instance Parsable Word where parseParam = readEither
instance Parsable Word8 where parseParam = readEither
instance Parsable Word16 where parseParam = readEither
instance Parsable Word32 where parseParam = readEither
instance Parsable Word64 where parseParam = readEither
instance Parsable Natural where parseParam = readEither
-- | Useful for creating 'Parsable' instances for things that already implement 'Read'. Ex:
--
-- > instance Parsable Int where parseParam = readEither
readEither :: Read a => T.Text -> Either T.Text a
readEither t = case [ x | (x,"") <- reads (T.unpack t) ] of
[x] -> Right x
[] -> Left "readEither: no parse"
_ -> Left "readEither: ambiguous parse"
-- | Set the HTTP response status. Default is 200.
status :: Monad m => Status -> ActionT e m ()
status = ActionT . MS.modify . setStatus
-- Not exported, but useful in the functions below.
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
. MS.modify
. setHeaderWith
. f (CI.mk $ lazyTextToStrictByteString k)
. lazyTextToStrictByteString
-- | Add to the response headers. Header names are case-insensitive.
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 :: 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\"
-- header to \"text/plain; charset=utf-8\" if it has not already been set.
text :: (ScottyError e, Monad m) => T.Text -> ActionT e m ()
text t = do
changeHeader addIfNotPresent "Content-Type" "text/plain; charset=utf-8"
raw $ encodeUtf8 t
-- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"
-- header to \"text/html; charset=utf-8\" if it has not already been set.
html :: (ScottyError e, Monad m) => T.Text -> ActionT e m ()
html t = do
changeHeader addIfNotPresent "Content-Type" "text/html; charset=utf-8"
raw $ encodeUtf8 t
-- | Send a file as the response. Doesn't set the \"Content-Type\" header, so you probably
-- want to do that on your own with 'setHeader'.
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\"
-- header to \"application/json; charset=utf-8\" if it has not already been set.
json :: (A.ToJSON a, ScottyError e, Monad m) => a -> ActionT e m ()
json v = do
changeHeader addIfNotPresent "Content-Type" "application/json; charset=utf-8"
raw $ A.encode v
-- | Set the body of the response to a Source. Doesn't set the
-- \"Content-Type\" header, so you probably want to do that on your
-- own with 'setHeader'.
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 :: Monad m => BL.ByteString -> ActionT e m ()
raw = ActionT . MS.modify . setContent . ContentBuilder . fromLazyByteString
scotty-0.12/Web/Scotty/Internal/ 0000755 0000000 0000000 00000000000 07346545000 014730 5 ustar 00 0000000 0000000 scotty-0.12/Web/Scotty/Internal/Types.hs 0000644 0000000 0000000 00000021160 07346545000 016370 0 ustar 00 0000000 0000000 {-# 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)
import Control.Applicative
import qualified Control.Exception as E
import Control.Monad.Base (MonadBase, liftBase, liftBaseDefault)
import Control.Monad.Catch (MonadCatch, catch, MonadThrow, throwM)
import Control.Monad.Error.Class
import qualified Control.Monad.Fail as Fail
import Control.Monad.Reader
import Control.Monad.State.Strict
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.Class (Default, def)
import Data.String (IsString(..))
import Data.Text.Lazy (Text, pack)
import Data.Typeable (Typeable)
import Network.HTTP.Types
import Network.Wai hiding (Middleware, Application)
import qualified Network.Wai as Wai
import Network.Wai.Handler.Warp (Settings, defaultSettings)
import Network.Wai.Parse (FileInfo)
import Prelude ()
import Prelude.Compat
--------------------- Options -----------------------
data Options = Options { verbose :: Int -- ^ 0 = silent, 1(def) = startup banner
, settings :: Settings -- ^ Warp 'Settings'
-- Note: to work around an issue in warp,
-- the default FD cache duration is set to 0
-- so changes to static files are always picked
-- up. This likely has performance implications,
-- so you may want to modify this for production
-- servers using `setFdCacheDuration`.
}
instance Default Options where
def = Options 1 defaultSettings
----- Transformer Aware Applications/Middleware -----
type Middleware m = Application m -> Application m
type Application m = Request -> m Response
--------------- Scotty Applications -----------------
data ScottyState e m =
ScottyState { middlewares :: [Wai.Middleware]
, routes :: [Middleware m]
, handler :: ErrorHandler e m
}
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 :: 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 :: State (ScottyState e m) a }
deriving ( Functor, Applicative, Monad )
------------------ Scotty Errors --------------------
data ActionError e
= Redirect Text
| Next
| Finish
| ActionError Status e
-- | In order to use a custom exception type (aside from 'Text'), you must
-- define an instance of 'ScottyError' for that type.
class ScottyError e where
stringError :: String -> e
showError :: e -> Text
instance ScottyError Text where
stringError = pack
showError = id
instance ScottyError e => ScottyError (ActionError e) where
stringError = ActionError status500 . 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 ())
------------------ Scotty Actions -------------------
type Param = (Text, Text)
type File = (Text, FileInfo ByteString)
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
data ScottyResponse = SR { srStatus :: Status
, srHeaders :: ResponseHeaders
, srContent :: Content
}
instance Default ScottyResponse where
def = SR status200 [] (ContentBuilder mempty)
newtype ActionT e m a = ActionT { runAM :: ExceptT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a }
deriving ( Functor, Applicative, MonadIO )
instance (Monad m, ScottyError e) => Monad (ActionT e m) where
return = ActionT . return
ActionT m >>= k = ActionT (m >>= runAM . k)
#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
#endif
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
#endif
) => 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 MonadTrans (ActionT e) where
lift = ActionT . lift . lift . lift
instance (ScottyError e, Monad m) => MonadError (ActionError e) (ActionT e m) where
throwError = ActionT . throwError
catchError (ActionT m) f = ActionT (catchError m (runAM . f))
instance (MonadBase b m, ScottyError e) => MonadBase b (ActionT e m) where
liftBase = liftBaseDefault
instance (MonadThrow m, ScottyError e) => MonadThrow (ActionT e m) where
throwM = ActionT . throwM
instance (MonadCatch m, ScottyError e) => MonadCatch (ActionT e m) where
catch (ActionT m) f = ActionT (m `catch` (runAM . f))
instance MonadTransControl (ActionT e) where
type StT (ActionT e) a = StT (StateT ScottyResponse) (StT (ReaderT ActionEnv) (StT (ExceptT (ActionError e)) a))
liftWith = \f ->
ActionT $ liftWith $ \run ->
liftWith $ \run' ->
liftWith $ \run'' ->
f $ run'' . run' . run . runAM
restoreT = ActionT . restoreT . restoreT . restoreT
instance (ScottyError e, MonadBaseControl b m) => MonadBaseControl b (ActionT e m) where
type StM (ActionT e m) a = ComposeSt (ActionT e) m a
liftBaseWith = defaultLiftBaseWith
restoreM = defaultRestoreM
instance (MonadReader r m, ScottyError e) => MonadReader r (ActionT e m) where
{-# INLINE ask #-}
ask = lift ask
{-# INLINE local #-}
local f = ActionT . mapExceptT (mapReaderT (mapStateT $ local f)) . runAM
instance (MonadState s m, ScottyError e) => MonadState s (ActionT e m) where
{-# INLINE get #-}
get = lift get
{-# INLINE put #-}
put = lift . put
instance (Semigroup a) => Semigroup (ScottyT e m a) where
x <> y = (<>) <$> x <*> y
instance
( Monoid a
#if !(MIN_VERSION_base(4,11,0))
, Semigroup a
#endif
#if !(MIN_VERSION_base(4,8,0))
, Functor m
#endif
) => Monoid (ScottyT e m a) where
mempty = return mempty
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
instance
( Monad m
#if !(MIN_VERSION_base(4,8,0))
, Functor m
#endif
, Semigroup a
) => Semigroup (ActionT e m a) where
x <> y = (<>) <$> x <*> y
instance
( Monad m, ScottyError e, Monoid a
#if !(MIN_VERSION_base(4,11,0))
, Semigroup a
#endif
#if !(MIN_VERSION_base(4,8,0))
, Functor m
#endif
) => Monoid (ActionT e m a) where
mempty = return mempty
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
------------------ Scotty Routes --------------------
data RoutePattern = Capture Text
| Literal Text
| Function (Request -> Maybe [Param])
instance IsString RoutePattern where
fromString = Capture . pack
scotty-0.12/Web/Scotty/Route.hs 0000644 0000000 0000000 00000024471 07346545000 014616 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances,
OverloadedStrings, RankNTypes, ScopedTypeVariables #-}
module Web.Scotty.Route
( get, post, put, delete, patch, options, addroute, matchAny, notFound,
capture, regex, function, literal
) where
import Control.Arrow ((***))
import Control.Concurrent.MVar
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, isJust)
import Data.String (fromString)
import qualified Data.Text.Lazy as T
import qualified Data.Text as TS
import Network.HTTP.Types
import Network.Wai (Request(..))
#if MIN_VERSION_wai(3,2,2)
import Network.Wai.Internal (getRequestBodyChunk)
#endif
import qualified Network.Wai.Parse as Parse hiding (parseRequestBody)
import Prelude ()
import Prelude.Compat
import qualified Text.Regex as Regex
import Web.Scotty.Action
import Web.Scotty.Internal.Types
import Web.Scotty.Util
-- | get = 'addroute' 'GET'
get :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
get = addroute GET
-- | post = 'addroute' 'POST'
post :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
post = addroute POST
-- | put = 'addroute' 'PUT'
put :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
put = addroute PUT
-- | delete = 'addroute' 'DELETE'
delete :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
delete = addroute DELETE
-- | patch = 'addroute' 'PATCH'
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 = ScottyT $ MS.modify $ \s -> addRoute (route (handler s) Nothing pattern action) s
-- | Specify an action to take if nothing else is found. Note: this _always_ matches,
-- so should generally be the last route specified.
notFound :: (ScottyError e, MonadIO m) => ActionT e m () -> ScottyT e m ()
notFound action = matchAny (Function (\req -> Just [("path", path req)])) (status status404 >> action)
-- | Define a route with a 'StdMethod', 'T.Text' value representing the path spec,
-- and a body ('Action') which modifies the response.
--
-- > addroute GET "/" $ text "beam me up!"
--
-- The path spec can include values starting with a colon, which are interpreted
-- as /captures/. These are named wildcards that can be looked up with 'param'.
--
-- > addroute GET "/foo/:bar" $ do
-- > v <- param "bar"
-- > text v
--
-- >>> curl http://localhost:3000/foo/something
-- something
addroute :: (ScottyError e, MonadIO m) => StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute method pat action = ScottyT $ MS.modify $ \s -> addRoute (route (handler s) (Just method) pat action) s
route :: (ScottyError e, MonadIO m) => ErrorHandler e m -> Maybe StdMethod -> RoutePattern -> ActionT e m () -> Middleware m
route h method pat action app req =
let tryNext = app req
{- |
We match all methods in the case where 'method' is 'Nothing'.
See https://github.com/scotty-web/scotty/issues/196
-}
methodMatches :: Bool
methodMatches =
case method of
Nothing -> True
Just m -> Right m == parseMethod (requestMethod req)
in if methodMatches
then case matchRoute pat req of
Just captures -> do
env <- mkEnv req captures
res <- runAction h env action
maybe tryNext return res
Nothing -> tryNext
else tryNext
matchRoute :: RoutePattern -> Request -> Maybe [Param]
matchRoute (Literal pat) req | pat == path req = Just []
| otherwise = Nothing
matchRoute (Function fun) req = fun req
matchRoute (Capture pat) req = go (T.split (=='/') pat) (compress $ T.split (=='/') $ path req) []
where go [] [] prs = Just prs -- request string and pattern match!
go [] r prs | T.null (mconcat r) = Just prs -- in case request has trailing slashes
| otherwise = Nothing -- request string is longer than pattern
go p [] prs | T.null (mconcat p) = Just prs -- in case pattern has trailing slashes
| otherwise = Nothing -- request string is not long enough
go (p:ps) (r:rs) prs | p == r = go ps rs prs -- equal literals, keeping checking
| T.null p = Nothing -- p is null, but r is not, fail
| T.head p == ':' = go ps rs $ (T.tail p, r) : prs -- p is a capture, add to params
| otherwise = Nothing -- both literals, but unequal, fail
compress ("":rest@("":_)) = compress rest
compress (x:xs) = x : compress xs
compress [] = []
-- Pretend we are at the top level.
path :: Request -> T.Text
path = T.fromStrict . TS.cons '/' . TS.intercalate "/" . pathInfo
-- Stolen from wai-extra's Network.Wai.Parse, modified to accept body as list of Bytestrings.
-- Reason: WAI's getRequestBodyChunk is an IO action that returns the body as chunks.
-- Once read, they can't be read again. We read them into a lazy Bytestring, so Scotty
-- user can get the raw body, even if they also want to call wai-extra's parsing routines.
parseRequestBody :: MonadIO m
=> [B.ByteString]
-> Parse.BackEnd y
-> Request
-> m ([Parse.Param], [Parse.File y])
parseRequestBody bl s r =
case Parse.getRequestBodyType r of
Nothing -> return ([], [])
Just rbt -> do
mvar <- liftIO $ newMVar bl -- MVar is a bit of a hack so we don't have to inline
-- large portions of Network.Wai.Parse
let provider = modifyMVar mvar $ \bsold -> case bsold of
[] -> return ([], B.empty)
(b:bs) -> return (bs, b)
liftIO $ Parse.sinkRequestBody s rbt provider
mkEnv :: forall m. MonadIO m => Request -> [Param] -> m ActionEnv
mkEnv req captures = do
bodyState <- liftIO $ newMVar BodyUntouched
let rbody = getRequestBodyChunk req
takeAll :: ([B.ByteString] -> IO [B.ByteString]) -> IO [B.ByteString]
takeAll prefix = rbody >>= \b -> if B.null b then prefix [] else takeAll (prefix . (b:))
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
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 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
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 ]
-- | Match requests using a regular expression.
-- Named captures are not yet supported.
--
-- > get (regex "^/f(.*)r$") $ do
-- > path <- param "0"
-- > cap <- param "1"
-- > text $ mconcat ["Path: ", path, "\nCapture: ", cap]
--
-- >>> curl http://localhost:3000/foo/bar
-- Path: /foo/bar
-- Capture: oo/ba
--
regex :: String -> RoutePattern
regex pattern = Function $ \ req -> fmap (map (T.pack . show *** T.pack) . zip [0 :: Int ..] . strip)
(Regex.matchRegexAll rgx $ T.unpack $ path req)
where rgx = Regex.mkRegex pattern
strip (_, match, _, subs) = match : subs
-- | Standard Sinatra-style route. Named captures are prepended with colons.
-- This is the default route type generated by OverloadedString routes. i.e.
--
-- > get (capture "/foo/:bar") $ ...
--
-- and
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > ...
-- > get "/foo/:bar" $ ...
--
-- are equivalent.
capture :: String -> RoutePattern
capture = fromString
-- | Build a route based on a function which can match using the entire 'Request' object.
-- 'Nothing' indicates the route does not match. A 'Just' value indicates
-- a successful match, optionally returning a list of key-value pairs accessible
-- by 'param'.
--
-- > get (function $ \req -> Just [("version", T.pack $ show $ httpVersion req)]) $ do
-- > v <- param "version"
-- > text v
--
-- >>> curl http://localhost:3000/
-- HTTP/1.1
--
function :: (Request -> Maybe [Param]) -> RoutePattern
function = Function
-- | Build a route that requires the requested path match exactly, without captures.
literal :: String -> RoutePattern
literal = Literal . T.pack
#if !(MIN_VERSION_wai(3,2,2))
getRequestBodyChunk :: Request -> IO B.ByteString
getRequestBodyChunk = requestBody
#endif
scotty-0.12/Web/Scotty/Trans.hs 0000644 0000000 0000000 00000013062 07346545000 014601 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings, RankNTypes #-}
-- | It should be noted that most of the code snippets below depend on the
-- OverloadedStrings language pragma.
--
-- The functions in this module allow an arbitrary monad to be embedded
-- in Scotty's monad transformer stack in order that Scotty be combined
-- with other DSLs.
--
-- Scotty is set up by default for development mode. For production servers,
-- you will likely want to modify 'settings' and the 'defaultHandler'. See
-- the comments on each of these functions for more information.
module Web.Scotty.Trans
( -- * scotty-to-WAI
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, options, addroute, matchAny, notFound
-- ** Route Patterns
, capture, regex, function, literal
-- ** Accessing the Request, Captures, and Query Parameters
, request, header, headers, body, bodyReader, param, params, jsonData, files
-- ** Modifying the Response and Redirecting
, status, addHeader, setHeader, redirect
-- ** Setting Response Body
--
-- | Note: only one of these should be present in any given route
-- definition, as they completely replace the current 'Response' body.
, text, html, file, json, stream, raw
-- ** Exceptions
, raise, raiseStatus, rescue, next, finish, defaultHandler, ScottyError(..), liftAndCatchIO
-- * Parsing Parameters
, Param, Parsable(..), readEither
-- * Types
, RoutePattern, File
-- * Monad Transformers
, ScottyT, ActionT
) where
import Blaze.ByteString.Builder (fromByteString)
import Control.Monad (when)
import Control.Monad.State.Strict (execState, modify)
import Control.Monad.IO.Class
import Data.Default.Class (def)
import Network.HTTP.Types (status404, status500)
import Network.Socket (Socket)
import Network.Wai
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
scottyT :: (Monad m, MonadIO n)
=> Port
-> (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
scottyOptsT :: (Monad m, MonadIO n)
=> Options
-> (m Response -> IO Response) -- ^ Run monad 'm' into 'IO', called at each action.
-> ScottyT e m ()
-> n ()
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 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
scottyAppT :: (Monad m, Monad n)
=> (m Response -> IO Response) -- ^ Run monad 'm' into 'IO', called at each action.
-> ScottyT e m ()
-> n Application
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)
notFoundApp :: Monad m => Scotty.Application m
notFoundApp _ = return $ responseBuilder status404 [("Content-Type","text/html")]
$ fromByteString "404: File Not Found!
"
-- | Global handler for uncaught exceptions.
--
-- Uncaught exceptions normally become 500 responses.
-- You can use this to selectively override that behavior.
--
-- Note: IO exceptions are lifted into 'ScottyError's by 'stringError'.
-- This has security implications, so you probably want to provide your
-- own defaultHandler in production which does not send out the error
-- strings as 500 responses.
defaultHandler :: (ScottyError e, Monad m) => (e -> ActionT e m ()) -> ScottyT e m ()
defaultHandler f = ScottyT $ modify $ addHandler $ Just (\e -> status status500 >> f e)
-- | Use given middleware. Middleware is nested such that the first declared
-- is the outermost middleware (it has first dibs on the request and last action
-- on the response). Every middleware is run on each request.
middleware :: Middleware -> ScottyT e m ()
middleware = ScottyT . modify . addMiddleware
scotty-0.12/Web/Scotty/Util.hs 0000644 0000000 0000000 00000004602 07346545000 014427 0 ustar 00 0000000 0000000 module Web.Scotty.Util
( lazyTextToStrictByteString
, strictByteStringToLazyText
, setContent
, setHeaderWith
, setStatus
, mkResponse
, replace
, add
, addIfNotPresent
, socketDescription
) where
import Network.Socket (SockAddr(..), Socket, getSocketName, socketPort)
import Network.Wai
import Network.HTTP.Types
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
lazyTextToStrictByteString :: T.Text -> B.ByteString
lazyTextToStrictByteString = ES.encodeUtf8 . T.toStrict
strictByteStringToLazyText :: B.ByteString -> T.Text
strictByteStringToLazyText = T.fromStrict . ES.decodeUtf8With ES.lenientDecode
setContent :: Content -> ScottyResponse -> ScottyResponse
setContent c sr = sr { srContent = c }
setHeaderWith :: ([(HeaderName, B.ByteString)] -> [(HeaderName, B.ByteString)]) -> ScottyResponse -> ScottyResponse
setHeaderWith f sr = sr { srHeaders = f (srHeaders sr) }
setStatus :: Status -> ScottyResponse -> ScottyResponse
setStatus s sr = sr { srStatus = s }
-- Note: we currently don't support responseRaw, which may be useful
-- for websockets. However, we always read the request body, which
-- is incompatible with responseRaw responses.
mkResponse :: ScottyResponse -> Response
mkResponse sr = case srContent sr of
ContentBuilder b -> responseBuilder s h b
ContentFile f -> responseFile s h f Nothing
ContentStream str -> responseStream s h str
where s = srStatus sr
h = srHeaders sr
-- Note: we assume headers are not sensitive to order here (RFC 2616 specifies they are not)
replace :: Eq a => a -> b -> [(a,b)] -> [(a,b)]
replace k v = add k v . filter ((/= k) . fst)
add :: a -> b -> [(a,b)] -> [(a,b)]
add k v m = (k,v):m
addIfNotPresent :: Eq a => a -> b -> [(a,b)] -> [(a,b)]
addIfNotPresent k v = go
where go [] = [(k,v)]
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 sock = do
sockName <- getSocketName sock
case sockName of
SockAddrUnix u -> return $ "unix socket " ++ u
_ -> fmap (\port -> "port " ++ show port) $ socketPort sock
scotty-0.12/bench/ 0000755 0000000 0000000 00000000000 07346545000 012231 5 ustar 00 0000000 0000000 scotty-0.12/bench/Main.hs 0000644 0000000 0000000 00000002531 07346545000 013452 0 ustar 00 0000000 0000000 {-# language
OverloadedStrings
, GeneralizedNewtypeDeriving
#-}
module Main (main) where
import Control.Monad
import Data.Default.Class (def)
import Data.Functor.Identity
import Data.Text (Text)
import Lucid.Base
import Lucid.Html5
import Web.Scotty
import Web.Scotty.Internal.Types
import qualified Control.Monad.State.Lazy as SL
import qualified Control.Monad.State.Strict as SS
import qualified Data.ByteString.Lazy as BL
import Weigh
main :: IO ()
main = do
mainWith $ do
setColumns [Case,Allocated,GCs,Live,Check,Max,MaxOS]
setFormat Markdown
io "ScottyM Strict" BL.putStr
(SS.evalState (runS $ renderBST htmlScotty) def)
io "ScottyM Lazy" BL.putStr
(SL.evalState (runScottyLazy $ renderBST htmlScottyLazy) def)
io "Identity" BL.putStr
(runIdentity $ renderBST htmlIdentity)
htmlTest :: Monad m => HtmlT m ()
htmlTest = replicateM_ 2 $ div_ $ do
replicateM_ 1000 $ div_ $ do
replicateM_ 10000 $ div_ "test"
htmlIdentity :: HtmlT Identity ()
htmlIdentity = htmlTest
{-# noinline htmlIdentity #-}
htmlScotty :: HtmlT ScottyM ()
htmlScotty = htmlTest
{-# noinline htmlScotty #-}
htmlScottyLazy :: HtmlT ScottyLazy ()
htmlScottyLazy = htmlTest
{-# noinline htmlScottyLazy #-}
newtype ScottyLazy a = ScottyLazy
{ runScottyLazy:: SL.State (ScottyState Text IO) a }
deriving (Functor,Applicative,Monad)
scotty-0.12/changelog.md 0000755 0000000 0000000 00000014657 07346545000 013443 0 ustar 00 0000000 0000000 ## 0.12 [2020.05.16]
* Provide `MonadReader` and `MonadState` instances for `ActionT`.
* Add HTTP Status code as a field to `ActionError`, and add
a sister function to `raise`, `raiseStatus`. This makes
throwing a specific error code and exiting much cleaner, and
avoids the strange defaulting to HTTP 500. This will make internal
functions easier to implement with the right status codes 'thrown',
such as `jsonData`.
* Correct http statuses returned by `jsonData` (#228).
* Better error message when no data is provided to `jsonData` (#226).
* Add `Semigroup` and `Monoid` instances for `ActionT` and `ScottyT`
* ScottyT: Use strict StateT instead of lazy
* Handle adjacent slashes in the request path as one (thanks @SkyWriter)
## 0.11.5 [2019.09.07]
* Allow building the test suite with `hspec-wai-0.10`.
## 0.11.4 [2019.05.02]
* Allow building with `base-4.13` (GHC 8.8).
## 0.11.3 [2019.01.08]
* Drop the test suite's dependency on `hpc-coveralls`, which is unmaintained
and does not build with GHC 8.4 or later.
## 0.11.2 [2018.07.02]
* Migrate from `Network` to `Network.Socket` to avoid deprecation warnings.
## 0.11.1 [2018.04.07]
* Add `MonadThrow` and `MonadCatch` instances for `ActionT` [abhinav]
* Fix `matchAny` so that all methods are matched, not just standard ones
[taphu]
## 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
## 0.10.1
* `Parsable` instances for `Word`, `Word8`, `Word16`, `Word32`, `Word64`
[adamflott]
* `Parsable` instances for `Int8`, `Int16`, `Int32`, `Int64`, and `Natural`
* Removed redundant `Monad` constraint on `middleware`
## 0.10.0
* 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]
* `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]
* `Alternative`, `MonadPlus` instances for `ActionT`
* `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
* Add `charset=utf-8` to `Content-Type` for `text`, `html` and `json`
* Assume HTTP status 500 for `defaultHandler`
* Remove deprecated `source` method.
* No longer depend on conduit.
## 0.8.2
* Bump `aeson` upper bound
* Fix `mtl` related deprecation warnings
## 0.8.1
* Export internal types
* Added `MonadBase`, `MonadTransControl` and `MonadBaseControl` instances for
`ActionT`
## 0.8.0
* Upgrade to wai/wai-extra/warp 3.0
* No longer depend on conduit-extra.
* The `source` response method has been deprecated in favor
of a new `stream` response, matching changes in WAI 3.0.
* Removed the deprecated `reqHeader` function.
## 0.7.3
* Bump upper bound for case-insensitive, mtl and transformers.
## 0.7.2
* Bump lower bound on conduit, add conduit-extra to cabal build depends.
## 0.7.1
* Default warp settings now use `setFdCacheDuration 0` to work around a warp
issue where file changes are not getting picked up.
## 0.7.0
* Renamed `reqHeader` to `header`. Added `headers` function to get all headers.
* Changed `MonadIO` instance for `ActionT` such that IO exceptions are lifted
into `ScottyError`s via `stringError`.
* Make `Bool` parsing case-insensitive. Goal: support both Haskell's True/False
and Javascript's true/false. Thanks to Ben Gamari for suggesting this.
* Bump `aeson`/`text` upper bounds.
* Bump `wai`/`wai-extra`/`warp` bounds, including new lower bound for `warp`, which fixes a security issue related to Slowloris protection.
## 0.6.2
* Bump upper bound for `text`.
## 0.6.1
* Match changes in `wai-extra`.
## 0.6.0
* The Scotty transformers (`ScottyT` and `ActionT`) are now parameterized
over a custom exception type, allowing one to extend Scotty's `ErrorT`
layer with something richer than `Text` errors. See the `exceptions`
example for use. `ScottyM` and `ActionM` remain specialized to `Text`
exceptions for simplicity.
* Both monads are now instances of `Functor` and `Applicative`.
* There is a new `cookies` example.
* Internals brought up-to-date with WAI 2.0 and related packages.
## 0.5.0
* The Scotty monads (`ScottyM` and `ActionM`) are now monad transformers,
allowing Scotty applications to be embedded in arbitrary `MonadIO`s.
The old API continues to be exported from `Web.Scotty` where:
type ScottyM = ScottyT IO
type ActionM = ActionT IO
The new transformers are found in `Web.Scotty.Trans`. See the
`globalstate` example for use. Special thanks to Dan Frumin (co-dan)
for much of the legwork here.
* Added support for HTTP PATCH method.
* Removed lambda action syntax. This will return when we have a better
story for typesafe routes.
* `reqHeader :: Text -> ActionM Text` ==>
`reqHeader :: Text -> ActionM (Maybe Text)`
* New `raw` method to set body to a raw `ByteString`
* Parse error thrown by `jsonData` now includes the body it couldn't parse.
* `header` split into `setHeader` and `addHeader`. The former replaces
a response header (original behavior). The latter adds a header (useful
for multiple `Set-Cookie`s, for instance).
scotty-0.12/examples/ 0000755 0000000 0000000 00000000000 07346545000 012770 5 ustar 00 0000000 0000000 scotty-0.12/examples/404.html 0000755 0000000 0000000 00000000035 07346545000 014166 0 ustar 00 0000000 0000000 This is a 404 page!
scotty-0.12/examples/LICENSE 0000755 0000000 0000000 00000002767 07346545000 014014 0 ustar 00 0000000 0000000 Copyright (c) 2012-2017 Andrew Farmer
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Andrew Farmer nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
scotty-0.12/examples/basic.hs 0000755 0000000 0000000 00000006576 07346545000 014426 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Web.Scotty
import Network.Wai.Middleware.RequestLogger -- install wai-extra if you don't have this
import Control.Monad
import Control.Monad.Trans
import System.Random (newStdGen, randomRs)
import Network.HTTP.Types (status302)
import Data.Text.Lazy.Encoding (decodeUtf8)
import Data.String (fromString)
import Prelude ()
import Prelude.Compat
main :: IO ()
main = scotty 3000 $ do
-- Add any WAI middleware, they are run top-down.
middleware logStdoutDev
-- get (function $ \req -> Just [("version", T.pack $ show $ httpVersion req)]) $ do
-- v <- param "version"
-- text v
-- To demonstrate that routes are matched top-down.
get "/" $ text "foobar"
get "/" $ text "barfoo"
-- Using a parameter in the query string. If it has
-- not been given, a 500 page is generated.
get "/foo" $ do
v <- param "fooparam"
html $ mconcat ["", v, "
"]
-- An uncaught error becomes a 500 page.
get "/raise" $ raise "some error here"
-- You can set status and headers directly.
get "/redirect-custom" $ do
status status302
setHeader "Location" "http://www.google.com"
-- note first arg to header is NOT case-sensitive
-- redirects preempt execution
get "/redirect" $ do
void $ redirect "http://www.google.com"
raise "this error is never reached"
-- Of course you can catch your own errors.
get "/rescue" $ do
(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
-- any string, and capture that value as a parameter.
-- URL captures take precedence over query string parameters.
get "/foo/:bar/required" $ do
v <- param "bar"
html $ mconcat ["", v, "
"]
-- Files are streamed directly to the client.
get "/404" $ file "404.html"
-- You can stop execution of this action and keep pattern matching routes.
get "/random" $ do
void next
redirect "http://www.we-never-go-here.com"
-- You can do IO with liftIO, and you can return JSON content.
get "/random" $ do
g <- liftIO newStdGen
json $ take 20 $ randomRs (1::Int,100) g
get "/ints/:is" $ do
is <- param "is"
json $ [(1::Int)..10] ++ is
get "/setbody" $ do
html $ mconcat [""
]
post "/readbody" $ do
b <- body
text $ decodeUtf8 b
get "/header" $ do
agent <- header "User-Agent"
maybe (raise "User-Agent header not found!") text agent
-- Make a request to this URI, then type a line in the terminal, which
-- will be the response. Using ctrl-c will cause getLine to fail.
-- This demonstrates that IO exceptions are lifted into ActionM exceptions.
get "/iofail" $ do
msg <- liftIO $ liftM fromString getLine
text msg
{- If you don't want to use Warp as your webserver,
you can use any WAI handler.
import Network.Wai.Handler.FastCGI (run)
main = do
myApp <- scottyApp $ do
get "/" $ text "hello world"
run myApp
-}
scotty-0.12/examples/bodyecho.hs 0000755 0000000 0000000 00000002212 07346545000 015120 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Web.Scotty
import Control.Monad.IO.Class (liftIO)
import qualified Blaze.ByteString.Builder as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text.Lazy as T
main :: IO ()
main = scotty 3000 $ do
post "/echo" $ do
rd <- bodyReader
stream $ ioCopy rd $ return ()
post "/count" $ do
wb <- body -- this must happen before first 'rd'
rd <- bodyReader
let step acc = do
chunk <- rd
putStrLn "got a chunk"
let len = BS.length chunk
if len > 0
then step $ acc + len
else return acc
len <- liftIO $ step 0
text $ T.pack $ "uploaded " ++ show len ++ " bytes, wb len is " ++ show (BSL.length wb)
ioCopy :: IO BS.ByteString -> IO () -> (B.Builder -> IO ()) -> IO () -> IO ()
ioCopy reader close write flush = step >> flush where
step = do chunk <- reader
if (BS.length chunk > 0)
then (write $ B.insertByteString chunk) >> step
else close
scotty-0.12/examples/cookies.hs 0000755 0000000 0000000 00000003765 07346545000 014776 0 ustar 00 0000000 0000000 {-# 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.Encoding as T
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Blaze.ByteString.Builder as B
import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Web.Scotty
import Web.Cookie
makeCookie :: BS.ByteString -> BS.ByteString -> SetCookie
makeCookie n v = def { setCookieName = n, setCookieValue = v }
renderSetCookie' :: SetCookie -> Text
renderSetCookie' = T.decodeUtf8 . B.toLazyByteString . renderSetCookie
setCookie :: BS.ByteString -> BS.ByteString -> ActionM ()
setCookie n v = setHeader "Set-Cookie" (renderSetCookie' (makeCookie n v))
getCookies :: ActionM (Maybe CookiesText)
getCookies =
fmap (fmap (parseCookiesText . lazyToStrict . T.encodeUtf8)) $
header "Cookie"
where
lazyToStrict = BS.concat . BSL.toChunks
renderCookiesTable :: CookiesText -> H.Html
renderCookiesTable cs =
H.table $ do
H.tr $ do
H.th "name"
H.th "value"
forM_ cs $ \(name', val) -> do
H.tr $ do
H.td (H.toMarkup name')
H.td (H.toMarkup val)
main :: IO ()
main = scotty 3000 $ do
get "/" $ do
cookies <- getCookies
html $ renderHtml $ do
case cookies of
Just cs -> renderCookiesTable cs
Nothing -> return ()
H.form H.! method "post" H.! action "/set-a-cookie" $ do
H.input H.! type_ "text" H.! name "name"
H.input H.! type_ "text" H.! name "value"
H.input H.! type_ "submit" H.! value "set a cookie"
post "/set-a-cookie" $ do
name' <- param "name"
value' <- param "value"
setCookie name' value'
redirect "/"
scotty-0.12/examples/exceptions.hs 0000755 0000000 0000000 00000004072 07346545000 015513 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
module Main (main) where
import Control.Monad.IO.Class
import Data.String (fromString)
import Network.HTTP.Types
import Network.Wai.Middleware.RequestLogger
import Prelude ()
import Prelude.Compat
import System.Random
import Web.Scotty.Trans
-- Define a custom exception type.
data Except = Forbidden | NotFound Int | StringEx String
deriving (Show, Eq)
-- The type must be an instance of 'ScottyError'.
-- 'ScottyError' is essentially a combination of 'Error' and 'Show'.
instance ScottyError Except where
stringError = StringEx
showError = fromString . show
-- Handler for uncaught exceptions.
handleEx :: Monad m => Except -> ActionT Except m ()
handleEx Forbidden = do
status status403
html "Scotty Says No
"
handleEx (NotFound i) = do
status status404
html $ fromString $ "Can't find " ++ show i ++ ".
"
handleEx (StringEx s) = do
status status500
html $ fromString $ "" ++ s ++ "
"
main :: IO ()
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
get "/" $ do
html $ mconcat ["Option 1 (Not Found)"
,"
"
,"Option 2 (Forbidden)"
,"
"
,"Option 3 (Random)"
]
get "/switch/:val" $ do
v <- param "val"
_ <- if even v then raise Forbidden else raise (NotFound v)
text "this will never be reached"
get "/random" $ do
rBool <- liftIO randomIO
i <- liftIO randomIO
let catchOne Forbidden = html "Forbidden was randomly thrown, but we caught it."
catchOne other = raise other
raise (if rBool then Forbidden else NotFound i) `rescue` catchOne
scotty-0.12/examples/globalstate.hs 0000755 0000000 0000000 00000005224 07346545000 015633 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}
-- An example of embedding a custom monad into
-- Scotty's transformer stack, using ReaderT to provide access
-- to a TVar containing global state.
--
-- Note: this example is somewhat simple, as our top level
-- 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 (main) where
import Control.Concurrent.STM
import Control.Monad.Reader
import Data.Default.Class
import Data.String
import Data.Text.Lazy (Text)
import Network.Wai.Middleware.RequestLogger
import Prelude ()
import Prelude.Compat
import Web.Scotty.Trans
newtype AppState = AppState { tickCount :: Int }
instance Default AppState where
def = AppState 0
-- Why 'ReaderT (TVar AppState)' rather than 'StateT AppState'?
-- With a state transformer, 'runActionToIO' (below) would have
-- to provide the state to _every action_, and save the resulting
-- state, using an MVar. This means actions would be blocking,
-- effectively meaning only one request could be serviced at a time.
-- The 'ReaderT' solution means only actions that actually modify
-- the state need to block/retry.
--
-- 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 (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
-- about when we are operating at the 'WebM' layer.
webM :: MonadTrans t => WebM a -> t WebM a
webM = lift
-- Some helpers to make this feel more like a state monad.
gets :: (AppState -> b) -> WebM b
gets f = ask >>= liftIO . readTVarIO >>= return . f
modify :: (AppState -> AppState) -> WebM ()
modify f = ask >>= liftIO . atomically . flip modifyTVar' f
main :: IO ()
main = do
sync <- newTVarIO def
-- 'runActionToIO' is called once per action.
let runActionToIO m = runReaderT (runWebM m) sync
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
-- annotation just about anywhere. In this case, we'll
-- just do it on the entire app.
app :: ScottyT Text WebM ()
app = do
middleware logStdoutDev
get "/" $ do
c <- webM $ gets tickCount
text $ fromString $ show c
get "/plusone" $ do
webM $ modify $ \ st -> st { tickCount = tickCount st + 1 }
redirect "/"
get "/plustwo" $ do
webM $ modify $ \ st -> st { tickCount = tickCount st + 2 }
redirect "/"
scotty-0.12/examples/gzip.hs 0000755 0000000 0000000 00000001066 07346545000 014303 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Network.Wai.Middleware.RequestLogger
import Network.Wai.Middleware.Gzip
import Web.Scotty
main :: IO ()
main = scotty 3000 $ do
-- Note that files are not gzip'd by the default settings.
middleware $ gzip $ def { gzipFiles = GzipCompress }
middleware logStdoutDev
-- gzip a normal response
get "/" $ text "It works"
-- gzip a file response (note non-default gzip settings above)
get "/afile" $ do
setHeader "content-type" "text/plain"
file "gzip.hs"
scotty-0.12/examples/options.hs 0000755 0000000 0000000 00000001060 07346545000 015017 0 ustar 00 0000000 0000000 {-# 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.Class (def)
import Network.Wai.Handler.Warp (setPort)
-- Set some Scotty settings
opts :: Options
opts = def { verbose = 0
, settings = setPort 4000 $ settings def
}
-- This won't display anything at startup, and will listen on localhost:4000
main :: IO ()
main = scottyOpts opts $ do
middleware logStdoutDev
get "/" $ text "hello world"
scotty-0.12/examples/reader.hs 0000755 0000000 0000000 00000002026 07346545000 014571 0 ustar 00 0000000 0000000 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-
An example of embedding a custom monad into Scotty's transformer
stack, using ReaderT to provide access to a global state.
-}
module Main where
import Control.Monad.Reader (MonadIO, MonadReader, ReaderT, asks, lift, runReaderT)
import Data.Default.Class (def)
import Data.Text.Lazy (Text, pack)
import Prelude ()
import Prelude.Compat
import Web.Scotty.Trans (ScottyT, get, scottyOptsT, text)
data Config = Config
{ environment :: String
} deriving (Eq, Read, Show)
newtype ConfigM a = ConfigM
{ runConfigM :: ReaderT Config IO a
} deriving (Applicative, Functor, Monad, MonadIO, MonadReader Config)
application :: ScottyT Text ConfigM ()
application = do
get "/" $ do
e <- lift $ asks environment
text $ pack $ show e
main :: IO ()
main = scottyOptsT def runIO application where
runIO :: ConfigM a -> IO a
runIO m = runReaderT (runConfigM m) config
config :: Config
config = Config
{ environment = "Development"
}
scotty-0.12/examples/static/ 0000755 0000000 0000000 00000000000 07346545000 014257 5 ustar 00 0000000 0000000 scotty-0.12/examples/static/jquery-json.js 0000755 0000000 0000000 00000004201 07346545000 017103 0 ustar 00 0000000 0000000
(function($){var escapeable=/["\\\x00-\x1f\x7f-\x9f]/g,meta={'\b':'\\b','\t':'\\t','\n':'\\n','\f':'\\f','\r':'\\r','"':'\\"','\\':'\\\\'};$.toJSON=typeof JSON==='object'&&JSON.stringify?JSON.stringify:function(o){if(o===null){return'null';}
var type=typeof o;if(type==='undefined'){return undefined;}
if(type==='number'||type==='boolean'){return''+o;}
if(type==='string'){return $.quoteString(o);}
if(type==='object'){if(typeof o.toJSON==='function'){return $.toJSON(o.toJSON());}
if(o.constructor===Date){var month=o.getUTCMonth()+1,day=o.getUTCDate(),year=o.getUTCFullYear(),hours=o.getUTCHours(),minutes=o.getUTCMinutes(),seconds=o.getUTCSeconds(),milli=o.getUTCMilliseconds();if(month<10){month='0'+month;}
if(day<10){day='0'+day;}
if(hours<10){hours='0'+hours;}
if(minutes<10){minutes='0'+minutes;}
if(seconds<10){seconds='0'+seconds;}
if(milli<100){milli='0'+milli;}
if(milli<10){milli='0'+milli;}
return'"'+year+'-'+month+'-'+day+'T'+
hours+':'+minutes+':'+seconds+'.'+milli+'Z"';}
if(o.constructor===Array){var ret=[];for(var i=0;i