{-# 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 :: RoutePattern -> ActionT e m () -> ScottyT e m ()
get = StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
GET

-- | post = 'addroute' 'POST'
post :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
post :: RoutePattern -> ActionT e m () -> ScottyT e m ()
post = StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
POST

-- | put = 'addroute' 'PUT'
put :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
put :: RoutePattern -> ActionT e m () -> ScottyT e m ()
put = StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
PUT

-- | delete = 'addroute' 'DELETE'
delete :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
delete :: RoutePattern -> ActionT e m () -> ScottyT e m ()
delete = StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
DELETE

-- | patch = 'addroute' 'PATCH'
patch :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
patch :: RoutePattern -> ActionT e m () -> ScottyT e m ()
patch = StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
PATCH

-- | options = 'addroute' 'OPTIONS'
options :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
options :: RoutePattern -> ActionT e m () -> ScottyT e m ()
options = StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute StdMethod
OPTIONS

-- | Add a route that matches regardless of the HTTP verb.
matchAny :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
matchAny :: RoutePattern -> ActionT e m () -> ScottyT e m ()
matchAny pattern :: RoutePattern
pattern action :: ActionT e m ()
action = State (ScottyState e m) () -> ScottyT e m ()
forall e (m :: * -> *) a.
State (ScottyState e m) a -> ScottyT e m a
ScottyT (State (ScottyState e m) () -> ScottyT e m ())
-> State (ScottyState e m) () -> ScottyT e m ()
forall a b. (a -> b) -> a -> b
$ (ScottyState e m -> ScottyState e m) -> State (ScottyState e m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((ScottyState e m -> ScottyState e m)
 -> State (ScottyState e m) ())
-> (ScottyState e m -> ScottyState e m)
-> State (ScottyState e m) ()
forall a b. (a -> b) -> a -> b
$ \s :: ScottyState e m
s -> Middleware m -> ScottyState e m -> ScottyState e m
forall (m :: * -> *) e.
Middleware m -> ScottyState e m -> ScottyState e m
addRoute (ErrorHandler e m
-> Maybe StdMethod
-> RoutePattern
-> ActionT e m ()
-> Middleware m
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
ErrorHandler e m
-> Maybe StdMethod
-> RoutePattern
-> ActionT e m ()
-> Middleware m
route (ScottyState e m -> ErrorHandler e m
forall e (m :: * -> *). ScottyState e m -> ErrorHandler e m
handler ScottyState e m
s) Maybe StdMethod
forall a. Maybe a
Nothing RoutePattern
pattern ActionT e m ()
action) ScottyState e m
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 :: ActionT e m () -> ScottyT e m ()
notFound action :: ActionT e m ()
action = RoutePattern -> ActionT e m () -> ScottyT e m ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
matchAny ((Request -> Maybe [Param]) -> RoutePattern
Function (\req :: Request
req -> [Param] -> Maybe [Param]
forall a. a -> Maybe a
Just [("path", Request -> Text
path Request
req)])) (Status -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
status Status
status404 ActionT e m () -> ActionT e m () -> ActionT e m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ActionT e m ()
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 :: StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
addroute method :: StdMethod
method pat :: RoutePattern
pat action :: ActionT e m ()
action = State (ScottyState e m) () -> ScottyT e m ()
forall e (m :: * -> *) a.
State (ScottyState e m) a -> ScottyT e m a
ScottyT (State (ScottyState e m) () -> ScottyT e m ())
-> State (ScottyState e m) () -> ScottyT e m ()
forall a b. (a -> b) -> a -> b
$ (ScottyState e m -> ScottyState e m) -> State (ScottyState e m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
MS.modify ((ScottyState e m -> ScottyState e m)
 -> State (ScottyState e m) ())
-> (ScottyState e m -> ScottyState e m)
-> State (ScottyState e m) ()
forall a b. (a -> b) -> a -> b
$ \s :: ScottyState e m
s -> Middleware m -> ScottyState e m -> ScottyState e m
forall (m :: * -> *) e.
Middleware m -> ScottyState e m -> ScottyState e m
addRoute (ErrorHandler e m
-> Maybe StdMethod
-> RoutePattern
-> ActionT e m ()
-> Middleware m
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
ErrorHandler e m
-> Maybe StdMethod
-> RoutePattern
-> ActionT e m ()
-> Middleware m
route (ScottyState e m -> ErrorHandler e m
forall e (m :: * -> *). ScottyState e m -> ErrorHandler e m
handler ScottyState e m
s) (StdMethod -> Maybe StdMethod
forall a. a -> Maybe a
Just StdMethod
method) RoutePattern
pat ActionT e m ()
action) ScottyState e m
s

route :: (ScottyError e, MonadIO m) => ErrorHandler e m -> Maybe StdMethod -> RoutePattern -> ActionT e m () -> Middleware m
route :: ErrorHandler e m
-> Maybe StdMethod
-> RoutePattern
-> ActionT e m ()
-> Middleware m
route h :: ErrorHandler e m
h method :: Maybe StdMethod
method pat :: RoutePattern
pat action :: ActionT e m ()
action app :: Application m
app req :: Request
req =
    let tryNext :: m Response
tryNext = Application m
app Request
req
        {- |
          We match all methods in the case where 'method' is 'Nothing'.
          See https://github.com/scotty-web/scotty/issues/196
        -}
        methodMatches :: Bool
        methodMatches :: Bool
methodMatches =
            case Maybe StdMethod
method of
                Nothing -> Bool
True
                Just m :: StdMethod
m -> StdMethod -> Either ByteString StdMethod
forall a b. b -> Either a b
Right StdMethod
m Either ByteString StdMethod -> Either ByteString StdMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Either ByteString StdMethod
parseMethod (Request -> ByteString
requestMethod Request
req)
    in if Bool
methodMatches
       then case RoutePattern -> Request -> Maybe [Param]
matchRoute RoutePattern
pat Request
req of
            Just captures :: [Param]
captures -> do
                ActionEnv
env <- Request -> [Param] -> m ActionEnv
forall (m :: * -> *).
MonadIO m =>
Request -> [Param] -> m ActionEnv
mkEnv Request
req [Param]
captures
                Maybe Response
res <- ErrorHandler e m
-> ActionEnv -> ActionT e m () -> m (Maybe Response)
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
ErrorHandler e m
-> ActionEnv -> ActionT e m () -> m (Maybe Response)
runAction ErrorHandler e m
h ActionEnv
env ActionT e m ()
action
                m Response
-> (Response -> m Response) -> Maybe Response -> m Response
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Response
tryNext Response -> m Response
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Response
res
            Nothing -> m Response
tryNext
       else m Response
tryNext

matchRoute :: RoutePattern -> Request -> Maybe [Param]
matchRoute :: RoutePattern -> Request -> Maybe [Param]
matchRoute (Literal pat :: Text
pat)  req :: Request
req | Text
pat Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Request -> Text
path Request
req = [Param] -> Maybe [Param]
forall a. a -> Maybe a
Just []
                              | Bool
otherwise       = Maybe [Param]
forall a. Maybe a
Nothing
matchRoute (Function fun :: Request -> Maybe [Param]
fun) req :: Request
req = Request -> Maybe [Param]
fun Request
req
matchRoute (Capture pat :: Text
pat)  req :: Request
req = [Text] -> [Text] -> [Param] -> Maybe [Param]
go ((Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='/') Text
pat) ([Text] -> [Text]
forall a. (Eq a, IsString a) => [a] -> [a]
compress ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='/') (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Request -> Text
path Request
req) []
    where go :: [Text] -> [Text] -> [Param] -> Maybe [Param]
go [] [] prs :: [Param]
prs = [Param] -> Maybe [Param]
forall a. a -> Maybe a
Just [Param]
prs -- request string and pattern match!
          go [] r :: [Text]
r  prs :: [Param]
prs | Text -> Bool
T.null ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
r)  = [Param] -> Maybe [Param]
forall a. a -> Maybe a
Just [Param]
prs -- in case request has trailing slashes
                       | Bool
otherwise           = Maybe [Param]
forall a. Maybe a
Nothing  -- request string is longer than pattern
          go p :: [Text]
p  [] prs :: [Param]
prs | Text -> Bool
T.null ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text]
p)  = [Param] -> Maybe [Param]
forall a. a -> Maybe a
Just [Param]
prs -- in case pattern has trailing slashes
                       | Bool
otherwise           = Maybe [Param]
forall a. Maybe a
Nothing  -- request string is not long enough
          go (p :: Text
p:ps :: [Text]
ps) (r :: Text
r:rs :: [Text]
rs) prs :: [Param]
prs | Text
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
r          = [Text] -> [Text] -> [Param] -> Maybe [Param]
go [Text]
ps [Text]
rs [Param]
prs -- equal literals, keeping checking
                               | Text -> Bool
T.null Text
p        = Maybe [Param]
forall a. Maybe a
Nothing      -- p is null, but r is not, fail
                               | Text -> Char
T.head Text
p Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ':' = [Text] -> [Text] -> [Param] -> Maybe [Param]
go [Text]
ps [Text]
rs ([Param] -> Maybe [Param]) -> [Param] -> Maybe [Param]
forall a b. (a -> b) -> a -> b
$ (Text -> Text
T.tail Text
p, Text
r) Param -> [Param] -> [Param]
forall a. a -> [a] -> [a]
: [Param]
prs -- p is a capture, add to params
                               | Bool
otherwise       = Maybe [Param]
forall a. Maybe a
Nothing      -- both literals, but unequal, fail
          compress :: [a] -> [a]
compress ("":rest :: [a]
rest@("":_)) = [a] -> [a]
compress [a]
rest
          compress (x :: a
x:xs :: [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
compress [a]
xs
          compress [] = []

-- Pretend we are at the top level.
path :: Request -> T.Text
path :: Request -> Text
path = Text -> Text
T.fromStrict (Text -> Text) -> (Request -> Text) -> Request -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
TS.cons '/' (Text -> Text) -> (Request -> Text) -> Request -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
TS.intercalate "/" ([Text] -> Text) -> (Request -> [Text]) -> Request -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> [Text]
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 :: [ByteString] -> BackEnd y -> Request -> m ([Param], [File y])
parseRequestBody bl :: [ByteString]
bl s :: BackEnd y
s r :: Request
r =
    case Request -> Maybe RequestBodyType
Parse.getRequestBodyType Request
r of
        Nothing -> ([Param], [File y]) -> m ([Param], [File y])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
        Just rbt :: RequestBodyType
rbt -> do
            MVar [ByteString]
mvar <- IO (MVar [ByteString]) -> m (MVar [ByteString])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar [ByteString]) -> m (MVar [ByteString]))
-> IO (MVar [ByteString]) -> m (MVar [ByteString])
forall a b. (a -> b) -> a -> b
$ [ByteString] -> IO (MVar [ByteString])
forall a. a -> IO (MVar a)
newMVar [ByteString]
bl -- MVar is a bit of a hack so we don't have to inline
                                        -- large portions of Network.Wai.Parse
            let provider :: IO ByteString
provider = MVar [ByteString]
-> ([ByteString] -> IO ([ByteString], ByteString)) -> IO ByteString
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar [ByteString]
mvar (([ByteString] -> IO ([ByteString], ByteString)) -> IO ByteString)
-> ([ByteString] -> IO ([ByteString], ByteString)) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \bsold :: [ByteString]
bsold -> case [ByteString]
bsold of
                                                []     -> ([ByteString], ByteString) -> IO ([ByteString], ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], ByteString
B.empty)
                                                (b :: ByteString
b:bs :: [ByteString]
bs) -> ([ByteString], ByteString) -> IO ([ByteString], ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString]
bs, ByteString
b)
            IO ([Param], [File y]) -> m ([Param], [File y])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Param], [File y]) -> m ([Param], [File y]))
