module Ganeti.DataCollectors.Types
( addStatus
, DCCategory(..)
, DCKind(..)
, DCReport(..)
, DCStatus(..)
, DCStatusCode(..)
, DCVersion(..)
, CollectorData(..)
, CollectorMap
, buildReport
, mergeStatuses
, getCategoryName
, ReportBuilder(..)
, DataCollector(..)
) where
import Control.DeepSeq (NFData, rnf)
import Control.Seq (using, seqFoldable, rdeepseq)
import Data.Char
import Data.Ratio
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import System.Time (ClockTime(..))
import Text.JSON
import Ganeti.Constants as C
import Ganeti.Objects (ConfigData)
import Ganeti.THH
import Ganeti.Utils (getCurrentTimeUSec)
data DCCategory = DCInstance | DCStorage | DCDaemon | DCHypervisor
deriving (Show, Eq, Read, Enum, Bounded)
getCategoryName :: DCCategory -> String
getCategoryName dcc = map toLower . drop 2 . show $ dcc
categoryNames :: Map.Map String DCCategory
categoryNames =
let l = [minBound ..]
in Map.fromList $ zip (map getCategoryName l) l
instance JSON DCCategory where
showJSON = showJSON . getCategoryName
readJSON (JSString s) =
let s' = fromJSString s
in case Map.lookup s' categoryNames of
Just category -> Ok category
Nothing -> fail $ "Invalid category name " ++ s' ++ " for type\
\ DCCategory"
readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for type DCCategory"
data DCStatusCode = DCSCOk
| DCSCTempBad
| DCSCUnknown
| DCSCBad
deriving (Show, Eq, Ord)
instance JSON DCStatusCode where
showJSON DCSCOk = showJSON (0 :: Int)
showJSON DCSCTempBad = showJSON (1 :: Int)
showJSON DCSCUnknown = showJSON (2 :: Int)
showJSON DCSCBad = showJSON (4 :: Int)
readJSON = error "JSON read instance not implemented for type DCStatusCode"
$(buildObject "DCStatus" "dcStatus"
[ simpleField "code" [t| DCStatusCode |]
, simpleField "message" [t| String |]
])
data DCKind = DCKPerf
| DCKStatus
deriving (Show, Eq)
instance JSON DCKind where
showJSON DCKPerf = showJSON (0 :: Int)
showJSON DCKStatus = showJSON (1 :: Int)
readJSON (JSRational _ x) =
if denominator x /= 1
then fail $ "Invalid JSON value " ++ show x ++ " for type DCKind"
else
let x' = (fromIntegral . numerator $ x) :: Int
in if x' == 0 then Ok DCKPerf
else if x' == 1 then Ok DCKStatus
else fail $ "Invalid JSON value " ++ show x' ++ " for type DCKind"
readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for type DCKind"
data DCVersion = DCVerBuiltin | DCVersion String deriving (Show, Eq)
instance JSON DCVersion where
showJSON DCVerBuiltin = showJSON C.builtinDataCollectorVersion
showJSON (DCVersion v) = showJSON v
readJSON (JSString s) =
if fromJSString s == C.builtinDataCollectorVersion
then Ok DCVerBuiltin else Ok . DCVersion $ fromJSString s
readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for type DCVersion"
data CollectorData = CPULoadData (Seq.Seq (ClockTime, [Int]))
instance NFData ClockTime where
rnf (TOD x y) = rnf x `seq` rnf y
instance NFData CollectorData where
rnf (CPULoadData x) = (x `using` seqFoldable rdeepseq) `seq` ()
type CollectorMap = Map.Map String CollectorData
$(buildObject "DCReport" "dcReport"
[ simpleField "name" [t| String |]
, simpleField "version" [t| DCVersion |]
, simpleField "format_version" [t| Int |]
, simpleField "timestamp" [t| Integer |]
, optionalNullSerField $
simpleField "category" [t| DCCategory |]
, simpleField "kind" [t| DCKind |]
, simpleField "data" [t| JSValue |]
])
addStatus :: DCStatus -> JSValue -> JSValue
addStatus dcStatus (JSObject obj) =
makeObj $ ("status", showJSON dcStatus) : fromJSObject obj
addStatus dcStatus value = makeObj
[ ("status", showJSON dcStatus)
, ("data", value)
]
mergeStatuses :: (DCStatusCode, String) -> (DCStatusCode, [String])
-> (DCStatusCode, [String])
mergeStatuses (newStat, newStr) (storedStat, storedStrs) =
let resStat = max newStat storedStat
resStrs =
if newStr == ""
then storedStrs
else storedStrs ++ [newStr]
in (resStat, resStrs)
buildReport :: String -> DCVersion -> Int -> Maybe DCCategory -> DCKind
-> JSValue -> IO DCReport
buildReport name version format_version category kind jsonData = do
usecs <- getCurrentTimeUSec
let timestamp = usecs * 1000 :: Integer
return $
DCReport name version format_version timestamp category kind
jsonData
data ReportBuilder = StatelessR (IO DCReport)
| StatefulR (Maybe CollectorData -> IO DCReport)
type Name = String
data DataCollector = DataCollector
{ dName :: Name
, dCategory :: Maybe DCCategory
, dKind :: DCKind
, dReport :: ReportBuilder
, dUpdate :: Maybe (Maybe CollectorData -> IO CollectorData)
, dActive :: Name -> ConfigData -> Bool
, dInterval :: Name -> ConfigData -> Integer
}