code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/Query/Query.hs

   1 {-| Implementation of the Ganeti Query2 functionality.
   2
   3  -}
   4
   5 {-
   6
   7 Copyright (C) 2012 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 {-
  27
  28 TODO: problems with the current model:
  29
  30 1. There's nothing preventing a result such as ResultEntry RSNormal
  31 Nothing, or ResultEntry RSNoData (Just ...); ideally, we would
  32 separate the the RSNormal and other types; we would need a new data
  33 type for this, though, with JSON encoding/decoding
  34
  35 2. We don't have a way to 'bind' a FieldDefinition's field type
  36 (e.q. QFTBool) with the actual value that is returned from a
  37 FieldGetter. This means that the various getter functions can return
  38 divergent types for the same field when evaluated against multiple
  39 items. This is bad; it only works today because we 'hide' everything
  40 behind JSValue, but is not nice at all. We should probably remove the
  41 separation between FieldDefinition and the FieldGetter, and introduce
  42 a new abstract data type, similar to QFT*, that contains the values
  43 too.
  44
  45 -}
  46
  47 module Ganeti.Query.Query
  48     ( query
  49     , queryFields
  50     , queryCompat
  51     , getRequestedNames
  52     , nameField
  53     ) where
  54
  55 import Control.Monad (filterM)
  56 import Control.Monad.Trans (lift)
  57 import Data.List (intercalate)
  58 import Data.Maybe (fromMaybe)
  59 import qualified Data.Map as Map
  60 import qualified Text.JSON as J
  61
  62 import Ganeti.BasicTypes
  63 import Ganeti.Errors
  64 import Ganeti.Config
  65 import Ganeti.JSON
  66 import Ganeti.Rpc
  67 import Ganeti.Query.Language
  68 import Ganeti.Query.Common
  69 import Ganeti.Query.Filter
  70 import Ganeti.Query.Types
  71 import Ganeti.Query.Node
  72 import Ganeti.Query.Group
  73 import Ganeti.Objects
  74 import Ganeti.Utils
  75
  76 -- * Helper functions
  77
  78 -- | Builds an unknown field definition.
  79 mkUnknownFDef :: String -> FieldData a b
  80 mkUnknownFDef name =
  81   ( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'")
  82   , FieldUnknown )
  83
  84 -- | Runs a field getter on the existing contexts.
  85 execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry
  86 execGetter _   _ item (FieldSimple getter)  = getter item
  87 execGetter cfg _ item (FieldConfig getter)  = getter cfg item
  88 execGetter _  rt item (FieldRuntime getter) = getter rt item
  89 execGetter _   _ _    FieldUnknown          = rsUnknown
  90
  91 -- * Main query execution
  92
  93 -- | Helper to build the list of requested fields. This transforms the
  94 -- list of string fields to a list of field defs and getters, with
  95 -- some of them possibly being unknown fields.
  96 getSelectedFields :: FieldMap a b  -- ^ Defined fields
  97                   -> [String]      -- ^ Requested fields
  98                   -> FieldList a b -- ^ Selected fields
  99 getSelectedFields defined =
 100   map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined)
 101
 102 -- | Collect live data from RPC query if enabled.
 103 -- FIXME: Check which fields we actually need and possibly send empty
 104 -- hvs/vgs if no info from hypervisor/volume group respectively
 105 -- is required
 106 maybeCollectLiveData:: Bool -> ConfigData -> [Node] -> IO [(Node, NodeRuntime)]
 107
 108 maybeCollectLiveData False _ nodes =
 109   return $ zip nodes (repeat $ Left (RpcResultError "Live data disabled"))
 110
 111 maybeCollectLiveData True cfg nodes = do
 112   let vgs = [clusterVolumeGroupName $ configCluster cfg]
 113       hvs = [getDefaultHypervisor cfg]
 114   executeRpcCall nodes (RpcCallNodeInfo vgs hvs)
 115
 116 -- | Check whether list of queried fields contains live fields.
 117 needsLiveData :: [FieldGetter a b] -> Bool
 118 needsLiveData = any isRuntimeField
 119
 120 -- | Checks whether we have requested exactly some names. This is a
 121 -- simple wrapper over 'requestedNames' and 'nameField'.
 122 needsNames :: Query -> Maybe [FilterValue]
 123 needsNames (Query kind _ qfilter) = requestedNames (nameField kind) qfilter
 124
 125 -- | Computes the name field for different query types.
 126 nameField :: ItemType -> FilterField
 127 nameField (ItemTypeLuxi QRJob) = "id"
 128 nameField _ = "name"
 129
 130 -- | Extracts all quoted strings from a list, ignoring the
 131 -- 'NumericValue' entries.
 132 getAllQuotedStrings :: [FilterValue] -> [String]
 133 getAllQuotedStrings =
 134   concatMap extractor
 135     where extractor (NumericValue _)   = []
 136           extractor (QuotedString val) = [val]
 137
 138 -- | Checks that we have either requested a valid set of names, or we
 139 -- have a more complex filter.
 140 getRequestedNames :: Query -> [String]
 141 getRequestedNames qry =
 142   case needsNames qry of
 143     Just names -> getAllQuotedStrings names
 144     Nothing    -> []
 145
 146 -- | Main query execution function.
 147 query :: ConfigData   -- ^ The current configuration
 148       -> Bool         -- ^ Whether to collect live data
 149       -> Query        -- ^ The query (item, fields, filter)
 150       -> IO (ErrorResult QueryResult) -- ^ Result
 151 query cfg live qry = queryInner cfg live qry $ getRequestedNames qry
 152
 153 -- | Inner query execution function.
 154 queryInner :: ConfigData   -- ^ The current configuration
 155            -> Bool         -- ^ Whether to collect live data
 156            -> Query        -- ^ The query (item, fields, filter)
 157            -> [String]     -- ^ Requested names
 158            -> IO (ErrorResult QueryResult) -- ^ Result
 159
 160 queryInner cfg live (Query (ItemTypeOpCode QRNode) fields qfilter) wanted =
 161   runResultT $ do
 162   cfilter <- resultT $ compileFilter nodeFieldsMap qfilter
 163   let selected = getSelectedFields nodeFieldsMap fields
 164       (fdefs, fgetters) = unzip selected
 165       live' = live && needsLiveData fgetters
 166   nodes <- resultT $ case wanted of
 167              [] -> Ok . niceSortKey nodeName .
 168                    Map.elems . fromContainer $ configNodes cfg
 169              _  -> mapM (getNode cfg) wanted
 170   -- runs first pass of the filter, without a runtime context; this
 171   -- will limit the nodes that we'll contact for runtime data
 172   fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
 173                       nodes
 174   -- here we would run the runtime data gathering, then filter again
 175   -- the nodes, based on existing runtime data
 176   nruntimes <- lift $ maybeCollectLiveData live' cfg fnodes
 177   let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters)
 178               nruntimes
 179   return QueryResult { qresFields = fdefs, qresData = fdata }
 180
 181 queryInner cfg _ (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted =
 182   return $ do
 183   cfilter <- compileFilter groupFieldsMap qfilter
 184   let selected = getSelectedFields groupFieldsMap fields
 185       (fdefs, fgetters) = unzip selected
 186   groups <- case wanted of
 187               [] -> Ok . niceSortKey groupName .
 188                     Map.elems . fromContainer $ configNodegroups cfg
 189               _  -> mapM (getGroup cfg) wanted
 190   -- there is no live data for groups, so filtering is much simpler
 191   fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups
 192   let fdata = map (\node ->
 193                        map (execGetter cfg GroupRuntime node) fgetters) fgroups
 194   return QueryResult {qresFields = fdefs, qresData = fdata }
 195
 196 queryInner _ _ (Query qkind _ _) _ =
 197   return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"
 198
 199 -- | Helper for 'queryFields'.
 200 fieldsExtractor :: FieldMap a b -> [FilterField] -> QueryFieldsResult
 201 fieldsExtractor fieldsMap fields =
 202   let selected = if null fields
 203                    then map snd $ Map.toAscList fieldsMap
 204                    else getSelectedFields fieldsMap fields
 205   in QueryFieldsResult (map fst selected)
 206
 207 -- | Query fields call.
 208 queryFields :: QueryFields -> ErrorResult QueryFieldsResult
 209 queryFields (QueryFields (ItemTypeOpCode QRNode) fields) =
 210   Ok $ fieldsExtractor nodeFieldsMap fields
 211
 212 queryFields (QueryFields (ItemTypeOpCode QRGroup) fields) =
 213   Ok $ fieldsExtractor groupFieldsMap fields
 214
 215 queryFields (QueryFields qkind _) =
 216   Bad . GenericError $ "QueryFields '" ++ show qkind ++ "' not supported"
 217
 218 -- | Classic query converter. It gets a standard query result on input
 219 -- and computes the classic style results.
 220 queryCompat :: QueryResult -> ErrorResult [[J.JSValue]]
 221 queryCompat (QueryResult fields qrdata) =
 222   case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of
 223     [] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata
 224     unknown -> Bad $ OpPrereqError ("Unknown output fields selected: " ++
 225                                     intercalate ", " unknown) ECodeInval