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
  49     ( query
  50     , queryFields
  51     ) where
  52
  53 import Control.Monad (filterM)
  54 import Data.Maybe (fromMaybe)
  55 import qualified Data.Map as Map
  56
  57 import Ganeti.BasicTypes
  58 import Ganeti.JSON
  59 import Ganeti.Query.Language
  60 import Ganeti.Query.Common
  61 import Ganeti.Query.Filter
  62 import Ganeti.Query.Types
  63 import Ganeti.Query.Node
  64 import Ganeti.Query.Group
  65 import Ganeti.Objects
  66
  67 -- * Helper functions
  68
  69 -- | Builds an unknown field definition.
  70 mkUnknownFDef :: String -> FieldData a b
  71 mkUnknownFDef name =
  72   ( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'")
  73   , FieldUnknown )
  74
  75 -- | Runs a field getter on the existing contexts.
  76 execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry
  77 execGetter _   _ item (FieldSimple getter)  = getter item
  78 execGetter cfg _ item (FieldConfig getter)  = getter cfg item
  79 execGetter _  rt item (FieldRuntime getter) = getter rt item
  80 execGetter _   _ _    FieldUnknown          = rsUnknown
  81
  82 -- * Main query execution
  83
  84 -- | Helper to build the list of requested fields. This transforms the
  85 -- list of string fields to a list of field defs and getters, with
  86 -- some of them possibly being unknown fields.
  87 getSelectedFields :: FieldMap a b  -- ^ Defined fields
  88                   -> [String]      -- ^ Requested fields
  89                   -> FieldList a b -- ^ Selected fields
  90 getSelectedFields defined =
  91   map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined)
  92
  93 -- | Main query execution function.
  94 query :: ConfigData   -- ^ The current configuration
  95       -> Bool         -- ^ Whether to collect live data
  96       -> Query        -- ^ The query (item, fields, filter)
  97       -> IO (Result QueryResult) -- ^ Result
  98
  99 query cfg _ (Query QRNode fields qfilter) = return $ do
 100   cfilter <- compileFilter nodeFieldsMap qfilter
 101   let selected = getSelectedFields nodeFieldsMap fields
 102       (fdefs, fgetters) = unzip selected
 103       nodes = Map.elems . fromContainer $ configNodes cfg
 104   -- runs first pass of the filter, without a runtime context; this
 105   -- will limit the nodes that we'll contact for runtime data
 106   fnodes <- filterM (\n -> evaluateFilter cfg Nothing n cfilter)
 107             nodes
 108   -- here we would run the runtime data gathering, then filter again
 109   -- the nodes, based on existing runtime data
 110   let fdata = map (\node -> map (execGetter cfg NodeRuntime node) fgetters)
 111               fnodes
 112   return QueryResult { qresFields = fdefs, qresData = fdata }
 113
 114 query cfg _ (Query QRGroup fields qfilter) = return $ do
 115   -- FIXME: want_diskparams is defaulted to false and not taken as parameter
 116   -- This is because the type for DiskParams is right now too generic for merges
 117   -- (or else I cannot see how to do this with curent implementation)
 118   cfilter <- compileFilter groupFieldsMap qfilter
 119   let selected = getSelectedFields groupFieldsMap fields
 120       (fdefs, fgetters) = unzip selected
 121       groups = Map.elems . fromContainer $ configNodegroups cfg
 122   -- there is no live data for groups, so filtering is much simpler
 123   fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups
 124   let fdata = map (\node ->
 125                        map (execGetter cfg GroupRuntime node) fgetters) fgroups
 126   return QueryResult {qresFields = fdefs, qresData = fdata }
 127
 128 query _ _ (Query qkind _ _) =
 129   return . Bad $ "Query '" ++ show qkind ++ "' not supported"
 130
 131 -- | Query fields call.
 132 -- FIXME: Looks generic enough to use a typeclass
 133 queryFields :: QueryFields -> Result QueryFieldsResult
 134 queryFields (QueryFields QRNode fields) =
 135   let selected = if null fields
 136                    then map snd $ Map.toAscList nodeFieldsMap
 137                    else getSelectedFields nodeFieldsMap fields
 138   in Ok $ QueryFieldsResult (map fst selected)
 139
 140 queryFields (QueryFields QRGroup fields) =
 141   let selected = if null fields
 142                    then map snd $ Map.toAscList groupFieldsMap
 143                    else getSelectedFields groupFieldsMap fields
 144   in Ok $ QueryFieldsResult (map fst selected)
 145
 146
 147 queryFields (QueryFields qkind _) =
 148   Bad $ "QueryFields '" ++ show qkind ++ "' not supported"