-- | Integration of "Freckle.App" tooling with "Yesod"
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 UnliftIO.Exception (displayException, handleJust)
import Yesod.Core.Handler (HandlerFor, sendWaiResponse)

-- | Catch 'SqlError' when queries are canceled due to timeout and respond 503
--
-- Also logs and increments a metric.
--
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' but adding headers to the 503 response
respondQueryCanceledHeaders
  :: HasStatsClient site
  => ResponseHeaders
  -> HandlerFor site res
  -> HandlerFor site res
respondQueryCanceledHeaders :: forall site res.
HasStatsClient site =>
ResponseHeaders -> HandlerFor site res -> HandlerFor site res
respondQueryCanceledHeaders ResponseHeaders
headers = forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust SqlError -> Maybe SqlError
queryCanceled 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")