From 69cc5783217e0e910fad83aff98b60bfcbd1bc62 Mon Sep 17 00:00:00 2001 From: ciukstar Date: Fri, 27 Oct 2023 19:33:54 +0300 Subject: [PATCH] Make persistent a local deps and increase connectionPoolConfigIdleTimeout from 600 to 1200 (20min > 15min grace time) --- config/settings.yml | 1 + package.yaml | 2 +- src/Admin/Business.hs | 2 + src/Application.hs | 57 +++++++++++++++---------- src/Settings.hs | 7 ++- stack.yaml | 3 ++ templates/book/customer/banner.hamlet | 2 +- templates/book/customer/customer.hamlet | 7 +-- templates/book/end.hamlet | 2 +- templates/book/offers/banner.hamlet | 2 +- templates/book/offers/items.cassius | 3 -- templates/book/staff/banner.hamlet | 2 +- templates/book/staff/empls.hamlet | 16 ++++--- templates/book/staff/staff.hamlet | 2 +- templates/book/time/banner.hamlet | 2 +- templates/book/time/time.hamlet | 2 +- 16 files changed, 67 insertions(+), 45 deletions(-) diff --git a/config/settings.yml b/config/settings.yml index 12e4c86..f213337 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -35,6 +35,7 @@ database: # See config/test-settings.yml for an override during tests database: "_env:YESOD_SQLITE_DATABASE:':memory:'" poolsize: "_env:YESOD_SQLITE_POOLSIZE:1" +idle-timeout: "_env:YESOD_SQLITE_IDLETIMEOUT:1200" copyright: Insert copyright statement here #analytics: UA-YOURCODE diff --git a/package.yaml b/package.yaml index 2f261e4..458b395 100644 --- a/package.yaml +++ b/package.yaml @@ -15,7 +15,6 @@ dependencies: - classy-prelude-yesod - bytestring - text -- persistent - persistent-sqlite - persistent-template - template-haskell @@ -49,6 +48,7 @@ dependencies: - base64-bytestring - transformers - blaze-html +- persistent # The library contains all of our application code. The executable # defined below is just a thin wrapper. diff --git a/src/Admin/Business.hs b/src/Admin/Business.hs index 063dcae..d45fc37 100644 --- a/src/Admin/Business.hs +++ b/src/Admin/Business.hs @@ -239,6 +239,7 @@ getBusinessCalendarR bid = do langs <- languages user <- maybeAuth curr <- getCurrentRoute + setUltDestCurrent msgs <- getMessages pivot <- utctDay <$> liftIO getCurrentTime @@ -364,6 +365,7 @@ getBusinessHoursR bid = do return x user <- maybeAuth curr <- getCurrentRoute + setUltDestCurrent msgs <- getMessages fabBusinessHoursCreate <- newIdent defaultLayout $ do diff --git a/src/Application.hs b/src/Application.hs index 7fae3ea..da1bb98 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -21,30 +21,39 @@ module Application , db ) where -import Control.Monad.Logger (liftLoc, runLoggingT) -import Database.Persist.Sqlite (createSqlitePool, runSqlPool, - sqlDatabase, sqlPoolSize) + import Import -import Language.Haskell.TH.Syntax (qLocation) -import Network.HTTP.Client.TLS (getGlobalManager) +import Control.Monad.Logger (liftLoc, runLoggingT) +import Database.Persist.Sql + ( ConnectionPoolConfig + ( ConnectionPoolConfig, connectionPoolConfigStripes + , connectionPoolConfigIdleTimeout, connectionPoolConfigSize + ) + ) +import Database.Persist.Sqlite + ( createSqlitePoolWithConfig, runSqlPool, sqlDatabase, sqlPoolSize ) +import Language.Haskell.TH.Syntax (qLocation) +import Network.HTTP.Client.TLS (getGlobalManager) import Network.Wai (Middleware) -import Network.Wai.Handler.Warp (Settings, defaultSettings, - defaultShouldDisplayException, - runSettings, setHost, - setOnException, setPort, getPort) -import Network.Wai.Middleware.RequestLogger (Destination (Logger), - IPAddrSource (..), - OutputFormat (..), destination, - mkRequestLogger, outputFormat) -import Network.Wai.Middleware.Gzip (gzip, GzipSettings (gzipFiles), GzipFiles (GzipCompress)) -import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, - toLogStr) +import Network.Wai.Handler.Warp + ( Settings, defaultSettings, defaultShouldDisplayException,runSettings + , setHost, setOnException, setPort, getPort + ) +import Network.Wai.Middleware.RequestLogger + ( Destination (Logger), IPAddrSource (..), OutputFormat (..), destination + , mkRequestLogger, outputFormat + ) +import Network.Wai.Middleware.Gzip + ( gzip, GzipSettings (gzipFiles), GzipFiles (GzipCompress) ) +import System.Environment.Blank (getEnv) +import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr) + + import Demo.DemoDataFR (populateFR) import Demo.DemoDataRO (populateRO) import Demo.DemoDataRU (populateRU) import Demo.DemoDataEN (populateEN) -import System.Environment.Blank (getEnv) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! @@ -61,7 +70,7 @@ import Handler.Appointments , postAppointmentR, postAppointmentCancelR, getAppointmentHistR , getAppointmentRescheduleR, postAppointmentApproveR ) - + import Handler.Contacts (getContactR) import Handler.Book ( getBookOffersR, postBookOffersR @@ -122,12 +131,12 @@ import Admin.Contacts , postAdmContactsEditR , postAdmContactsDeleteR ) - + import Admin.About ( getAdmAboutR, getAdmAboutCreateR, postAdmAboutR , getAdmAboutEditR, postAdmAboutEditR, postAdmAboutDeleteR ) - + import Admin.Staff ( getAdmStaffR, getAdmStaffCreateR, getAdmStaffPhotoR , getAdmEmplR, postAdmEmplR, getAdmStaffEditR, getAdmScheduleR @@ -164,6 +173,7 @@ import Handler.Common ( getFaviconR, getRobotsR, getPhotoPlaceholderR ) + -- This line actually creates our YesodDispatch instance. It is the second half -- of the call to mkYesodData which occurs in Foundation.hs. Please see the -- comments there for more details. @@ -196,9 +206,12 @@ makeFoundation appSettings = do logFunc = messageLoggerSource tempFoundation appLogger -- Create the database connection pool - pool <- flip runLoggingT logFunc $ createSqlitePool + pool <- flip runLoggingT logFunc $ createSqlitePoolWithConfig (sqlDatabase $ appDatabaseConf appSettings) - (sqlPoolSize $ appDatabaseConf appSettings) + ConnectionPoolConfig { connectionPoolConfigStripes = 1 + , connectionPoolConfigIdleTimeout = appIdleTimeout appSettings + , connectionPoolConfigSize = sqlPoolSize $ appDatabaseConf appSettings + } -- Perform database migration using our application's logging settings. flip runLoggingT logFunc $ flip runSqlPool pool $ do diff --git a/src/Settings.hs b/src/Settings.hs index 5da2963..005507d 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -15,13 +15,14 @@ import qualified Control.Exception as Exception import Data.Aeson (Result (..), fromJSON, withObject, (.!=), (.:?)) import Data.FileEmbed (embedFile) +import Data.Time.Clock (NominalDiffTime) import Data.Yaml (decodeEither') import Database.Persist.Sqlite (SqliteConf) import Language.Haskell.TH.Syntax (Exp, Name, Q) import Network.Wai.Handler.Warp (HostPreference) import Yesod.Default.Config2 (applyEnvValue, configSettingsYml) -import Yesod.Default.Util (WidgetFileSettings, widgetFileNoReload, - widgetFileReload) +import Yesod.Default.Util + ( WidgetFileSettings, widgetFileNoReload, widgetFileReload ) -- | Runtime settings to configure this application. These settings can be -- loaded from various sources: defaults, environment variables, config files, @@ -30,6 +31,7 @@ data AppSettings = AppSettings { appStaticDir :: String -- ^ Directory from which to serve static files. , appDatabaseConf :: SqliteConf + , appIdleTimeout :: NominalDiffTime -- ^ Configuration settings for accessing the database. , appRoot :: Maybe Text -- ^ Base for all generated URLs. If @Nothing@, determined @@ -73,6 +75,7 @@ instance FromJSON AppSettings where #endif appStaticDir <- o .: "static-dir" appDatabaseConf <- o .: "database" + appIdleTimeout <- o .: "idle-timeout" appRoot <- o .:? "approot" appHost <- fromString <$> o .: "host" appPort <- o .: "port" diff --git a/stack.yaml b/stack.yaml index eff8f10..a4a3938 100644 --- a/stack.yaml +++ b/stack.yaml @@ -31,6 +31,9 @@ resolver: # - wai packages: - . +- ../../github-forks/persistent/persistent +- ../../github-forks/persistent/persistent-sqlite + # Dependency packages to be pulled from upstream that are not in the resolver. # These entries can reference officially published versions as well as # forks / in-progress versions pinned to a git hash. For example: diff --git a/templates/book/customer/banner.hamlet b/templates/book/customer/banner.hamlet index 83d7550..3fbc469 100644 --- a/templates/book/customer/banner.hamlet +++ b/templates/book/customer/banner.hamlet @@ -13,7 +13,7 @@
_{MsgCustomerInformation} - + $maybe Entity uid _ <- user diff --git a/templates/book/customer/customer.hamlet b/templates/book/customer/customer.hamlet index 4e0349b..2adbf59 100644 --- a/templates/book/customer/customer.hamlet +++ b/templates/book/customer/customer.hamlet @@ -13,7 +13,7 @@
_{MsgCustomerInformation} - + $maybe Entity uid _ <- user @@ -60,7 +60,7 @@ $maybe fname <- fname #{fname} - + _{MsgNotYourAccount}? _{MsgLogin} $nothing @@ -71,7 +71,8 @@ _{MsgSignUp}
- _{MsgAlreadyHaveAnAccount}? + + _{MsgAlreadyHaveAnAccount}? diff --git a/templates/book/end.hamlet b/templates/book/end.hamlet index 85e058c..1d9148a 100644 --- a/templates/book/end.hamlet +++ b/templates/book/end.hamlet @@ -8,7 +8,7 @@ _{MsgEnd} - + $maybe Entity uid _ <- user diff --git a/templates/book/offers/banner.hamlet b/templates/book/offers/banner.hamlet index 90f2c2a..31fe3a9 100644 --- a/templates/book/offers/banner.hamlet +++ b/templates/book/offers/banner.hamlet @@ -13,7 +13,7 @@
_{MsgChooseServicesToBook} - + diff --git a/templates/book/offers/items.cassius b/templates/book/offers/items.cassius index c9814ad..b6ad6c6 100644 --- a/templates/book/offers/items.cassius +++ b/templates/book/offers/items.cassius @@ -3,8 +3,5 @@ ul.mdc-list##{theId} span.mdc-list-item__content div.mdc-list-item__primary-text color: var(--theme-accent) - div.mdc-list-item__secondary-text - color: var(--theme-accent) - opacity: 0.6 \ No newline at end of file diff --git a/templates/book/staff/banner.hamlet b/templates/book/staff/banner.hamlet index d6c45af..7971722 100644 --- a/templates/book/staff/banner.hamlet +++ b/templates/book/staff/banner.hamlet @@ -13,7 +13,7 @@
_{MsgSelectStaff} - + $maybe Entity uid _ <- user diff --git a/templates/book/staff/empls.hamlet b/templates/book/staff/empls.hamlet index d42b9bd..4806a6d 100644 --- a/templates/book/staff/empls.hamlet +++ b/templates/book/staff/empls.hamlet @@ -1,5 +1,5 @@ - - + @@ -13,16 +13,17 @@ - + - + $forall e@(Entity sid (Staff sname _ _ _ _ _), Entity rid (Role _ _ rname rating)) <- options $with checked <- isChecked eval e - @@ -41,10 +42,11 @@ ★ - + - + diff --git a/templates/book/staff/staff.hamlet b/templates/book/staff/staff.hamlet index 921ed3f..0c36bc3 100644 --- a/templates/book/staff/staff.hamlet +++ b/templates/book/staff/staff.hamlet @@ -13,7 +13,7 @@
_{MsgSelectStaff} - + $maybe Entity uid _ <- user diff --git a/templates/book/time/banner.hamlet b/templates/book/time/banner.hamlet index da634da..48e28e4 100644 --- a/templates/book/time/banner.hamlet +++ b/templates/book/time/banner.hamlet @@ -13,7 +13,7 @@
_{MsgAppointmentTime} - + $maybe Entity uid _ <- user diff --git a/templates/book/time/time.hamlet b/templates/book/time/time.hamlet index 452e8b0..ea7156f 100644 --- a/templates/book/time/time.hamlet +++ b/templates/book/time/time.hamlet @@ -13,7 +13,7 @@
_{MsgAppointmentTime} - + $maybe Entity uid _ <- user