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
  case healthReport' of
    Nothing -> 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
    Just (lastUpdated, healthReport) -> do
      rContent <- 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

      interval <- getsYesod $ view _appHealthCheckInterval
      expiresAt $ interval `addUTCTime` lastUpdated
      addHeader "Last-Modified" $ formatRFC1123 lastUpdated
      let
        status 
          | HealthSuccess <- classifyHealthReport healthReport
          = ok200
          | otherwise
          = internalServerError500
      sendResponseStatus status rContent

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