src/Ganeti/Monitoring/Server.hs

{-# LANGUAGE OverloadedStrings #-}

{-| Implementation of the Ganeti confd server functionality.

-}

{-

Copyright (C) 2013 Google Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

module Ganeti.Monitoring.Server
  ( main
  , checkMain
  , prepMain
  ) where

import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Data.ByteString.Char8 hiding (map, filter, find)
import Data.List
import Snap.Core
import Snap.Http.Server
import qualified Text.JSON as J

import qualified Ganeti.BasicTypes as BT
import Ganeti.Daemon
import qualified Ganeti.DataCollectors.Diskstats as Diskstats
import qualified Ganeti.DataCollectors.Drbd as Drbd
import qualified Ganeti.DataCollectors.InstStatus as InstStatus
import qualified Ganeti.DataCollectors.Lv as Lv
import Ganeti.DataCollectors.Types
import qualified Ganeti.Constants as C

-- * Types and constants definitions

-- | Type alias for checkMain results.
type CheckResult = ()

-- | Type alias for prepMain results.
type PrepResult = Config Snap ()

-- | Version of the latest supported http API.
latestAPIVersion :: Int
latestAPIVersion = 1

-- | Type describing a data collector basic information
data DataCollector = DataCollector
  { dName     :: String           -- ^ Name of the data collector
  , dCategory :: Maybe DCCategory -- ^ Category (storage, instance, ecc)
                                  --   of the collector
  , dKind     :: DCKind           -- ^ Kind (performance or status reporting) of
                                  --   the data collector
  , dReport   :: IO DCReport      -- ^ Report produced by the collector
  }

-- | The list of available builtin data collectors.
collectors :: [DataCollector]
collectors =
  [ DataCollector Diskstats.dcName Diskstats.dcCategory Diskstats.dcKind
      Diskstats.dcReport
  , DataCollector Drbd.dcName Drbd.dcCategory Drbd.dcKind Drbd.dcReport
  , DataCollector InstStatus.dcName InstStatus.dcCategory InstStatus.dcKind
      InstStatus.dcReport
  , DataCollector Lv.dcName Lv.dcCategory Lv.dcKind Lv.dcReport
  ]

-- * Configuration handling

-- | The default configuration for the HTTP server.
defaultHttpConf :: Config Snap ()
defaultHttpConf =
  setAccessLog (ConfigFileLog C.daemonsExtraLogfilesGanetiMondAccess) .
  setCompression False .
  setErrorLog (ConfigFileLog C.daemonsExtraLogfilesGanetiMondError) $
  setVerbose False
  emptyConfig

-- * Helper functions

-- | Check function for the monitoring agent.
checkMain :: CheckFn CheckResult
checkMain _ = return $ Right ()

-- | Prepare function for monitoring agent.
prepMain :: PrepFn CheckResult PrepResult
prepMain opts _ =
  return $
    setPort (maybe C.defaultMondPort fromIntegral (optPort opts))
      defaultHttpConf

-- * Query answers

-- | Reply to the supported API version numbers query.
versionQ :: Snap ()
versionQ = writeBS . pack $ J.encode [latestAPIVersion]

-- | Version 1 of the monitoring HTTP API.
version1Api :: Snap ()
version1Api =
  let returnNull = writeBS . pack $ J.encode J.JSNull :: Snap ()
  in ifTop returnNull <|>
     route
       [ ("list", listHandler)
       , ("report", reportHandler)
       ]

-- | Get the JSON representation of a data collector to be used in the collector
-- list.
dcListItem :: DataCollector -> J.JSValue
dcListItem dc =
  J.JSArray
    [ J.showJSON $ dName dc
    , maybe J.JSNull J.showJSON $ dCategory dc
    , J.showJSON $ dKind dc
    ]

-- | Handler for returning lists.
listHandler :: Snap ()
listHandler =
  dir "collectors" . writeBS . pack . J.encode $ map dcListItem collectors

-- | Handler for returning data collector reports.
reportHandler :: Snap ()
reportHandler =
  route
    [ ("all", allReports)
    , (":category/:collector", oneReport)
    ] <|>
  errorReport

-- | Return the report of all the available collectors.
allReports :: Snap ()
allReports = do
  reports <- mapM (liftIO . dReport) collectors
  writeBS . pack . J.encode $ reports

-- | Returns a category given its name.
-- If "collector" is given as the name, the collector has no category, and
-- Nothing will be returned.
catFromName :: String -> BT.Result (Maybe DCCategory)
catFromName "instance"   = BT.Ok $ Just DCInstance
catFromName "storage"    = BT.Ok $ Just DCStorage
catFromName "daemon"     = BT.Ok $ Just DCDaemon
catFromName "hypervisor" = BT.Ok $ Just DCHypervisor
catFromName "default"    = BT.Ok Nothing
catFromName _            = BT.Bad "No such category"

errorReport :: Snap ()
errorReport = do
  modifyResponse $ setResponseStatus 404 "Not found"
  writeBS "Unable to produce a report for the requested resource"

error404 :: Snap ()
error404 = do
  modifyResponse $ setResponseStatus 404 "Not found"
  writeBS "Resource not found"

-- | Return the report of one collector
oneReport :: Snap ()
oneReport = do
  categoryName <- maybe mzero unpack <$> getParam "category"
  collectorName <- maybe mzero unpack <$> getParam "collector"
  category <-
    case catFromName categoryName of
      BT.Ok cat -> return cat
      BT.Bad msg -> fail msg
  collector <-
    case
      find (\col -> collectorName == dName col) $
        filter (\c -> category == dCategory c) collectors of
      Just col -> return col
      Nothing -> fail "Unable to find the requested collector"
  report <- liftIO $ dReport collector
  writeBS . pack . J.encode $ report

-- | The function implementing the HTTP API of the monitoring agent.
monitoringApi :: Snap ()
monitoringApi =
  ifTop versionQ <|>
  dir "1" version1Api <|>
  error404

-- | Main function.
main :: MainFn CheckResult PrepResult
main _ _ httpConf =
  httpServe httpConf $ method GET monitoringApi