code.grnet.gr Git - ganeti-local/blob - src/Ganeti/DataCollectors/Types.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2
   3 {-| Implementation of the Ganeti data collector types.
   4
   5 -}
   6
   7 {-
   8
   9 Copyright (C) 2012, 2013 Google Inc.
  10
  11 This program is free software; you can redistribute it and/or modify
  12 it under the terms of the GNU General Public License as published by
  13 the Free Software Foundation; either version 2 of the License, or
  14 (at your option) any later version.
  15
  16 This program is distributed in the hope that it will be useful, but
  17 WITHOUT ANY WARRANTY; without even the implied warranty of
  18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 General Public License for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with this program; if not, write to the Free Software
  23 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  24 02110-1301, USA.
  25
  26 -}
  27
  28 module Ganeti.DataCollectors.Types
  29   ( addStatus
  30   , DCCategory(..)
  31   , DCKind(..)
  32   , DCReport(..)
  33   , DCStatus(..)
  34   , DCStatusCode(..)
  35   , DCVersion(..)
  36   , CollectorData(..)
  37   , CollectorMap
  38   , buildReport
  39   , mergeStatuses
  40   , getCategoryName
  41   ) where
  42
  43 import Data.Char
  44 import Data.Ratio
  45 import qualified Data.Map as Map
  46 import qualified Data.Sequence as Seq
  47 import Text.JSON
  48
  49 import Ganeti.Constants as C
  50 import Ganeti.THH
  51 import Ganeti.Utils (getCurrentTime)
  52
  53 -- | The possible classes a data collector can belong to.
  54 data DCCategory = DCInstance | DCStorage | DCDaemon | DCHypervisor
  55   deriving (Show, Eq, Read)
  56
  57 -- | Get the category name and return it as a string.
  58 getCategoryName :: DCCategory -> String
  59 getCategoryName dcc = map toLower . drop 2 . show $ dcc
  60
  61 categoryNames :: Map.Map String DCCategory
  62 categoryNames =
  63   let l = [DCInstance, DCStorage, DCDaemon, DCHypervisor]
  64   in Map.fromList $ zip (map getCategoryName l) l
  65
  66 -- | The JSON instance for DCCategory.
  67 instance JSON DCCategory where
  68   showJSON = showJSON . getCategoryName
  69   readJSON (JSString s) =
  70     let s' = fromJSString s
  71     in case Map.lookup s' categoryNames of
  72          Just category -> Ok category
  73          Nothing -> fail $ "Invalid category name " ++ s' ++ " for type\
  74                            \ DCCategory"
  75   readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for type DCCategory"
  76
  77 -- | The possible status codes of a data collector.
  78 data DCStatusCode = DCSCOk      -- ^ Everything is OK
  79                   | DCSCTempBad -- ^ Bad, but being automatically fixed
  80                   | DCSCUnknown -- ^ Unable to determine the status
  81                   | DCSCBad     -- ^ Bad. External intervention required
  82                   deriving (Show, Eq, Ord)
  83
  84 -- | The JSON instance for CollectorStatus.
  85 instance JSON DCStatusCode where
  86   showJSON DCSCOk      = showJSON (0 :: Int)
  87   showJSON DCSCTempBad = showJSON (1 :: Int)
  88   showJSON DCSCUnknown = showJSON (2 :: Int)
  89   showJSON DCSCBad     = showJSON (4 :: Int)
  90   readJSON = error "JSON read instance not implemented for type DCStatusCode"
  91
  92 -- | The status of a \"status reporting data collector\".
  93 $(buildObject "DCStatus" "dcStatus"
  94   [ simpleField "code"    [t| DCStatusCode |]
  95   , simpleField "message" [t| String |]
  96   ])
  97
  98 -- | The type representing the kind of the collector.
  99 data DCKind = DCKPerf   -- ^ Performance reporting collector
 100             | DCKStatus -- ^ Status reporting collector
 101             deriving (Show, Eq)
 102
 103 -- | The JSON instance for CollectorKind.
 104 instance JSON DCKind where
 105   showJSON DCKPerf   = showJSON (0 :: Int)
 106   showJSON DCKStatus = showJSON (1 :: Int)
 107   readJSON (JSRational _ x) =
 108     if denominator x /= 1
 109     then fail $ "Invalid JSON value " ++ show x ++ " for type DCKind"
 110     else
 111       let x' = (fromIntegral . numerator $ x) :: Int
 112       in if x' == 0 then Ok DCKPerf
 113          else if x' == 1 then Ok DCKStatus
 114          else fail $ "Invalid JSON value " ++ show x' ++ " for type DCKind"
 115   readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for type DCKind"
 116
 117 -- | Type representing the version number of a data collector.
 118 data DCVersion = DCVerBuiltin | DCVersion String deriving (Show, Eq)
 119
 120 -- | The JSON instance for DCVersion.
 121 instance JSON DCVersion where
 122   showJSON DCVerBuiltin = showJSON C.builtinDataCollectorVersion
 123   showJSON (DCVersion v) = showJSON v
 124   readJSON (JSString s) =
 125     if fromJSString s == C.builtinDataCollectorVersion
 126     then Ok DCVerBuiltin else Ok . DCVersion $ fromJSString s
 127   readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for type DCVersion"
 128
 129 -- | Type for the value field of the above map.
 130 data CollectorData = CPULoadData (Seq.Seq (Integer, [Int]))
 131
 132 -- | Type for the map storing the data of the statefull DataCollectors.
 133 type CollectorMap = Map.Map String CollectorData
 134
 135 -- | This is the format of the report produced by each data collector.
 136 $(buildObject "DCReport" "dcReport"
 137   [ simpleField "name"           [t| String |]
 138   , simpleField "version"        [t| DCVersion |]
 139   , simpleField "format_version" [t| Int |]
 140   , simpleField "timestamp"      [t| Integer |]
 141   , optionalNullSerField $
 142       simpleField "category"     [t| DCCategory |]
 143   , simpleField "kind"           [t| DCKind |]
 144   , simpleField "data"           [t| JSValue |]
 145   ])
 146
 147 -- | Add the data collector status information to the JSON representation of
 148 -- the collector data.
 149 addStatus :: DCStatus -> JSValue -> JSValue
 150 addStatus dcStatus (JSObject obj) =
 151   makeObj $ ("status", showJSON dcStatus) : fromJSObject obj
 152 addStatus dcStatus value = makeObj
 153   [ ("status", showJSON dcStatus)
 154   , ("data", value)
 155   ]
 156
 157 -- | Helper function for merging statuses.
 158 mergeStatuses :: (DCStatusCode, String) -> (DCStatusCode, [String])
 159               -> (DCStatusCode, [String])
 160 mergeStatuses (newStat, newStr) (storedStat, storedStrs) =
 161   let resStat = max newStat storedStat
 162       resStrs =
 163         if newStr == ""
 164           then storedStrs
 165           else storedStrs ++ [newStr]
 166   in (resStat, resStrs)
 167
 168 -- | Utility function for building a report automatically adding the current
 169 -- timestamp (rounded up to seconds).
 170 -- If the version is not specified, it will be set to the value indicating
 171 -- a builtin collector.
 172 buildReport :: String -> DCVersion -> Int -> Maybe DCCategory -> DCKind
 173             -> JSValue -> IO DCReport
 174 buildReport name version format_version category kind jsonData = do
 175   now <- getCurrentTime
 176   let timestamp = now * 1000000000 :: Integer
 177   return $
 178     DCReport name version format_version timestamp category kind
 179       jsonData