module Handler.Health where

import Import

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

import Utils.Lens

import qualified Data.UUID as UUID


getHealthR :: Handler TypedContent
getHealthR = do
  healthReport' <- liftIO . readTVarIO =<< getsYesod appHealthReport
  let
    handleMissing = do
      interval <- getsYesod $ round . (* 1e6) . toRational . view _appHealthCheckInterval
      reportStore <- getsYesod appHealthReport
      waitResult <- threadDelay interval `race` atomically (readTVar reportStore >>= guard . is _Just)
      case waitResult of
        Left () -> fail "System is not generating HealthReports"
        Right _ -> redirect HealthR
  (lastUpdated, healthReport) <- maybe handleMissing return healthReport'
  interval <- getsYesod $ view _appHealthCheckInterval
  instanceId <- getsYesod appInstanceID

  setWeakEtagHashable (instanceId, lastUpdated)
  expiresAt $ interval `addUTCTime` lastUpdated
  setLastModified lastUpdated
  
  let status 
        | HealthSuccess <- classifyHealthReport healthReport
        = ok200
        | otherwise
        = internalServerError500
  sendResponseStatus status <=< selectRep $ do
    provideRep . siteLayoutMsg MsgHealthReport $ do
      setTitleI MsgHealthReport
      let HealthReport{..} = healthReport
      [whamlet|
        $newline never
        <dl .deflist>
          <dt .deflist__dt>_{MsgHealthMatchingClusterConfig}
          <dd .deflist__dd>#{boolSymbol healthMatchingClusterConfig}
          $maybe httpReachable <- healthHTTPReachable
            <dt .deflist__dt>_{MsgHealthHTTPReachable}
            <dd .deflist__dd>#{boolSymbol httpReachable}
          $maybe ldapAdmins <- healthLDAPAdmins
            <dt .deflist__dt>_{MsgHealthLDAPAdmins}
            <dd .deflist__dd>#{textPercent ldapAdmins}
          $maybe smtpConnect <- healthSMTPConnect
            <dt .deflist__dt>_{MsgHealthSMTPConnect}
            <dd .deflist__dd>#{boolSymbol smtpConnect}
          $maybe widgetMemcached <- healthWidgetMemcached
            <dt .deflist__dt>_{MsgHealthWidgetMemcached}
            <dd .deflist__dd>#{boolSymbol widgetMemcached}
      |]
    provideJson healthReport
    provideRep . return . Builder.toLazyText $ Aeson.encodePrettyToTextBuilder healthReport

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