{-# 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)
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (mconcat)
#endif
import Data.String (fromString)
import qualified Data.Text.Lazy as T
import qualified Data.Text as TS
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 qualified Text.Regex as Regex
import Web.Scotty.Action
import Web.Scotty.Internal.Types
import Web.Scotty.Util
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 :: (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 :: (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 :: (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 :: (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 :: (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
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
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)
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
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) ((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
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
| Bool
otherwise = Maybe [Param]
forall a. Maybe a
Nothing
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
| Bool
otherwise = Maybe [Param]
forall a. Maybe a
Nothing
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
| Text -> Bool
T.null Text
p = Maybe [Param]
forall a. Maybe a
Nothing
| 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
| Bool
otherwise = Maybe [Param]
forall a. Maybe a
Nothing
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
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
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 ]
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
capture :: String -> RoutePattern
capture :: String -> RoutePattern
capture = String -> RoutePattern
forall a. IsString a => String -> a
fromString
function :: (Request -> Maybe [Param]) -> RoutePattern
function :: (Request -> Maybe [Param]) -> RoutePattern
function = (Request -> Maybe [Param]) -> RoutePattern
Function
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