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

   1 {-| Implementation of the Ganeti Query2 functionality.
   2
   3  -}
   4
   5 {-
   6
   7 Copyright (C) 2012, 2013 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.DeepSeq
  56 import Control.Monad (filterM, liftM, foldM)
  57 import Control.Monad.Trans (lift)
  58 import Data.List (intercalate)
  59 import Data.Maybe (fromMaybe)
  60 import qualified Data.Map as Map
  61 import qualified Text.JSON as J
  62
  63 import Ganeti.BasicTypes
  64 import Ganeti.Config
  65 import Ganeti.Errors
  66 import Ganeti.JQueue
  67 import Ganeti.JSON
  68 import Ganeti.Objects
  69 import Ganeti.Query.Common
  70 import qualified Ganeti.Query.Export as Export
  71 import Ganeti.Query.Filter
  72 import qualified Ganeti.Query.Job as Query.Job
  73 import qualified Ganeti.Query.Group as Group
  74 import Ganeti.Query.Language
  75 import qualified Ganeti.Query.Network as Network
  76 import qualified Ganeti.Query.Node as Node
  77 import Ganeti.Query.Types
  78 import Ganeti.Path
  79 import Ganeti.Types
  80 import Ganeti.Utils
  81
  82 -- * Helper functions
  83
  84 -- | Builds an unknown field definition.
  85 mkUnknownFDef :: String -> FieldData a b
  86 mkUnknownFDef name =
  87   ( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'")
  88   , FieldUnknown
  89   , QffNormal )
  90
  91 -- | Runs a field getter on the existing contexts.
  92 execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry
  93 execGetter _   _ item (FieldSimple getter)  = getter item
  94 execGetter cfg _ item (FieldConfig getter)  = getter cfg item
  95 execGetter _  rt item (FieldRuntime getter) = getter rt item
  96 execGetter _   _ _    FieldUnknown          = rsUnknown
  97
  98 -- * Main query execution
  99
 100 -- | Helper to build the list of requested fields. This transforms the
 101 -- list of string fields to a list of field defs and getters, with
 102 -- some of them possibly being unknown fields.
 103 getSelectedFields :: FieldMap a b  -- ^ Defined fields
 104                   -> [String]      -- ^ Requested fields
 105                   -> FieldList a b -- ^ Selected fields
 106 getSelectedFields defined =
 107   map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined)
 108
 109 -- | Check whether list of queried fields contains live fields.
 110 needsLiveData :: [FieldGetter a b] -> Bool
 111 needsLiveData = any isRuntimeField
 112
 113 -- | Checks whether we have requested exactly some names. This is a
 114 -- simple wrapper over 'requestedNames' and 'nameField'.
 115 needsNames :: Query -> Maybe [FilterValue]
 116 needsNames (Query kind _ qfilter) = requestedNames (nameField kind) qfilter
 117
 118 -- | Computes the name field for different query types.
 119 nameField :: ItemType -> FilterField
 120 nameField (ItemTypeLuxi QRJob) = "id"
 121 nameField (ItemTypeOpCode QRExport) = "node"
 122 nameField _ = "name"
 123
 124 -- | Extracts all quoted strings from a list, ignoring the
 125 -- 'NumericValue' entries.
 126 getAllQuotedStrings :: [FilterValue] -> [String]
 127 getAllQuotedStrings =
 128   concatMap extractor
 129     where extractor (NumericValue _)   = []
 130           extractor (QuotedString val) = [val]
 131
 132 -- | Checks that we have either requested a valid set of names, or we
 133 -- have a more complex filter.
 134 getRequestedNames :: Query -> [String]
 135 getRequestedNames qry =
 136   case needsNames qry of
 137     Just names -> getAllQuotedStrings names
 138     Nothing    -> []
 139
 140 -- | Compute the requested job IDs. This is custom since we need to
 141 -- handle both strings and integers.
 142 getRequestedJobIDs :: Filter FilterField -> Result [JobId]
 143 getRequestedJobIDs qfilter =
 144   case requestedNames (nameField (ItemTypeLuxi QRJob)) qfilter of
 145     Nothing -> Ok []
 146     Just [] -> Ok []
 147     Just vals ->
 148       mapM (\e -> case e of
 149                     QuotedString s -> makeJobIdS s
 150                     NumericValue i -> makeJobId $ fromIntegral i
 151            ) vals
 152
 153 -- | Main query execution function.
 154 query :: ConfigData   -- ^ The current configuration
 155       -> Bool         -- ^ Whether to collect live data
 156       -> Query        -- ^ The query (item, fields, filter)
 157       -> IO (ErrorResult QueryResult) -- ^ Result
 158 query cfg live (Query (ItemTypeLuxi QRJob) fields qfilter) =
 159   queryJobs cfg live fields qfilter
 160 query cfg live qry = queryInner cfg live qry $ getRequestedNames qry
 161
 162 -- | Inner query execution function.
 163 queryInner :: ConfigData   -- ^ The current configuration
 164            -> Bool         -- ^ Whether to collect live data
 165            -> Query        -- ^ The query (item, fields, filter)
 166            -> [String]     -- ^ Requested names
 167            -> IO (ErrorResult QueryResult) -- ^ Result
 168
 169 queryInner cfg live (Query (ItemTypeOpCode QRNode) fields qfilter) wanted =
 170   runResultT $ do
 171   cfilter <- resultT $ compileFilter Node.fieldsMap qfilter
 172   let selected = getSelectedFields Node.fieldsMap fields
 173       (fdefs, fgetters, _) = unzip3 selected
 174       live' = live && needsLiveData fgetters
 175   nodes <- resultT $ case wanted of
 176              [] -> Ok . niceSortKey nodeName .
 177                    Map.elems . fromContainer $ configNodes cfg
 178              _  -> mapM (getNode cfg) wanted
 179   -- runs first pass of the filter, without a runtime context; this
 180   -- will limit the nodes that we'll contact for runtime data
 181   fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
 182                       nodes
 183   -- here we would run the runtime data gathering, then filter again
 184   -- the nodes, based on existing runtime data
 185   nruntimes <- lift $ Node.collectLiveData live' cfg fnodes
 186   let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters)
 187               nruntimes
 188   return QueryResult { qresFields = fdefs, qresData = fdata }
 189
 190 queryInner cfg _ (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted =
 191   return $ do
 192   cfilter <- compileFilter Group.fieldsMap qfilter
 193   let selected = getSelectedFields Group.fieldsMap fields
 194       (fdefs, fgetters, _) = unzip3 selected
 195   groups <- case wanted of
 196               [] -> Ok . niceSortKey groupName .
 197                     Map.elems . fromContainer $ configNodegroups cfg
 198               _  -> mapM (getGroup cfg) wanted
 199   -- there is no live data for groups, so filtering is much simpler
 200   fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups
 201   let fdata = map (\node ->
 202                      map (execGetter cfg Group.Runtime node) fgetters) fgroups
 203   return QueryResult { qresFields = fdefs, qresData = fdata }
 204
 205 queryInner cfg _ (Query (ItemTypeOpCode QRNetwork) fields qfilter) wanted =
 206   return $ do
 207   cfilter <- compileFilter Network.fieldsMap qfilter
 208   let selected = getSelectedFields Network.fieldsMap fields
 209       (fdefs, fgetters, _) = unzip3 selected
 210   networks <- case wanted of
 211                 [] -> Ok . niceSortKey (fromNonEmpty . networkName) .
 212                       Map.elems . fromContainer $ configNetworks cfg
 213                 _  -> mapM (getNetwork cfg) wanted
 214   fnetworks <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) networks
 215   let fdata = map (\network ->
 216                    map (execGetter cfg Network.Runtime network) fgetters)
 217                    fnetworks
 218   return QueryResult { qresFields = fdefs, qresData = fdata }
 219
 220 queryInner cfg live (Query (ItemTypeOpCode QRExport) fields qfilter) wanted =
 221   runResultT $ do
 222   cfilter <- resultT $ compileFilter Export.fieldsMap qfilter
 223   let selected = getSelectedFields Export.fieldsMap fields
 224       (fdefs, fgetters, _) = unzip3 selected
 225       -- we alwyas have live queries in exports, but we keep this for
 226       -- standard style (in case we add static fields in the future)
 227       live' = live && needsLiveData fgetters
 228   nodes <- resultT $ case wanted of
 229              [] -> Ok . niceSortKey nodeName .
 230                    Map.elems . fromContainer $ configNodes cfg
 231              _  -> mapM (getNode cfg) wanted
 232   -- runs first pass of the filter, without a runtime context; this
 233   -- will limit the nodes that we'll contact for exports
 234   fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
 235                       nodes
 236   -- here we would run the runtime data gathering...
 237   nruntimes <- lift $ Export.collectLiveData live' cfg fnodes
 238   -- ... then filter again the results, based on existing export
 239   -- names, but note that no client sends filters on the export list
 240   -- today, so it's likely a no-oop
 241   let fdata = map (\(node, nrt) -> map (execGetter cfg nrt node) fgetters)
 242               nruntimes
 243   return QueryResult { qresFields = fdefs, qresData = fdata }
 244
 245 queryInner _ _ (Query qkind _ _) _ =
 246   return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"
 247
 248 -- | Query jobs specific query function, needed as we need to accept
 249 -- both 'QuotedString' and 'NumericValue' as wanted names.
 250 queryJobs :: ConfigData                   -- ^ The current configuration
 251           -> Bool                         -- ^ Whether to collect live data
 252           -> [FilterField]                -- ^ Item
 253           -> Filter FilterField           -- ^ Filter
 254           -> IO (ErrorResult QueryResult) -- ^ Result
 255 queryJobs cfg live fields qfilter =
 256   runResultT $ do
 257   rootdir <- lift queueDir
 258   let wanted_names = getRequestedJobIDs qfilter
 259       want_arch = Query.Job.wantArchived fields
 260   rjids <- case wanted_names of
 261              Bad msg -> resultT . Bad $ GenericError msg
 262              Ok [] -> if live
 263                         -- we can check the filesystem for actual jobs
 264                         then lift $ liftM sortJobIDs
 265                              (determineJobDirectories rootdir want_arch >>=
 266                               getJobIDs)
 267                         -- else we shouldn't look at the filesystem...
 268                         else return []
 269              Ok v -> resultT $ Ok v
 270   cfilter <- resultT $ compileFilter Query.Job.fieldsMap qfilter
 271   let selected = getSelectedFields Query.Job.fieldsMap fields
 272       (fdefs, fgetters, _) = unzip3 selected
 273       live' = live && needsLiveData fgetters
 274       disabled_data = Bad "live data disabled"
 275   -- runs first pass of the filter, without a runtime context; this
 276   -- will limit the jobs that we'll load from disk
 277   jids <- resultT $
 278           filterM (\jid -> evaluateFilter cfg Nothing jid cfilter) rjids
 279   -- here we run the runtime data gathering, filtering and evaluation,
 280   -- all in the same step, so that we don't keep jobs in memory longer
 281   -- than we need; we can't be fully lazy due to the multiple monad
 282   -- wrapping across different steps
 283   qdir <- lift queueDir
 284   fdata <- foldM
 285            -- big lambda, but we use many variables from outside it...
 286            (\lst jid -> do
 287               job <- lift $ if live'
 288                               then loadJobFromDisk qdir True jid
 289                               else return disabled_data
 290               pass <- resultT $ evaluateFilter cfg (Just job) jid cfilter
 291               let nlst = if pass
 292                            then let row = map (execGetter cfg job jid) fgetters
 293                                 in rnf row `seq` row:lst
 294                            else lst
 295               -- evaluate nlst (to WHNF), otherwise we're too lazy
 296               return $! nlst
 297            ) [] jids
 298   return QueryResult { qresFields = fdefs, qresData = reverse fdata }
 299
 300 -- | Helper for 'queryFields'.
 301 fieldsExtractor :: FieldMap a b -> [FilterField] -> QueryFieldsResult
 302 fieldsExtractor fieldsMap fields =
 303   let selected = if null fields
 304                    then map snd $ Map.toAscList fieldsMap
 305                    else getSelectedFields fieldsMap fields
 306   in QueryFieldsResult (map (\(defs, _, _) -> defs) selected)
 307
 308 -- | Query fields call.
 309 queryFields :: QueryFields -> ErrorResult QueryFieldsResult
 310 queryFields (QueryFields (ItemTypeOpCode QRNode) fields) =
 311   Ok $ fieldsExtractor Node.fieldsMap fields
 312
 313 queryFields (QueryFields (ItemTypeOpCode QRGroup) fields) =
 314   Ok $ fieldsExtractor Group.fieldsMap fields
 315
 316 queryFields (QueryFields (ItemTypeOpCode QRNetwork) fields) =
 317   Ok $ fieldsExtractor Network.fieldsMap fields
 318
 319 queryFields (QueryFields (ItemTypeLuxi QRJob) fields) =
 320   Ok $ fieldsExtractor Query.Job.fieldsMap fields
 321
 322 queryFields (QueryFields (ItemTypeOpCode QRExport) fields) =
 323   Ok $ fieldsExtractor Export.fieldsMap fields
 324
 325 queryFields (QueryFields qkind _) =
 326   Bad . GenericError $ "QueryFields '" ++ show qkind ++ "' not supported"
 327
 328 -- | Classic query converter. It gets a standard query result on input
 329 -- and computes the classic style results.
 330 queryCompat :: QueryResult -> ErrorResult [[J.JSValue]]
 331 queryCompat (QueryResult fields qrdata) =
 332   case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of
 333     [] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata
 334     unknown -> Bad $ OpPrereqError ("Unknown output fields selected: " ++
 335                                     intercalate ", " unknown) ECodeInval