{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} module Web.Scotty.Action ( addHeader , body , bodyReader , file , files , finish , header , headers , html , liftAndCatchIO , json , jsonData , next , param , params , raise , raiseStatus , raw , 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 (liftM, when) import Control.Monad.Error.Class import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader (MonadReader(..), ReaderT(..)) import qualified Control.Monad.State.Strict as MS import Control.Monad.Trans.Except import qualified Data.Aeson as A import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.CaseInsensitive as CI import Data.Default.Class (def) 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 import Numeric.Natural import Prelude () import Prelude.Compat import Web.Scotty.Internal.Types import Web.Scotty.Util -- Nothing indicates route failed (due to Next) and pattern matching should continue. -- Just indicates a successful response. runAction :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionEnv -> ActionT e m () -> m (Maybe Response) runAction h env action = do (e,r) <- flip MS.runStateT def $ flip runReaderT env $ runExceptT $ runAM $ action `catchError` (defH h) return $ either (const Nothing) (const $ Just $ mkResponse r) e -- | Default error handler for all actions. defH :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionError e -> ActionT e m () defH _ (Redirect url) = do status status302 setHeader "Location" url defH Nothing (ActionError s e) = do status s let code = T.pack $ show $ statusCode s let msg = T.fromStrict $ STE.decodeUtf8 $ statusMessage s html $ mconcat ["