diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 4f8494fdf..3052f652f 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -55,6 +55,7 @@ module Database.Esqueleto.Utils , day, day', dayMaybe, interval, diffDays, diffTimes , exprLift , explicitUnsafeCoerceSqlExprValue + , psqlVersion_ , truncateTable , module Database.Esqueleto.Utils.TH ) where @@ -814,6 +815,8 @@ instance (PersistField a1, PersistField a2, PersistField b, Finite a1, Finite a2 ] (E.else_ $ E.else_ $ E.veryUnsafeCoerceSqlExprValue (E.nothing :: E.SqlExpr (E.Value (Maybe ())))) +psqlVersion_ :: E.SqlExpr (E.Value Text) +psqlVersion_ = E.unsafeSqlFunction "VERSION" () -- Suspected to cause trouble. Needs more testing! -- truncateTable :: (MonadIO m, BackendCompatible SqlBackend backend, PersistEntity record) diff --git a/src/Handler/Admin/Test.hs b/src/Handler/Admin/Test.hs index 86e96ddcc..cbd23f3ae 100644 --- a/src/Handler/Admin/Test.hs +++ b/src/Handler/Admin/Test.hs @@ -28,7 +28,9 @@ import Text.Hamlet -- import Handler.Utils.I18n import Handler.Admin.Test.Download (testDownload) - +import qualified Database.Esqueleto.Experimental as E (selectOne, unValue) +import qualified Database.Esqueleto.PostgreSQL as E (now_) +import qualified Database.Esqueleto.Utils as E (psqlVersion_) -- BEGIN - Buttons needed only here data ButtonCreate = CreateMath | CreateInf | CrashApp -- Dummy for Example @@ -226,6 +228,9 @@ postAdminTestR = do UniWorX{ appSettings' = AppSettings{..} } <- getYesod + psqlVersion <- runDBRead $ E.selectOne $ return E.psqlVersion_ + dbTime <- runDBRead $ E.selectOne $ return E.now_ + let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|] siteLayout locallyDefinedPageHeading $ do -- defaultLayout $ do @@ -327,6 +332,17 @@ postAdminTestR = do
#{tshow appSynchroniseAvsUsersWithin} |] + [whamlet| +
+

PostgreSQL Information +
+ $maybe pver <- psqlVersion +
DB Version +
#{E.unValue pver} + $maybe ptme <- dbTime +
DB Time +
#{tshow (E.unValue ptme)} + |] diff --git a/src/Handler/Health.hs b/src/Handler/Health.hs index 69db731e1..708feea8f 100644 --- a/src/Handler/Health.hs +++ b/src/Handler/Health.hs @@ -20,6 +20,9 @@ import Control.Concurrent.STM.Delay import System.Environment (lookupEnv) -- while git version number is not working +import qualified Database.Esqueleto.Experimental as E +import qualified Database.Esqueleto.PostgreSQL as E (now_) + -- import Data.FileEmbed (embedStringFile) getHealthR :: Handler TypedContent @@ -114,10 +117,16 @@ getInstanceR = do getStatusR :: Handler Html getStatusR = do starttime <- getsYesod appStartTime - (currtime, env_version) <- liftIO $ (,) <$> getCurrentTime <*> lookupEnv "VERSION_NR" + dbTime <- runDBRead $ E.selectOne $ return E.now_ + (currtime,env_version) <- liftIO $ (,) <$> getCurrentTime <*> lookupEnv "VERSION_NR" -- ft <- formatTime' "%Y-%m-%d %H:%M:%S" currtime let diffTime :: UTCTime -> Text - diffTime = pack . iso8601Show . calendarTimeTime . fromIntegral . truncate . diffUTCTime currtime + diffTime t = + let tdiff = diffUTCTime currtime t + in if 64 > abs tdiff + then tshow tdiff + else pack . iso8601Show . calendarTimeTime . fromIntegral $ truncate tdiff + withUrlRenderer [hamlet| $doctype 5 @@ -129,8 +138,13 @@ getStatusR = do

Environment version #{env_ver}

- Current Time
+ Current Application Time
#{show currtime}
+ $maybe dbtval <- dbTime + $with dbt <- E.unValue dbtval + Current Database Time
+ #{show dbt} # + Difference: #{diffTime dbt}

Instance Start
#{show starttime} #