{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE LambdaCase #-} {-# language ScopedTypeVariables #-} module Web.Scotty.Action ( addHeader , body , bodyReader , file , rawResponse , files , finish , header , headers , html , liftAndCatchIO , json , jsonData , next , param , captureParam , formParam , queryParam , params , captureParams , formParams , queryParams , raise , raiseStatus , throw , raw , nested , 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 (when) import Control.Monad.IO.Class (MonadIO(..)) import UnliftIO (MonadUnliftIO(..)) import Control.Monad.Reader (MonadReader(..), ReaderT(..)) 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.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 (Request, Response, StreamingBody, Application, requestHeaders) import Numeric.Natural import Prelude () import "base-compat-batteries" Prelude.Compat import Web.Scotty.Internal.Types import Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, strictByteStringToLazyText) import Web.Scotty.Exceptions (Handler(..), catch, catchesOptionally, tryAny) 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 => 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 mh env action = do let handlers = [ statusErrorHandler, -- StatusError actionErrorHandler, -- ActionError i.e. Next, Finish, Redirect someExceptionHandler -- all remaining exceptions ] ok <- flip runReaderT env $ runAM $ tryNext (catchesOptionally action mh handlers ) 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 = T.fromStrict $ STE.decodeUtf8 $ statusMessage s html $ mconcat ["