module Handler.Health where

import Import

-- import Handler.Utils

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

import Language.Haskell.TH (stringE,runIO)

-- import Data.FileEmbed (embedStringFile)

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 .uuid>#{UUID.toText clusterId}
            <dt .deflist__dt>_{MsgInstanceId}
            <dd .deflist__dd .uuid>#{UUID.toText instanceId}
        |]
    provideJson instanceInfo
    provideRep . return $ tshow instanceInfo


-- Most simple page for simple liveness checks
getStatusR :: Handler Html
getStatusR = do
  starttime <- getsYesod appStartTime
  currtime <- liftIO getCurrentTime    
  -- ft <- formatTime'  "%Y-%m-%d %H:%M:%S" currtime
  withUrlRenderer 
    [hamlet|
      $doctype 5
      <html lang=en>
        <head>        
          <title>Status
        <body>
          <p> 
            Current Time <br> 
            #{show currtime} <br>     
          <p>
            Instance Start <br> 
            #{show starttime} #
            Uptime: #{show $ ddays starttime currtime} days.
          <p>
            Compile Time <br>
            #{comptime} #
            $maybe ctime <- readMay comptime 
              Build age: #{show $ ddays ctime currtime} days.
    |]
  where 
    -- vnr_full :: Text = $(embedStringFile "nix/docker/version.json") -- nix/ files not accessible during container construction

    comptime :: Text 
    comptime = $(stringE =<< runIO (show <$> getCurrentTime))
    
    ddays :: UTCTime -> UTCTime -> Double
    ddays tstart tstop = (/100) $ fromIntegral $ round $ diffUTCTime tstop tstart / (36 * 24)