-> IO ([Param], [File y]) -> m ([Param], [File y])
forall a b. (a -> b) -> a -> b
$ BackEnd y
-> RequestBodyType -> IO ByteString -> IO ([Param], [File y])
forall y.
BackEnd y
-> RequestBodyType -> IO ByteString -> IO ([Param], [File y])
Parse.sinkRequestBody BackEnd y
s RequestBodyType
rbt IO ByteString
provider

mkEnv :: forall m. MonadIO m => Request -> [Param] -> m ActionEnv
mkEnv :: Request -> [Param] -> m ActionEnv
mkEnv req :: Request
req captures :: [Param]
captures = do
    MVar RequestBodyState
bodyState <- IO (MVar RequestBodyState) -> m (MVar RequestBodyState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar RequestBodyState) -> m (MVar RequestBodyState))
-> IO (MVar RequestBodyState) -> m (MVar RequestBodyState)
forall a b. (a -> b) -> a -> b
$ RequestBodyState -> IO (MVar RequestBodyState)
forall a. a -> IO (MVar a)
newMVar RequestBodyState
BodyUntouched

    let rbody :: IO ByteString
rbody = Request -> IO ByteString
getRequestBodyChunk Request
req
        takeAll :: ([B.ByteString] -> IO [B.ByteString]) -> IO [B.ByteString]
        takeAll :: ([ByteString] -> IO [ByteString]) -> IO [ByteString]
