{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE LambdaCase #-} {-# language ScopedTypeVariables #-} module Web.Scotty.Action ( addHeader , body , bodyReader , file , rawResponse , files , filesOpts , W.ParseRequestBodyOptions, W.defaultParseRequestBodyOptions , finish , header , headers , html , htmlLazy , liftAndCatchIO , json , jsonData , next , param , pathParam , captureParam , formParam , queryParam , pathParamMaybe , captureParamMaybe , formParamMaybe , queryParamMaybe , params , pathParams , captureParams , formParams , queryParams , raise , raiseStatus , throw , raw , nested , readEither , redirect , request , rescue , setHeader , status , stream , text , textLazy , getResponseStatus , getResponseHeaders , getResponseContent , Param , Parsable(..) , ActionT -- private to Scotty , runAction ) where import Blaze.ByteString.Builder (fromLazyByteString) import qualified Control.Exception as E import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..)) import UnliftIO (MonadUnliftIO(..)) import Control.Monad.Reader (MonadReader(..), ReaderT(..)) import Control.Monad.Trans.Resource (withInternalState, runResourceT) import Control.Concurrent.MVar import qualified Data.Aeson as A import Data.Bool (bool) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.CaseInsensitive as CI import Data.Traversable (for) import Data.Int import Data.Maybe (maybeToList) import qualified Data.Text as T import Data.Text.Encoding as STE import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE import Data.Time (UTCTime) import Data.Time.Format (parseTimeM, defaultTimeLocale) import Data.Typeable (typeOf) 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 (Request, Response, StreamingBody, Application, requestHeaders) import Network.Wai.Handler.Warp (InvalidRequest(..)) import qualified Network.Wai.Parse as W (FileInfo(..), ParseRequestBodyOptions, defaultParseRequestBodyOptions) import Numeric.Natural import Web.Scotty.Internal.Types import Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, decodeUtf8Lenient) import UnliftIO.Exception (Handler(..), catch, catches, throwIO) import System.IO (hPutStrLn, stderr) import Network.Wai.Internal (ResponseReceived(..)) -- | Evaluate a route, catch all exceptions (user-defined ones, internal and all remaining, in this order) -- and construct the 'Response' -- -- 'Nothing' indicates route failed (due to Next) and pattern matching should try the next available route. -- 'Just' indicates a successful response. runAction :: MonadUnliftIO m => Options -> Maybe (ErrorHandler m) -- ^ this handler (if present) is in charge of user-defined exceptions -> ActionEnv -> ActionT m () -- ^ Route action to be evaluated -> m (Maybe Response) runAction options mh env action = do ok <- flip runReaderT env $ runAM $ tryNext $ action `catches` concat [ [actionErrorHandler] , maybeToList mh , [statusErrorHandler, scottyExceptionHandler, someExceptionHandler options] ] res <- getResponse env return $ bool Nothing (Just $ mkResponse res) ok -- | Catches 'StatusError' and produces an appropriate HTTP response. statusErrorHandler :: MonadIO m => ErrorHandler m statusErrorHandler = Handler $ \case StatusError s e -> do status s let code = T.pack $ show $ statusCode s let msg = decodeUtf8Lenient $ statusMessage s html $ mconcat ["