module Web.Welshy.Request where
import Control.Applicative
import Control.Monad
import Data.Aeson (FromJSON, fromJSON)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Network.HTTP.Types
import Network.Wai
import Web.Welshy.Action
import Web.Welshy.FromText
import Web.Welshy.Response
capture :: FromText a => Text -> Action a
capture k = (lookup k <$> captures) >>= \case
Nothing -> fail ("unknown capture: " ++ T.unpack k)
Just raw -> case fromText raw of
Left _ -> pass
Right v -> return v
queryParam :: FromText a => Text -> Action a
queryParam k = (lookup k <$> queryParams) >>= \case
Nothing -> halt $ status badRequest400
Just raw -> case fromText raw of
Left _ -> halt $ status badRequest400
Right v -> return v
maybeQueryParam :: FromText a => Text -> Action (Maybe a)
maybeQueryParam k = (lookup k <$> queryParams) >>= \case
Nothing -> return Nothing
Just raw -> case fromText raw of
Left _ -> halt $ status badRequest400
Right v -> return (Just v)
jsonParam :: FromJSON a => Text -> Action a
jsonParam k = (HashMap.lookup k <$> jsonParams) >>= \case
Nothing -> halt $ status badRequest400
Just raw -> case fromJSON raw of
A.Error _ -> halt $ status badRequest400
A.Success v -> return v
maybeJsonParam :: FromJSON a => Text -> Action (Maybe a)
maybeJsonParam k = (HashMap.lookup k <$> jsonParams) >>= \case
Nothing -> return Nothing
Just raw -> case fromJSON raw of
A.Error _ -> halt $ status badRequest400
A.Success v -> return (Just v)
jsonData :: FromJSON a => Action a
jsonData = A.decode <$> body >>= \case
Nothing -> halt $ status badRequest400
Just v -> return v
jsonParams :: Action A.Object
jsonParams = Action $ \r s -> do
case _jsonParams r of
Nothing -> return $ Halt $ status badRequest400
Just v -> return $ Ok v s
bearerAuth :: FromText a => Action a
bearerAuth = do
headers <- requestHeaders <$> request
maybe (halt $ status unauthorized401) return $ do
credentials <- lookup hAuthorization headers
let (scheme, raw) = B.splitAt 7 credentials
guard (scheme == "Bearer ")
maybeFromText $ T.decodeUtf8 raw