takeAll prefix :: [ByteString] -> IO [ByteString]
prefix = IO ByteString
rbody IO ByteString -> (ByteString -> IO [ByteString]) -> IO [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b :: ByteString
b -> if ByteString -> Bool
B.null ByteString
b then [ByteString] -> IO [ByteString]
prefix [] else ([ByteString] -> IO [ByteString]) -> IO [ByteString]
takeAll ([ByteString] -> IO [ByteString]
prefix ([ByteString] -> IO [ByteString])
-> ([ByteString] -> [ByteString])
-> [ByteString]
-> IO [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
bByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:))

        safeBodyReader :: IO B.ByteString
        safeBodyReader :: IO ByteString
safeBodyReader =  do
          RequestBodyState
state <- MVar RequestBodyState -> IO RequestBodyState
forall a. MVar a -> IO a
takeMVar MVar RequestBodyState
bodyState
          let direct :: IO ByteString
direct = MVar RequestBodyState -> RequestBodyState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar RequestBodyState
bodyState RequestBodyState
BodyCorrupted IO () -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ByteString
rbody
          case RequestBodyState
state of
            s :: RequestBodyState
s@(BodyCached _ []) ->
              do MVar RequestBodyState -> RequestBodyState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar RequestBodyState
bodyState RequestBodyState
s
                 ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
            BodyCached b :: ByteString
b (chunk :: ByteString
chunk:rest :: [ByteString]
rest) ->
              do MVar RequestBodyState -> RequestBodyState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar RequestBodyState
bodyState (RequestBodyState -> IO ()) -> RequestBodyState -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> RequestBodyState
BodyCached ByteString
b [ByteString]
rest
                 ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
chunk
            BodyUntouched -> IO ByteString
direct
            BodyCorrupted -> IO ByteString
direct

        bs :: IO BL.ByteString
        bs :: IO ByteString
bs = do
          RequestBodyState
state <- MVar RequestBodyState -> IO RequestBodyState
forall a. MVar a -> IO a
takeMVar MVar RequestBodyState
bodyState
          case RequestBodyState
state of
            s :: RequestBodyState
s@(BodyCached b :: ByteString
b _) ->
              do MVar RequestBodyState -> RequestBodyState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar RequestBodyState
bodyState RequestBodyState
s
                 ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
            BodyCorrupted -> BodyPartiallyStreamed -> IO ByteString
forall a e. Exception e => e -> a
throw BodyPartiallyStreamed
BodyPartiallyStreamed
            BodyUntouched ->
              do [ByteString]
chunks <- ([ByteString] -> IO [ByteString]) -> IO [ByteString]
takeAll [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return
                 let b :: ByteString
b = [ByteString] -> ByteString
BL.fromChunks [ByteString]
chunks
                 MVar RequestBodyState -> RequestBodyState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar RequestBodyState
bodyState (RequestBodyState -> IO ()) -> RequestBodyState -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> RequestBodyState
BodyCached ByteString
b [ByteString]
chunks
                 ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b

        shouldParseBody :: Bool
shouldParseBody = Maybe RequestBodyType -> Bool
forall a. Maybe a -> Bool
isJust (Maybe RequestBodyType -> Bool) -> Maybe RequestBodyType -> Bool
forall a b. (a -> b) -> a -> b
$ Request -> Maybe RequestBodyType
Parse.getRequestBodyType Request
req

    (formparams :: [Param]
formparams, fs :: [File ByteString]
fs) <- if Bool
shouldParseBody
      then IO ([Param], [File ByteString]) -> m ([Param], [File ByteString])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Param], [File ByteString]) -> m ([Param], [File ByteString]))
