content: {-# LANGUAGE FunctionalDependencies #-}
  {-# LANGUAGE UndecidableInstances #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE DeriveFunctor #-}
  {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE Rank2Types #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE CPP #-}
  
  module Control.Monad.Apiary.Action.Internal
      ( ActionT
  
      , application
      , stop
  
      , param
      , params
  
      , status
  
      , addHeader, setHeaders, modifyHeader
      , contentType
  
      , reset
      , builder
      , bytes, lazyBytes
      , text,  lazyText
      , showing
      , json
      , string, char
      , appendBuilder
      , appendBytes, appendLazyBytes
      , appendText, appendLazyText
      , appendShowing
      , appendString, appendChar
      , file
      , file'
  
      , redirect, redirectPermanently, redirectTemporary
  
      , defaultDocumentationAction
      , DefaultDocumentConfig(..)
  
      , hoistActionT
      , ContentType
      , stopWith
  
      , getRequest
      , getHeaders
      , getParams
      , getQueryParams
      , getReqBodyParams
      , getReqBodyFiles
      , getReqBodyJSON
      , ActionReqBody(..)
      , getReqBody
  
      , devFile
      , devFile'
      , stream
      , rawResponse
  
      , lookupVault
      , modifyVault
      , insertVault
      , adjustVault
      , deleteVault
  
      , redirectWith
  
      -- internal
      , ApiaryConfig(..)
      , getConfig
      , getState
      , modifyState
      , getReqBodyInternal
      , execActionT
      , applyDict
  
      , MonadExts(..)
      , Extensions(..)
      , Extension(..)
      , Middleware'
      ) where
  
  
  import qualified Language.Haskell.TH as TH
  import Language.Haskell.TH.Quote(QuasiQuoter(..))
  
  import qualified System.PosixCompat.Files as Files
  
  #if MIN_VERSION_base(4,8,0)
  import Control.Applicative (Alternative(..))
  #else
  import Data.Monoid(Monoid(..))
  import Control.Applicative (Applicative(..), Alternative(..), (<$>))
  #endif
  import Control.Monad (MonadPlus(..), liftM)
  import Control.Monad.Trans(MonadIO(..), MonadTrans(..))
  import Control.Monad.Base(MonadBase(..), liftBaseDefault)
  import Control.Monad.Reader(MonadReader(..), ReaderT)
  import Control.Monad.Catch(MonadThrow(..), MonadCatch(..), MonadMask(..))
  import Control.Monad.Trans.Control
      (MonadTransControl(..), MonadBaseControl(..)
      , ComposeSt
      , defaultLiftBaseWith, defaultRestoreM)
  import Control.Exception (try, onException)
  import Control.Monad.Trans.Resource (createInternalState, closeInternalState)
  
  import Network.Mime(defaultMimeLookup)
  import Network.HTTP.Date(parseHTTPDate, epochTimeToHTTPDate, formatHTTPDate)
  import qualified Network.HTTP.Types as HTTP
  import qualified Network.Wai as Wai
  import qualified Network.Wai.Parse as P
  import Network.Wai.Request (requestSizeCheck, RequestSizeException(..))
  
  import qualified Network.Routing.Dict as Dict
  import Data.Apiary.Param(Param, File(..))
  import Data.Apiary.SProxy(SProxy(..))
  import Data.Apiary.Document(Documents)
  import Data.Apiary.Document.Html(defaultDocumentToHtml, DefaultDocumentConfig(..))
  import Data.Default.Class(Default(..))
  
  import Blaze.ByteString.Builder(Builder)
  import Text.Blaze.Html.Renderer.Utf8(renderHtmlBuilder)
  import qualified Blaze.ByteString.Builder as B
  import qualified Blaze.ByteString.Builder.Char.Utf8 as B
  import qualified Data.ByteString as S
  import qualified Data.ByteString.Lazy as L
  import qualified Data.ByteString.Lazy.Char8 as LC
  import qualified Data.Text as T
  import qualified Data.Text.Lazy as TL
  import qualified Data.Vault.Lazy as V
  import Data.Word (Word64)
  import Data.Aeson (FromJSON, ToJSON)
  import qualified Data.Aeson as JSON
  
  data ApiaryConfig = ApiaryConfig
      { -- | call when no handler matched.
        notFound            :: Wai.Application
        -- | used unless call 'status' function.
      , defaultStatus       :: HTTP.Status
        -- | initial headers.
      , defaultHeaders      :: HTTP.ResponseHeaders
      , defaultContentType  :: S.ByteString
      , failStatus          :: HTTP.Status
      , failHeaders         :: HTTP.ResponseHeaders
        -- | maximum request size, default to 5MB. since 2.0.0.
      , maxRequestSize      :: Word64
        -- | where to store upload file. since 2.0.0.
        --
        -- default to 'Nothing', which saves file content in memory.
        -- NOTE. once you set this value to some path,
        -- it's your responsibility to clean uploaded files. eg. move or remove it.
      , uploadFilePath      :: Maybe FilePath
        -- | used by 'Control.Monad.Apiary.Filter.root' filter.
      , rootPattern         :: [T.Text]
      , mimeType            :: FilePath -> S.ByteString
      }
  
  -- | auto generated document.
  defaultDocumentationAction :: Monad m => DefaultDocumentConfig -> ActionT exts prms m ()
  defaultDocumentationAction conf = do
      d <- getDocuments
      contentType "text/html"
      builder . renderHtmlBuilder $ defaultDocumentToHtml conf d
  
  defaultNotFound :: Wai.Application
  defaultNotFound _ f = f      $ Wai.responseLBS HTTP.status404 [("Content-Type", "text/plain")] "404 Page Notfound.\n"
  
  instance Default ApiaryConfig where
      def = ApiaryConfig
          { notFound            = defaultNotFound
          , defaultStatus       = HTTP.ok200
          , defaultHeaders      = []
          , defaultContentType  = "text/plain"
          , failStatus          = HTTP.internalServerError500
          , failHeaders         = []
          , rootPattern         = ["index.html", "index.htm"]
          , maxRequestSize      = 5242880
          , uploadFilePath      = Nothing
          , mimeType            = defaultMimeLookup . T.pack
          }
  
  --------------------------------------------------------------------------------
  
  data ResponseBody
      = ResponseFile FilePath (Maybe Wai.FilePart)
      | ResponseBuilder Builder
      | ResponseStream Wai.StreamingBody
      | ResponseRaw (IO S.ByteString -> (S.ByteString -> IO ()) -> IO ()) Wai.Response
      | ResponseFunc (HTTP.Status -> HTTP.ResponseHeaders -> Wai.Response)
  
  instance Monoid ResponseBody where
      mempty = ResponseBuilder mempty
      ResponseBuilder a `mappend` ResponseBuilder b = ResponseBuilder $ a `mappend` b
      _ `mappend` b = b
  
  toResponse :: ActionState -> Wai.Response
  toResponse ActionState{..} = case actionResponse of
      ResponseFile  f p -> Wai.responseFile    actionStatus headers f p
      ResponseBuilder b -> Wai.responseBuilder actionStatus headers b
      ResponseStream  s -> Wai.responseStream  actionStatus headers s
      ResponseRaw   f r -> Wai.responseRaw f r
      ResponseFunc    f -> f actionStatus headers
    where
      headers = ("Content-Type", actionContentType) : actionHeaders
  
  --------------------------------------------------------------------------------
  
  data ActionReqBody
      = Unknown L.ByteString -- ^ raw body
      | UrlEncoded [Param]   -- ^ url-encoded params
      | Multipart [Param] [File] -- ^ boundary params files
    deriving (Show, Eq)
  
  data ActionState = ActionState
      { actionResponse    :: ResponseBody
      , actionStatus      :: HTTP.Status
      , actionHeaders     :: HTTP.ResponseHeaders
      , actionVault       :: V.Vault
      , actionContentType :: S.ByteString
      , actionReqBody     :: Maybe ActionReqBody
      }
  
  initialState :: ApiaryConfig -> ActionState
  initialState conf = ActionState
      { actionResponse    = ResponseBuilder mempty
      , actionStatus      = defaultStatus  conf
      , actionHeaders     = defaultHeaders conf
      , actionVault       = V.empty
      , actionContentType = defaultContentType conf
      , actionReqBody     = Nothing
      }
  {-# INLINE initialState #-}
  
  --------------------------------------------------------------------------------
  data Extensions (es :: [*]) where
      NoExtension  :: Extensions '[]
      AddExtension :: Extension e => (e :: *) -> Extensions es -> Extensions (e ': es)
  
  type Middleware' = forall exts. ActionT exts '[] IO () -> ActionT exts '[] IO ()
  
  class Extension e where
      extMiddleware :: e -> Wai.Middleware
      extMiddleware _ = id
      {-# INLINE extMiddleware #-}
  
      extMiddleware'  :: e -> Middleware'
      extMiddleware'  _ = id
      {-# INLINE extMiddleware' #-}
  
  class Monad m => MonadExts es m | m -> es where
      getExts :: m (Extensions es)
  
  instance Monad m => MonadExts es (ReaderT (Extensions es) m) where
      getExts = ask
  
  --------------------------------------------------------------------------------
  
  data ActionEnv exts = ActionEnv
      { actionConfig    :: ApiaryConfig
      , actionRequest   :: Wai.Request
      , actionDocuments :: Documents
      , actionExts      :: Extensions exts
      }
  
  data Action a
      = Continue ActionState a
      | Pass (Maybe ActionReqBody)
      | Stop Wai.Response
      | App Wai.Application
  
  newtype ActionT exts prms m a = ActionT { unActionT :: forall b.
      Dict.Dict prms
      -> ActionEnv exts
      -> ActionState
      -> (a -> ActionState -> m (Action b))
      -> m (Action b)
      } deriving (Functor)
  
  runActionT :: Monad m => ActionT exts prms m a
             -> Dict.Dict prms -> ActionEnv exts -> ActionState
             -> m (Action a)
  runActionT m dict env st = unActionT m dict env st $ \a !st' ->
      return (Continue st' a)
  {-# INLINE runActionT #-}
  
  actionT :: Monad m
          => (Dict.Dict prms -> ActionEnv exts -> ActionState -> m (Action a))
          -> ActionT exts prms m a
  actionT f = ActionT $ \dict env !st cont -> f dict env st >>= \case
      Pass b          -> return $ Pass b
      Stop s          -> return $ Stop s
      Continue !st' a -> cont a st'
      App a           -> return $ App a
  {-# INLINE actionT #-}
  
  -- | stop and proxy current request to a 'Wai.Application', since 2.0.0.
  application :: Monad m
          => Wai.Application
          -> ActionT exts prms m a
  application app = ActionT $ \_ _ _ _ -> return $ App app
  
  -- | n must be Monad, so cant be MFunctor.
  hoistActionT :: (Monad m, Monad n)
               => (forall b. m b -> n b) -> ActionT exts prms m a -> ActionT exts prms n a
  hoistActionT run m = actionT $ \d e s -> run (runActionT m d e s)
  {-# INLINE hoistActionT #-}
  
  applyDict :: Dict.Dict prms -> ActionT exts prms m a -> ActionT exts '[] m a
  applyDict d (ActionT m) = ActionT $ const (m d)
  {-# INLINE applyDict #-}
  
  execActionT :: ApiaryConfig -> Extensions exts -> Documents -> ActionT exts '[] IO () -> Wai.Application
  execActionT config exts doc m request send =
      runActionT m Dict.emptyDict (ActionEnv config request doc exts) (initialState config) >>= \case
          Pass _       -> notFound config request send
          Stop s       -> send s
          Continue r _ -> send $ toResponse r
          App a        -> a request send
  
  --------------------------------------------------------------------------------
  
  instance Applicative (ActionT exts prms m) where
      pure x = ActionT $ \_ _ !st cont -> cont x st
      mf <*> ma = ActionT $ \dict env st cont ->
          unActionT mf dict env st  $ \f !st'  ->
          unActionT ma dict env st' $ \a !st'' ->
          cont (f a) st''
  
  instance Monad m => Monad (ActionT exts prms m) where
      return x = ActionT $ \_ _ !st cont -> cont x st
      m >>= k  = ActionT $ \dict env !st cont ->
          unActionT m dict env st $ \a !st' ->
          unActionT (k a) dict env st' cont
      fail s = ActionT $ \_ (ActionEnv{actionConfig = c}) _ _ -> return $
          Stop (Wai.responseLBS (failStatus c) (failHeaders c) $ LC.pack s)
  
  instance MonadIO m => MonadIO (ActionT exts prms m) where
      liftIO m = ActionT $ \_ _ !st cont ->
          liftIO m >>= \a -> cont a st
  
  instance MonadTrans (ActionT exts prms) where
      lift m = ActionT $ \_ _ !st cont ->
          m >>= \a -> cont a st
  
  instance MonadThrow m => MonadThrow (ActionT exts prms m) where
      throwM e = ActionT $ \_ _ !st cont ->
          throwM e >>= \a -> cont a st
  
  instance MonadCatch m => MonadCatch (ActionT exts prms m) where
      catch m h = ActionT $ \dict env !st cont ->
          catch (unActionT m dict env st cont) (\e -> unActionT (h e) dict env st cont)
      {-# INLINE catch #-}
  
  instance MonadMask m => MonadMask (ActionT exts prms m) where
      mask a = ActionT $ \dict env !st cont ->
          mask $ \u -> unActionT (a $ q u) dict env st cont
        where
          q u m = actionT $ \dict env !st -> u (runActionT m dict env st)
      uninterruptibleMask a = ActionT $ \dict env !st cont ->
          uninterruptibleMask $ \u -> unActionT (a $ q u) dict env st cont
        where
          q u m = actionT $ \dict env !st -> u (runActionT m dict env st)
      {-# INLINE mask #-}
      {-# INLINE uninterruptibleMask #-}
  
  instance (Monad m, Functor m) => Alternative (ActionT exts prms m) where
      empty = mzero
      (<|>) = mplus
      {-# INLINE empty #-}
      {-# INLINE (<|>) #-}
  
  instance Monad m => MonadPlus (ActionT exts prms m) where
      mzero = ActionT $ \_ _ !st _ -> return $ Pass (actionReqBody st)
      mplus m n = ActionT $ \dict e !s cont -> unActionT m dict e s cont >>= \case
          Continue !st a -> return $ Continue st a
          Stop stp       -> return $ Stop stp
          Pass b         -> unActionT n dict e s { actionReqBody = b } cont
          App a          -> return $ App a
      {-# INLINE mzero #-}
      {-# INLINE mplus #-}
  
  instance MonadBase b m => MonadBase b (ActionT exts prms m) where
      liftBase = liftBaseDefault
  
  -- `MIN_VERSION_base(major1,major2,minor)
  instance MonadTransControl (ActionT exts prms) where
  #if MIN_VERSION_monad_control(1,0,0)
      type StT (ActionT exts prms) a = Action a
      liftWith f = actionT $ \prms e !s -> liftM (\a -> Continue s a) (f $ \t -> runActionT t prms e s)
      restoreT m = actionT $ \_ _ _ -> m
  #else
      newtype StT (ActionT exts prms) a = StActionT { unStActionT :: Action a }
      liftWith f = actionT $ \prms e !s ->
          liftM (\a -> Continue s a) (f $ \t -> liftM StActionT $ runActionT t prms e s)
      restoreT m = actionT $ \_ _ _ -> liftM unStActionT m
  #endif
  
  instance MonadBaseControl b m => MonadBaseControl b (ActionT exts prms m) where
  #if MIN_VERSION_monad_control(1,0,0)
      type StM (ActionT exts prms m) a = ComposeSt (ActionT exts prms) m a
      liftBaseWith = defaultLiftBaseWith
      restoreM     = defaultRestoreM
  #else
      newtype StM (ActionT exts prms m) a = StMActionT { unStMActionT :: ComposeSt (ActionT exts prms) m a }
      liftBaseWith = defaultLiftBaseWith StMActionT
      restoreM     = defaultRestoreM unStMActionT
  #endif
  
  instance MonadReader r m => MonadReader r (ActionT exts prms m) where
      ask     = lift ask
      local f = hoistActionT $ local f
  
  instance Monad m => MonadExts exts (ActionT exts prms m) where
      getExts = liftM actionExts getEnv
  
  --------------------------------------------------------------------------------
  
  getEnv :: Monad m => ActionT exts prms m (ActionEnv exts)
  getEnv = ActionT $ \_ e s c -> c e s
  {-# INLINE getEnv #-}
  
  -- | get raw request. since 0.1.0.0.
  getRequest :: Monad m => ActionT exts prms m Wai.Request
  getRequest = liftM actionRequest getEnv
  
  getConfig :: Monad m => ActionT exts prms m ApiaryConfig
  getConfig = liftM actionConfig getEnv
  
  getParams :: Monad m => ActionT exts prms m (Dict.Dict prms)
  getParams = ActionT $ \d _ s c -> c d s
  {-# INLINE getParams #-}
  
  -- | get parameter. since 1.0.0.
  --
  -- example:
  --
  -- > param [key|foo|]
  --
  param :: (Dict.Member k v prms, Monad m) => proxy k -> ActionT exts prms m v
  param p = liftM (Dict.get p) getParams
  
  paramsE :: [String] -> TH.ExpQ
  paramsE ps = do
      ns <- mapM (\p -> (,) <$> TH.newName "x" <*> pure p) ps
      let bs  = map (\(v, k) -> TH.bindS (TH.varP v) (prm k)) ns
          tpl = TH.noBindS [| return $(TH.tupE $ map (TH.varE . fst) ns) |]
      TH.doE $ bs ++ [tpl]
    where
      prm  n = [| param (SProxy :: SProxy $(TH.litT $ TH.strTyLit n)) |]
  
  -- | get parameters. since 1.0.0.
  --
  -- > [params|foo,bar|] == do { a <- param [key|foo|]; b <- param [key|bar|]; return (a, b) }
  --
  params :: QuasiQuoter
  params = QuasiQuoter
      { quoteExp  = paramsE . map (T.unpack . T.strip) . T.splitOn "," . T.pack
      , quotePat  = error "params QQ is defined only exp."
      , quoteType = error "params QQ is defined only exp."
      , quoteDec  = error "params QQ is defined only exp."
      }
  
  -- | only get parameters in query string.
  getQueryParams :: Monad m => ActionT exts prms m HTTP.Query
  getQueryParams = Wai.queryString <$> getRequest
  
  getDocuments :: Monad m => ActionT exts prms m Documents
  getDocuments = liftM actionDocuments getEnv
  
  -- | parse request body into 'ActionReqBody' and return it. since 1.2.2.
  getReqBody :: MonadIO m => ActionT exts prms m ActionReqBody
  getReqBody = ActionT $ \_ e s c -> case actionReqBody s of
      Just  b -> c b s
      Nothing -> do
          let req  = actionRequest e
              config = actionConfig e
              rbody = Wai.requestBody =<< requestSizeCheck (maxRequestSize config) req
  
          b <- liftIO $ try (
              case P.getRequestBodyType req of
                  Nothing                  -> sinkRaw rbody
                  Just typ@P.UrlEncoded    -> sinkUrlEncoded typ rbody
                  Just typ@(P.Multipart _) ->
                      case uploadFilePath config of
                          Nothing -> sinkMultipartLBS typ rbody
                          Just p  -> sinkMultipartToDisk p typ rbody
              )
          case b of
              Left (RequestSizeException limit) ->
                  return $ Stop $ Wai.responseLBS HTTP.status413 [] $ B.toLazyByteString $
                      "Request body is too large(limit is "
                          `mappend` B.fromString (show limit) `mappend` " bytes)"
              Left _   ->
                  return $ Stop $ Wai.responseLBS HTTP.status400 [] $ "Bad Request"
  
              Right b' ->
                  c b' s { actionReqBody = Just b' }
    where
      sinkRaw rbody = do
          let loop front = do
                  bs <- rbody
                  if S.null bs
                      then return $ L.fromChunks $ front []
                      else loop $ front . (bs:)
          Unknown `liftM` loop id
  
      sinkUrlEncoded typ rbody = do
          (p, _) <- P.sinkRequestBody P.lbsBackEnd typ rbody
          return (UrlEncoded p)
  
      sinkMultipartLBS typ rbody = do
          (p, f) <- P.sinkRequestBody P.lbsBackEnd typ rbody
          let f' = map (\ (pn, P.FileInfo{..})
                      -> File pn fileName fileContentType (Left fileContent)
                  ) f
          return (Multipart p f')
  
      sinkMultipartToDisk path typ rbody = do
          internalState <- createInternalState
          (p, f) <-
              P.sinkRequestBody
                  (P.tempFileBackEndOpts (return path) "apiaryUpload" internalState)
                  typ
                  rbody
              `onException` closeInternalState internalState
          let f' = map (\ (pn, P.FileInfo{..})
                      -> File pn fileName fileContentType (Right fileContent)
                  ) f
          return (Multipart p f')
  
  getReqBodyInternal :: MonadIO m => ActionT exts prms m ([Param], [File])
  getReqBodyInternal = getReqBody >>= return . \case
      Unknown _       -> ([], [])
      UrlEncoded  p   -> (p, [])
      Multipart   p f -> (p, f)
  
  -- | parse request body and return params. since 1.0.0.
  getReqBodyParams :: MonadIO m => ActionT exts prms m [Param]
  getReqBodyParams = getReqBody >>= return . \case
      Unknown _       -> []
      UrlEncoded  p   -> p
      Multipart   p _ -> p
  
  -- | parse request body and return files. since 0.9.0.0.
  getReqBodyFiles :: MonadIO m => ActionT exts prms m [File]
  getReqBodyFiles = getReqBody >>= return . \case
      Multipart   _ f -> f
      _               -> []
  
  -- | parse request body and try parse it as JSON.
  --
  -- it's recommended to use 'Control.Monad.Apiary.Filter.jsonReqBody' filter
  -- to leverage type level routing instead of 'getReqBodyJSON'. since 2.0.0.
  getReqBodyJSON :: (MonadIO m, FromJSON a) => ActionT exts prms m (Maybe a)
  getReqBodyJSON = getReqBody >>= return . \case
      Unknown lbs     -> JSON.decode' lbs
      _               -> Nothing
  
  -- | get all request headers. since 0.6.0.0.
  getHeaders :: Monad m => ActionT exts prms m HTTP.RequestHeaders
  getHeaders = Wai.requestHeaders `liftM` getRequest
  
  --------------------------------------------------------------------------------
  
  modifyState :: Monad m => (ActionState -> ActionState) -> ActionT exts prms m ()
  modifyState f = ActionT $ \_ _ s c -> c () (f s)
  
  -- | set status code. since 0.1.0.0.
  status :: Monad m => HTTP.Status -> ActionT exts prms m ()
  status st = modifyState (\s -> s { actionStatus = st } )
  
  -- | modify response header. since 0.1.0.0.
  --
  -- Don't set Content-Type using this function. Use @contentType@.
  modifyHeader :: Monad m => (HTTP.ResponseHeaders -> HTTP.ResponseHeaders) -> ActionT exts prms m ()
  modifyHeader f = modifyState (\s -> s {actionHeaders = f $ actionHeaders s } )
  
  -- | add response header. since 0.1.0.0.
  --
  -- Don't set Content-Type using this function. Use @contentType@.
  addHeader :: Monad m => HTTP.HeaderName -> S.ByteString -> ActionT exts prms m ()
  addHeader h v = modifyHeader ((h,v):)
  
  -- | set response headers. since 0.1.0.0.
  --
  -- Don't set Content-Type using this function. Use @contentType@.
  setHeaders :: Monad m => HTTP.ResponseHeaders -> ActionT exts prms m ()
  setHeaders hs = modifyHeader (const hs)
  
  type ContentType = S.ByteString
  
  -- | set content-type header.
  --
  -- if content-type header already exists, replace it. since 0.1.0.0.
  contentType :: Monad m => ContentType -> ActionT exts prms m ()
  contentType c = modifyState (\s -> s { actionContentType = c } )
  
  getState :: ActionT exts prms m ActionState
  getState = ActionT $ \_ _ s c -> c s s
  
  -- | lookup extensional state. since v1.2.0.
  lookupVault :: V.Key a -> ActionT exts prms m (Maybe a)
  lookupVault k = V.lookup k . actionVault <$> getState
  
  -- | modify extensional state. since v1.2.0.
  modifyVault :: (V.Vault -> V.Vault) -> ActionT exts prms m ()
  modifyVault f = ActionT $ \_ _ s c -> c () (s {actionVault = f $ actionVault s})
  
  -- | insert extensional state. since v1.2.0.
  insertVault :: V.Key a -> a -> ActionT exts prms m ()
  insertVault k i = modifyVault $ V.insert k i
  
  -- | adjust extensional state. since v1.2.0.
  adjustVault :: (a -> a) -> V.Key a -> ActionT exts prms m ()
  adjustVault f k = modifyVault $ V.adjust f k
  
  -- | delete extensional state. since v1.2.0.
  deleteVault :: V.Key a -> ActionT exts prms m ()
  deleteVault k = modifyVault $ V.delete k
  
  --------------------------------------------------------------------------------
  
  -- | stop handler and send current state. since 0.3.3.0.
  stop :: Monad m => ActionT exts prms m a
  stop = ActionT $ \_ _ s _ -> return $ Stop (toResponse s)
  
  -- | stop with response. since 0.4.2.0.
  stopWith :: Monad m => Wai.Response -> ActionT exts prms m a
  stopWith a = ActionT $ \_ _ _ _ -> return $ Stop a
  
  -- | redirect handler
  --
  -- set status and add location header. since 0.3.3.0.
  --
  -- rename from redirect in 0.6.2.0.
  redirectWith :: Monad m
               => HTTP.Status
               -> S.ByteString -- ^ Location redirect to
               -> ActionT exts prms m ()
  redirectWith st url = do
      status st
      addHeader "location" url
  
  --      HTTP/1.0            HTTP/1.1
  -- 300                      MultipleChoices
  -- 301  MovedPermanently    MovedPermanently
  -- 302  MovedTemporarily    Found
  -- 303                      SeeOther
  -- 304  NotModified         NotModified
  -- 305                      UseProxy
  -- 307                      TemporaryRedirect
  
  -- | redirect with 301 Moved Permanently. since 0.3.3.0.
  redirectPermanently :: Monad m => S.ByteString -> ActionT exts prms m ()
  redirectPermanently = redirectWith HTTP.movedPermanently301
  
  -- | redirect with:
  --
  -- 303 See Other (HTTP/1.1)  or
  -- 302 Moved Temporarily (Other)
  --
  -- since 0.6.2.0.
  redirect :: Monad m => S.ByteString -> ActionT exts prms m ()
  redirect to = do
      v <- Wai.httpVersion <$> getRequest
      if v == HTTP.http11
          then redirectWith HTTP.seeOther303 to
          else redirectWith HTTP.status302   to
  
  -- | redirect with:
  --
  -- 307 Temporary Redirect (HTTP/1.1) or
  -- 302 Moved Temporarily (Other)
  --
  -- since 0.3.3.0.
  redirectTemporary :: Monad m => S.ByteString -> ActionT exts prms m ()
  redirectTemporary to = do
      v <- Wai.httpVersion <$> getRequest
      if v == HTTP.http11
          then redirectWith HTTP.temporaryRedirect307 to
          else redirectWith HTTP.status302            to
  
  -- | set raw response constructor. since 0.10.
  --
  -- example(use pipes-wai)
  --
  -- @
  -- producer :: Monad m => Producer (Flush Builder) IO () -> ActionT' exts m ()
  -- producer = response (\s h -> responseProducer s h)
  -- @
  --
  rawResponse :: Monad m => (HTTP.Status -> HTTP.ResponseHeaders -> Wai.Response) -> ActionT exts prms m ()
  rawResponse f = modifyState (\s -> s { actionResponse = ResponseFunc f } )
  
  -- | reset response body to no response. since v0.15.2.
  reset :: Monad m => ActionT exts prms m ()
  reset = modifyState (\s -> s { actionResponse = mempty } )
  
  -- | set response body file content, without set Content-Type. since 0.1.0.0.
  file' :: MonadIO m => FilePath -> Maybe Wai.FilePart -> ActionT exts prms m ()
  file' f p = modifyState (\s -> s { actionResponse = ResponseFile f p } )
  
  -- | set response body file content and detect Content-Type by extension. since 0.1.0.0.
  --
  -- file modification check since 0.17.2.
  file :: MonadIO m => FilePath -> Maybe Wai.FilePart -> ActionT exts prms m ()
  file f p = do
      mbims <- (>>= parseHTTPDate) . lookup "If-Modified-Since" <$> getHeaders
      e <- liftIO $ Files.fileExist f
      t <- if e
           then liftIO $ Just . epochTimeToHTTPDate . Files.modificationTime <$> Files.getFileStatus f
           else return Nothing
      case mbims of
          Just ims | maybe False (ims >=) t -> reset >> status HTTP.status304 >> stop
          _ -> do
              mime <- mimeType <$> getConfig
              contentType (mime f)
              maybe (return ()) (addHeader "Last-Modified" . formatHTTPDate) t
              file' f p
  
  devFile' :: MonadIO m => FilePath -> ActionT exts prms m ()
  devFile' f = liftIO (Files.fileExist f) >>= \e ->
      if e
      then liftIO (L.readFile f) >>= lazyBytes
      else mzero
  
  -- | send file contents as lazy bytestring response. since v1.1.4.
  devFile :: MonadIO m => FilePath -> ActionT exts prms m ()
  devFile f = do
      mime <- mimeType <$> getConfig
      contentType (mime f)
      devFile' f
  
  -- | set response body from builder. since 0.1.0.0.
  builder :: Monad m => Builder -> ActionT exts prms m ()
  builder b = modifyState (\s -> s { actionResponse = ResponseBuilder b } )
  
  -- | set response body from strict bytestring. since 0.15.2.
  bytes :: Monad m => S.ByteString -> ActionT exts prms m ()
  bytes = builder . B.fromByteString
  
  -- | set response body from lazy bytestring. since 0.15.2.
  lazyBytes :: Monad m => L.ByteString -> ActionT exts prms m ()
  lazyBytes = builder . B.fromLazyByteString
  
  -- | set response body from strict text. encoding UTF-8. since 0.15.2.
  text :: Monad m => T.Text -> ActionT exts prms m ()
  text = builder . B.fromText
  
  -- | set response body from lazy text. encoding UTF-8. since 0.15.2.
  lazyText :: Monad m => TL.Text -> ActionT exts prms m ()
  lazyText = builder . B.fromLazyText
  
  -- | set response body from show. encoding UTF-8. since 0.15.2.
  showing :: (Monad m, Show a) => a -> ActionT exts prms m ()
  showing = builder . B.fromShow
  
  -- | set response body from 'ToJSON' with content-type set to @application/json@. since 2.0.2
  json :: (Monad m, ToJSON a) => a -> ActionT exts prms m ()
  json x = do
      contentType "application/json"
      lazyBytes (JSON.encode x)
  
  -- | set response body from string. encoding UTF-8. since 0.15.2.
  string :: Monad m => String -> ActionT exts prms m ()
  string = builder . B.fromString
  
  -- | set response body from char. encoding UTF-8. since 0.15.2.
  char :: Monad m => Char -> ActionT exts prms m ()
  char = builder . B.fromChar
  
  -- | append response body from builder. since 1.2.0.
  appendBuilder :: Monad m => Builder -> ActionT exts prms m ()
  appendBuilder b = modifyState (\s -> s { actionResponse = actionResponse s `mappend` ResponseBuilder b } )
  
  -- | append response body from strict bytestring. since 1.2.0.
  appendBytes :: Monad m => S.ByteString -> ActionT exts prms m ()
  appendBytes = appendBuilder . B.fromByteString
  
  -- | append response body from lazy bytestring. since 1.2.0.
  appendLazyBytes :: Monad m => L.ByteString -> ActionT exts prms m ()
  appendLazyBytes = appendBuilder . B.fromLazyByteString
  
  -- | append response body from strict text. encoding UTF-8. since 1.2.0.
  appendText :: Monad m => T.Text -> ActionT exts prms m ()
  appendText = appendBuilder . B.fromText
  
  -- | append response body from lazy text. encoding UTF-8. since 1.2.0.
  appendLazyText :: Monad m => TL.Text -> ActionT exts prms m ()
  appendLazyText = appendBuilder . B.fromLazyText
  
  -- | append response body from show. encoding UTF-8. since 1.2.0.
  appendShowing :: (Monad m, Show a) => a -> ActionT exts prms m ()
  appendShowing = appendBuilder . B.fromShow
  
  -- | append response body from string. encoding UTF-8. since 1.2.0.
  appendString :: Monad m => String -> ActionT exts prms m ()
  appendString = appendBuilder . B.fromString
  
  -- | append response body from char. encoding UTF-8. since 1.2.0.
  appendChar :: Monad m => Char -> ActionT exts prms m ()
  appendChar = appendBuilder . B.fromChar
  
  -- | set response body source. since 0.9.0.0.
  stream :: Monad m => Wai.StreamingBody -> ActionT exts prms m ()
  stream str = modifyState (\s -> s { actionResponse = ResponseStream str })
  