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 Data.Semigroup (Min(..), Max(..))

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