-> IO ([Param], [File ByteString])
-> m ([Param], [File ByteString])
forall a b. (a -> b) -> a -> b
$ do [ByteString]
wholeBody <- ByteString -> [ByteString]
BL.toChunks (ByteString -> [ByteString]) -> IO ByteString -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO ByteString
bs
                       [ByteString]
-> BackEnd ByteString -> Request -> IO ([Param], [File ByteString])
forall (m :: * -> *) y.
MonadIO m =>
[ByteString] -> BackEnd y -> Request -> m ([Param], [File y])
parseRequestBody [ByteString]
wholeBody BackEnd ByteString
forall (m :: * -> *) ignored1 ignored2.
Monad m =>
ignored1 -> ignored2 -> m ByteString -> m ByteString
Parse.lbsBackEnd Request
req
      else ([Param], [File ByteString]) -> m ([Param], [File ByteString])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])

    let
        convert :: Param -> Param
convert (k :: ByteString
k, v :: ByteString
v) = (ByteString -> Text
strictByteStringToLazyText ByteString
k, ByteString -> Text
strictByteStringToLazyText ByteString
v)
        parameters :: [Param]
parameters =  [Param]
captures [Param] -> [Param] -> [Param]
forall a. [a] -> [a] -> [a]
++ (Param -> Param) -> [Param] -> [Param]
forall a b. (a -> b) -> [a] -> [b]
map Param -> Param
convert [Param]
formparams [Param] -> [Param] -> [Param]
forall a. [a] -> [a] -> [a]
++ [Param]
queryparams
        queryparams :: [Param]
