module Handler.Health where

import Import

import qualified Data.Aeson.Encode.Pretty as Aeson
import qualified Data.Text.Lazy.Builder as Builder

import qualified Data.UUID as UUID

import qualified Data.Set as Set

import Control.Concurrent.STM.Delay


getHealthR :: Handler TypedContent
getHealthR = do
  reportStore <- getsYesod appHealthReport
  healthReports' <- liftIO $ readTVarIO reportStore
  interval <- getsYesod $ view _appHealthCheckInterval

  case fromNullable healthReports' of
    Nothing -> do
      let Min (NTop minInterval) = ofoldMap1 (Min . NTop) $ impureNonNull interval
      delay <- for minInterval $ \minInterval' -> liftIO . newDelay . round $ toRational minInterval' * 1e6
      waitResult <- atomically $ maybe (pure $ Left False) (fmap (const $ Left True) . waitDelay) delay <|> (fmap Right . assertM (not. Set.null) $ readTVar reportStore)
      case waitResult of
        Left False -> sendResponseStatus noContent204 ()
        Left True  -> sendResponseStatus internalServerError500 ("System is not generating HealthReports" :: Text)
        Right _    -> redirect HealthR
    Just healthReports -> do
      let (Max lastUpdated, Min status) = ofoldMap1 (Max *** Min . healthReportStatus) healthReports
          reportNextUpdate (lastCheck, classifyHealthReport -> kind)
            = fromMaybe 0 (interval kind) `addUTCTime` lastCheck
          Max nextUpdate = ofoldMap1 (Max . reportNextUpdate) healthReports
      instanceId <- getsYesod appInstanceID

      setWeakEtagHashable (instanceId, lastUpdated)
      expiresAt nextUpdate
      setLastModified lastUpdated

      let status'
            | HealthSuccess <- status
            = ok200
            | otherwise
            = internalServerError500
      sendResponseStatus status' <=< selectRep $ do
        provideRep . siteLayoutMsg MsgHealthReport $ do
          setTitleI MsgHealthReport
          [whamlet|
            $newline never
            <dl .deflist>
              $forall (_, report) <- healthReports'
                $case report
                  $of HealthMatchingClusterConfig passed
                    <dt .deflist__dt>_{MsgHealthMatchingClusterConfig}
                    <dd .deflist__dd>#{boolSymbol passed}
                  $of HealthHTTPReachable (Just passed)
                    <dt .deflist__dt>_{MsgHealthHTTPReachable}
                    <dd .deflist__dd>#{boolSymbol passed}
                  $of HealthLDAPAdmins (Just found)
                    <dt .deflist__dt>_{MsgHealthLDAPAdmins}
                    <dd .deflist__dd>#{textPercent found 1}
                  $of HealthSMTPConnect (Just passed)
                    <dt .deflist__dt>_{MsgHealthSMTPConnect}
                    <dd .deflist__dd>#{boolSymbol passed}
                  $of HealthWidgetMemcached (Just passed)
                    <dt .deflist__dt>_{MsgHealthWidgetMemcached}
                    <dd .deflist__dd>#{boolSymbol passed}
                  $of HealthActiveJobExecutors (Just active)
                    <dt .deflist__dt>_{MsgHealthActiveJobExecutors}
                    <dd .deflist__dd>#{textPercent active 1}
                  $of _
          |]
        provideJson healthReports
        provideRep . return . Builder.toLazyText $ Aeson.encodePrettyToTextBuilder healthReports

getInstanceR :: Handler TypedContent
getInstanceR = do
  instanceInfo@(clusterId, instanceId) <- getsYesod $ (,) <$> appClusterID <*> appInstanceID

  setWeakEtagHashable (clusterId, instanceId)

  selectRep $ do
    provideRep $
      siteLayoutMsg MsgInstanceIdentification $ do
        setTitleI MsgInstanceIdentification
        [whamlet|
          $newline never
          <dl .deflist>
            <dt .deflist__dt>_{MsgClusterId}
            <dd .deflist__dd style="font-family: monospace">#{UUID.toText clusterId}
            <dt .deflist__dt>_{MsgInstanceId}
            <dd .deflist__dd style="font-family: monospace">#{UUID.toText instanceId}
        |]
    provideJson instanceInfo
    provideRep . return $ tshow instanceInfo