freckle-app 1.0.0.3 → 1.0.0.4
raw patch · 7 files changed
+130/−26 lines, 7 files
Files
- CHANGELOG.md +16/−0
- freckle-app.cabal +1/−2
- library/Freckle/App/Database.hs +44/−5
- library/Freckle/App/Time.hs +0/−10
- library/Freckle/App/Wai.hs +29/−4
- library/Freckle/App/Yesod.hs +39/−4
- package.yaml +1/−1
CHANGELOG.md view
@@ -1,3 +1,19 @@+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.0.0.4...main)++None.++## [v1.0.0.4](https://github.com/freckle/freckle-app/compare/v1.0.0.3...v1.0.0.4)++- Support seconds or milliseconds in `PGSTATEMENTTIMEOUT`++ NOTE: We consider this a non-breaking change because the environment variable+ interface is backwards-compatible. By normal Haskell rules, it would be major+ since it's changing the type of something exported.++- Add `respondQueryCanceled` Yesod Middlewares++- Add `makeRequestMetricsMiddleware`+ ## [v1.0.0.3](https://github.com/freckle/freckle-app/compare/v1.0.0.2...v1.0.0.3) - Add `package.yaml` to `extra-source-files`.
freckle-app.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: freckle-app-version: 1.0.0.3+version: 1.0.0.4 license: MIT license-file: LICENSE maintainer: Freckle Education@@ -40,7 +40,6 @@ Freckle.App.Test Freckle.App.Test.DocTest Freckle.App.Test.Hspec.Runner- Freckle.App.Time Freckle.App.Version Freckle.App.Wai Freckle.App.Yesod
library/Freckle/App/Database.hs view
@@ -10,13 +10,14 @@ -- * Abstract over access to a sql database HasSqlPool(..) , SqlPool- , Seconds(..) , makePostgresPool , makePostgresPoolWith , runDB , PostgresConnectionConf(..) , PostgresPasswordSource(..) , PostgresPassword(..)+ , PostgresStatementTimeout(..)+ , postgresStatementTimeoutMilliseconds , envParseDatabaseConf , envPostgresPasswordSource ) where@@ -30,6 +31,7 @@ import Control.Monad.Reader import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS8+import Data.Char (isDigit) import Data.IORef import Data.Pool import qualified Data.Text as T@@ -39,7 +41,6 @@ (Connection, Only(..), connectPostgreSQL, execute) import Database.PostgreSQL.Simple.SqlQQ (sql) import qualified Freckle.App.Env as Env-import Freckle.App.Time (Seconds(..)) import System.Process (readProcess) type SqlPool = Pool SqlBackend@@ -71,7 +72,7 @@ , pccPassword :: PostgresPassword , pccDatabase :: String , pccPoolSize :: Int- , pccStatementTimeout :: Seconds+ , pccStatementTimeout :: PostgresStatementTimeout } deriving stock (Show, Eq) @@ -85,6 +86,42 @@ | PostgresPasswordStatic String deriving stock (Show, Eq) +data PostgresStatementTimeout+ = PostgresStatementTimeoutSeconds Int+ | PostgresStatementTimeoutMilliseconds Int+ deriving stock (Show, Eq)++postgresStatementTimeoutMilliseconds :: PostgresStatementTimeout -> Int+postgresStatementTimeoutMilliseconds = \case+ PostgresStatementTimeoutSeconds s -> s * 1000+ PostgresStatementTimeoutMilliseconds ms -> ms++-- | Read @PGSTATEMENTTIMEOUT@ as seconds or milliseconds+--+-- >>> readPostgresStatementTimeout "10"+-- Right (PostgresStatementTimeoutSeconds 10)+--+-- >>> readPostgresStatementTimeout "10s"+-- Right (PostgresStatementTimeoutSeconds 10)+--+-- >>> readPostgresStatementTimeout "10ms"+-- Right (PostgresStatementTimeoutMilliseconds 10)+--+-- >>> readPostgresStatementTimeout "20m"+-- Left "..."+--+-- >>> readPostgresStatementTimeout "2m0"+-- Left "..."+--+readPostgresStatementTimeout+ :: String -> Either String PostgresStatementTimeout+readPostgresStatementTimeout x = case span isDigit x of+ ("", _) -> Left "must be {digits}(s|ms)"+ (digits, "") -> Right $ PostgresStatementTimeoutSeconds $ read digits+ (digits, "s") -> Right $ PostgresStatementTimeoutSeconds $ read digits+ (digits, "ms") -> Right $ PostgresStatementTimeoutMilliseconds $ read digits+ _ -> Left "must be {digits}(s|ms)"+ envPostgresPasswordSource :: Env.Parser PostgresPasswordSource envPostgresPasswordSource = do useIam <- Env.switch "USE_RDS_IAM_AUTH" $ Env.def False@@ -104,7 +141,9 @@ database <- Env.var Env.str "PGDATABASE" Env.nonEmpty port <- Env.var Env.auto "PGPORT" Env.nonEmpty poolSize <- Env.var Env.auto "PGPOOLSIZE" $ Env.def 1- statementTimeout <- Env.var Env.auto "PGSTATEMENTTIMEOUT" $ Env.def 120+ statementTimeout <-+ Env.var (Env.eitherReader readPostgresStatementTimeout) "PGSTATEMENTTIMEOUT"+ $ Env.def (PostgresStatementTimeoutSeconds 120) pure PostgresConnectionConf { pccHost = host , pccPort = port@@ -178,7 +217,7 @@ setTimeout :: PostgresConnectionConf -> Connection -> IO () setTimeout PostgresConnectionConf {..} conn =- let timeoutMillis = unSeconds pccStatementTimeout * 1000+ let timeoutMillis = postgresStatementTimeoutMilliseconds pccStatementTimeout in void $ execute conn [sql| SET statement_timeout = ? |] (Only timeoutMillis) makePostgresPoolWith :: PostgresConnectionConf -> IO SqlPool
− library/Freckle/App/Time.hs
@@ -1,10 +0,0 @@--- | Time types and functions for @App@-module Freckle.App.Time- ( Seconds(..)- ) where--import Prelude--newtype Seconds = Seconds { unSeconds :: Int }- deriving stock (Show, Read)- deriving newtype (Eq, Num)
library/Freckle/App/Wai.hs view
@@ -1,18 +1,21 @@+{-# LANGUAGE TupleSections #-}+ -- | Integration of "Freckle.App" tooling with "Network.Wai" module Freckle.App.Wai ( RouteName(..) , TraceId(..) , makeLoggingMiddleware+ , makeRequestMetricsMiddleware , noCacheMiddleware , corsMiddleware- )-where+ ) where import Prelude import Control.Applicative ((<|>)) import Control.Monad (guard) import Control.Monad.Logger (LogLevel(..))+import Control.Monad.Reader (runReaderT) import Data.Aeson import Data.Bifunctor (first) import Data.ByteString (ByteString)@@ -23,10 +26,13 @@ import qualified Data.CaseInsensitive as CI import Data.Default (def) import Data.IP (fromHostAddress, fromHostAddress6)-import Data.Maybe (fromMaybe)-import Data.Text (Text)+import Data.Maybe (fromMaybe, maybeToList)+import Data.Text (Text, pack) import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode)+import Data.Time (getCurrentTime)+import Freckle.App.Datadog (HasDogStatsClient, HasDogStatsTags)+import qualified Freckle.App.Datadog as Datadog import Freckle.App.Logging import Network.HTTP.Types (QueryItem, ResponseHeaders) import Network.HTTP.Types.Status (Status, status200, statusCode)@@ -158,6 +164,25 @@ sockAddrToIp (SockAddrInet _ h) = BS8.pack $ show $ fromHostAddress h sockAddrToIp (SockAddrInet6 _ _ h _) = BS8.pack $ show $ fromHostAddress6 h sockAddrToIp (SockAddrUnix _) = "<socket>"++makeRequestMetricsMiddleware+ :: (HasDogStatsClient env, HasDogStatsTags env)+ => env+ -> (Request -> Maybe RouteName)+ -> Middleware+makeRequestMetricsMiddleware env getRouteName app req sendResponse' = do+ start <- getCurrentTime+ app req $ \res -> do+ flip runReaderT env $ do+ Datadog.increment "requests" $ tags res+ Datadog.histogramSinceMs "response_time_ms" (tags res) start+ sendResponse' res+ where+ tags res =+ maybeToList (("route", ) . unRouteName <$> getRouteName req)+ <> [ ("method", decodeUtf8 $ requestMethod req)+ , ("status", pack $ show $ statusCode $ responseStatus res)+ ] noCacheMiddleware :: Middleware noCacheMiddleware = addHeaders [cacheControlHeader]
library/Freckle/App/Yesod.hs view
@@ -2,15 +2,24 @@ module Freckle.App.Yesod ( makeLogger , messageLoggerSource- )-where + -- * Functions for use as 'yesodMiddleware'+ , respondQueryCanceled+ , respondQueryCanceledHeaders+ ) where+ import Prelude -import Control.Monad (when)+import Control.Monad (guard, when) import Control.Monad.Logger+import Data.Text (pack)+import Database.PostgreSQL.Simple (SqlError(..))+import Freckle.App.Datadog (HasDogStatsClient, HasDogStatsTags)+import qualified Freckle.App.Datadog as Datadog import Freckle.App.GlobalCache import Freckle.App.Logging+import Network.HTTP.Types (ResponseHeaders, status503)+import qualified Network.Wai as W import System.IO.Unsafe (unsafePerformIO) import System.Log.FastLogger ( LoggerSet@@ -19,7 +28,9 @@ , newStderrLoggerSet , newStdoutLoggerSet )-import Yesod.Core.Types (Logger, loggerPutStr)+import UnliftIO.Exception (handleJust)+import Yesod.Core.Handler (sendWaiResponse)+import Yesod.Core.Types (HandlerFor, Logger, loggerPutStr) import Yesod.Default.Config2 (makeYesodLogger) loggerSetVar :: GlobalCache LoggerSet@@ -53,3 +64,27 @@ FormatJSON -> formatJsonLogStr loc src level str FormatTerminal -> formatTerminal (getLogDefaultANSI app) loc src level str++-- | Catch 'SqlError' when queries are canceled due to timeout and respond 503+--+-- Also logs and increments a metric.+--+respondQueryCanceled+ :: (HasDogStatsClient site, HasDogStatsTags site)+ => HandlerFor site res+ -> HandlerFor site res+respondQueryCanceled = respondQueryCanceledHeaders []++-- | 'respondQueryCanceledHeaders' but adding headers to the 503 response+respondQueryCanceledHeaders+ :: (HasDogStatsClient site, HasDogStatsTags site)+ => ResponseHeaders+ -> HandlerFor site res+ -> HandlerFor site res+respondQueryCanceledHeaders headers = handleJust queryCanceled $ \ex -> do+ logErrorN $ pack $ show ex+ Datadog.increment "query_canceled" []+ sendWaiResponse $ W.responseLBS status503 headers "Query canceled"++queryCanceled :: SqlError -> Maybe SqlError+queryCanceled ex = ex <$ guard (sqlState ex == "57014")
package.yaml view
@@ -1,6 +1,6 @@ --- name: freckle-app-version: 1.0.0.3+version: 1.0.0.4 maintainer: Freckle Education category: Utils github: freckle/freckle-app