queryparams = ByteString -> [Param]
parseEncodedParams (ByteString -> [Param]) -> ByteString -> [Param]
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
rawQueryString Request
req

    ActionEnv -> m ActionEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (ActionEnv -> m ActionEnv) -> ActionEnv -> m ActionEnv
forall a b. (a -> b) -> a -> b
$ Request
-> [Param] -> IO ByteString -> IO ByteString -> [File] -> ActionEnv
Env Request
req [Param]
parameters IO ByteString
bs IO ByteString
safeBodyReader [ (ByteString -> Text
strictByteStringToLazyText ByteString
k, FileInfo ByteString
fi) | (k :: ByteString
k,fi :: FileInfo ByteString
fi) <- [File ByteString]
fs ]

parseEncodedParams :: B.ByteString -> [Param]
parseEncodedParams :: ByteString -> [Param]
parseEncodedParams bs :: ByteString
bs = [ (Text -> Text
T.fromStrict Text
k, Text -> Text
T.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" Maybe Text
v) | (k :: Text
k,v :: Maybe Text
v) <- ByteString -> QueryText
parseQueryText ByteString
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 :: String -> RoutePattern
regex pattern :: String
pattern = (Request -> Maybe [Param]) -> RoutePattern
Function ((Request -> Maybe [Param]) -> RoutePattern)
-> (Request -> Maybe [Param]) -> RoutePattern
forall a b. (a -> b) -> a -> b
$ \ req :: Request
req -> ((String, String, String, [String]) -> [Param])
-> Maybe (String, String, String, [String]) -> Maybe [Param]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, String) -> Param) -> [(Int, String)] -> [Param]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> (String -> Text) -> (Int, String) -> Param
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> Text
T.pack) ([(Int, String)] -> [Param])
-> ((String, String, String, [String]) -> [(Int, String)])
-> (String, String, String, [String])
-> [Param]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0 :: Int ..] ([String] -> [(Int, String)])
-> ((String, String, String, [String]) -> [String])
-> (String, String, String, [String])
-> [(Int, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String, String, [String]) -> [String]
forall a a c. (a, a, c, [a]) -> [a]
strip)
                                         (Regex -> String -> Maybe (String, String, String, [String])
Regex.matchRegexAll Regex
rgx (String -> Maybe (String, String, String, [String]))
-> String -> Maybe (String, String, String, [String])
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Request -> Text
path Request
req)
    where rgx :: Regex
rgx = String -> Regex
Regex.mkRegex String
pattern
          strip :: (a, a, c, [a]) -> [a]
strip (_, match :: a
match, _, subs :: [a]
subs) = a
match a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
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 :: String -> RoutePattern
capture = String -> RoutePattern
forall a. IsString a => String -> a
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 :: (Request -> Maybe [Param]) -> RoutePattern
function = (Request -> Maybe [Param]) -> RoutePattern
Function

-- | Build a route that requires the requested path match exactly, without captures.
literal :: String -> RoutePattern
literal :: String -> RoutePattern
literal = Text -> RoutePattern
Literal (Text -> RoutePattern)
-> (String -> Text) -> String -> RoutePattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

#if !(MIN_VERSION_wai(3,2,2))
getRequestBodyChunk :: Request -> IO B.ByteString
getRequestBodyChunk = requestBody
#endif