module Freckle.App.Yesod
( respondQueryCanceled
, respondQueryCanceledHeaders
) where
import Freckle.App.Prelude
import Blammo.Logging
import Database.PostgreSQL.Simple (SqlError (..))
import Freckle.App.Stats (HasStatsClient)
import qualified Freckle.App.Stats as Stats
import Network.HTTP.Types (ResponseHeaders, status503)
import qualified Network.Wai as W
import Yesod.Core.Handler (HandlerFor, sendWaiResponse)
respondQueryCanceled
:: HasStatsClient site => HandlerFor site res -> HandlerFor site res
respondQueryCanceled :: forall site res.
HasStatsClient site =>
HandlerFor site res -> HandlerFor site res
respondQueryCanceled = forall site res.
HasStatsClient site =>
ResponseHeaders -> HandlerFor site res -> HandlerFor site res
respondQueryCanceledHeaders []
respondQueryCanceledHeaders
:: HasStatsClient site
=> ResponseHeaders
-> HandlerFor site res
-> HandlerFor site res
ResponseHeaders
headers HandlerFor site res
handler =
forall e b (m :: * -> *) a.
(Exception e, MonadUnliftIO m, HasCallStack) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust SqlError -> Maybe SqlError
queryCanceled HandlerFor site res
handler forall a b. (a -> b) -> a -> b
$ \SqlError
ex -> do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError forall a b. (a -> b) -> a -> b
$ Text
"Query canceled" Text -> [SeriesElem] -> Message
:# [Key
"exception" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall e. Exception e => e -> String
displayException SqlError
ex]
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasStatsClient env) =>
Text -> m ()
Stats.increment Text
"query_canceled"
forall (m :: * -> *) b. MonadHandler m => Response -> m b
sendWaiResponse forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
W.responseLBS Status
status503 ResponseHeaders
headers ByteString
"Query canceled"
queryCanceled :: SqlError -> Maybe SqlError
queryCanceled :: SqlError -> Maybe SqlError
queryCanceled SqlError
ex = SqlError
ex forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SqlError -> ByteString
sqlState SqlError
ex forall a. Eq a => a -> a -> Bool
== ByteString
"57014")