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 -- | Generic query implementation for resources that are backed by
 154 -- some configuration objects.
 155 genericQuery :: FieldMap a b       -- ^ Field map
 156              -> (Bool -> ConfigData -> [a] -> IO [(a, b)]) -- ^ Collector
 157              -> (a -> String)      -- ^ Object to name function
 158              -> (ConfigData -> Container a) -- ^ Get all objects from config
 159              -> (ConfigData -> String -> ErrorResult a) -- ^ Lookup object
 160              -> ConfigData         -- ^ The config to run the query against
 161              -> Bool               -- ^ Whether the query should be run live
 162              -> [String]           -- ^ List of requested fields
 163              -> Filter FilterField -- ^ Filter field
 164              -> [String]           -- ^ List of requested names
 165              -> IO (ErrorResult QueryResult)
 166 genericQuery fieldsMap collector nameFn configFn getFn cfg
 167              live fields qfilter wanted =
 168   runResultT $ do
 169   cfilter <- resultT $ compileFilter fieldsMap qfilter
 170   let selected = getSelectedFields fieldsMap fields
 171       (fdefs, fgetters, _) = unzip3 selected
 172       live' = live && needsLiveData fgetters
 173   objects <- resultT $ case wanted of
 174              [] -> Ok . niceSortKey nameFn .
 175                    Map.elems . fromContainer $ configFn cfg
 176              _  -> mapM (getFn cfg) wanted
 177   -- runs first pass of the filter, without a runtime context; this
 178   -- will limit the objects that we'll contact for exports
 179   fobjects <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter)
 180                         objects
 181   -- here run the runtime data gathering...
 182   runtimes <- lift $ collector live' cfg fobjects
 183   -- ... then filter again the results, based on gathered runtime data
 184   let fdata = map (\(obj, runtime) ->
 185                      map (execGetter cfg runtime obj) fgetters)
 186               runtimes
 187   return QueryResult { qresFields = fdefs, qresData = fdata }
 188
 189 -- | Main query execution function.
 190 query :: ConfigData   -- ^ The current configuration
 191       -> Bool         -- ^ Whether to collect live data
 192       -> Query        -- ^ The query (item, fields, filter)
 193       -> IO (ErrorResult QueryResult) -- ^ Result
 194 query cfg live (Query (ItemTypeLuxi QRJob) fields qfilter) =
 195   queryJobs cfg live fields qfilter
 196 query cfg live qry = queryInner cfg live qry $ getRequestedNames qry
 197
 198 -- | Inner query execution function.
 199 queryInner :: ConfigData   -- ^ The current configuration
 200            -> Bool         -- ^ Whether to collect live data
 201            -> Query        -- ^ The query (item, fields, filter)
 202            -> [String]     -- ^ Requested names
 203            -> IO (ErrorResult QueryResult) -- ^ Result
 204
 205 queryInner cfg live (Query (ItemTypeOpCode QRNode) fields qfilter) wanted =
 206   genericQuery Node.fieldsMap Node.collectLiveData nodeName configNodes getNode
 207                cfg live fields qfilter wanted
 208
 209 queryInner cfg live (Query (ItemTypeOpCode QRGroup) fields qfilter) wanted =
 210   genericQuery Group.fieldsMap Group.collectLiveData groupName configNodegroups
 211                getGroup cfg live fields qfilter wanted
 212
 213 queryInner cfg live (Query (ItemTypeOpCode QRNetwork) fields qfilter) wanted =
 214   genericQuery Network.fieldsMap Network.collectLiveData
 215                (fromNonEmpty . networkName)
 216                configNetworks getNetwork cfg live fields qfilter wanted
 217
 218 queryInner cfg live (Query (ItemTypeOpCode QRExport) fields qfilter) wanted =
 219   genericQuery Export.fieldsMap Export.collectLiveData nodeName configNodes
 220                getNode cfg live fields qfilter wanted
 221
 222 queryInner _ _ (Query qkind _ _) _ =
 223   return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"
 224
 225 -- | Query jobs specific query function, needed as we need to accept
 226 -- both 'QuotedString' and 'NumericValue' as wanted names.
 227 queryJobs :: ConfigData                   -- ^ The current configuration
 228           -> Bool                         -- ^ Whether to collect live data
 229           -> [FilterField]                -- ^ Item
 230           -> Filter FilterField           -- ^ Filter
 231           -> IO (ErrorResult QueryResult) -- ^ Result
 232 queryJobs cfg live fields qfilter =
 233   runResultT $ do
 234   rootdir <- lift queueDir
 235   let wanted_names = getRequestedJobIDs qfilter
 236       want_arch = Query.Job.wantArchived fields
 237   rjids <- case wanted_names of
 238              Bad msg -> resultT . Bad $ GenericError msg
 239              Ok [] -> if live
 240                         -- we can check the filesystem for actual jobs
 241                         then lift $ liftM sortJobIDs
 242                              (determineJobDirectories rootdir want_arch >>=
 243                               getJobIDs)
 244                         -- else we shouldn't look at the filesystem...
 245                         else return []
 246              Ok v -> resultT $ Ok v
 247   cfilter <- resultT $ compileFilter Query.Job.fieldsMap qfilter
 248   let selected = getSelectedFields Query.Job.fieldsMap fields
 249       (fdefs, fgetters, _) = unzip3 selected
 250       live' = live && needsLiveData fgetters
 251       disabled_data = Bad "live data disabled"
 252   -- runs first pass of the filter, without a runtime context; this
 253   -- will limit the jobs that we'll load from disk
 254   jids <- resultT $
 255           filterM (\jid -> evaluateFilter cfg Nothing jid cfilter) rjids
 256   -- here we run the runtime data gathering, filtering and evaluation,
 257   -- all in the same step, so that we don't keep jobs in memory longer
 258   -- than we need; we can't be fully lazy due to the multiple monad
 259   -- wrapping across different steps
 260   qdir <- lift queueDir
 261   fdata <- foldM
 262            -- big lambda, but we use many variables from outside it...
 263            (\lst jid -> do
 264               job <- lift $ if live'
 265                               then loadJobFromDisk qdir True jid
 266                               else return disabled_data
 267               pass <- resultT $ evaluateFilter cfg (Just job) jid cfilter
 268               let nlst = if pass
 269                            then let row = map (execGetter cfg job jid) fgetters
 270                                 in rnf row `seq` row:lst
 271                            else lst
 272               -- evaluate nlst (to WHNF), otherwise we're too lazy
 273               return $! nlst
 274            ) [] jids
 275   return QueryResult { qresFields = fdefs, qresData = reverse fdata }
 276
 277 -- | Helper for 'queryFields'.
 278 fieldsExtractor :: FieldMap a b -> [FilterField] -> QueryFieldsResult
 279 fieldsExtractor fieldsMap fields =
 280   let selected = if null fields
 281                    then map snd $ Map.toAscList fieldsMap
 282                    else getSelectedFields fieldsMap fields
 283   in QueryFieldsResult (map (\(defs, _, _) -> defs) selected)
 284
 285 -- | Query fields call.
 286 queryFields :: QueryFields -> ErrorResult QueryFieldsResult
 287 queryFields (QueryFields (ItemTypeOpCode QRNode) fields) =
 288   Ok $ fieldsExtractor Node.fieldsMap fields
 289
 290 queryFields (QueryFields (ItemTypeOpCode QRGroup) fields) =
 291   Ok $ fieldsExtractor Group.fieldsMap fields
 292
 293 queryFields (QueryFields (ItemTypeOpCode QRNetwork) fields) =
 294   Ok $ fieldsExtractor Network.fieldsMap fields
 295
 296 queryFields (QueryFields (ItemTypeLuxi QRJob) fields) =
 297   Ok $ fieldsExtractor Query.Job.fieldsMap fields
 298
 299 queryFields (QueryFields (ItemTypeOpCode QRExport) fields) =
 300   Ok $ fieldsExtractor Export.fieldsMap fields
 301
 302 queryFields (QueryFields qkind _) =
 303   Bad . GenericError $ "QueryFields '" ++ show qkind ++ "' not supported"
 304
 305 -- | Classic query converter. It gets a standard query result on input
 306 -- and computes the classic style results.
 307 queryCompat :: QueryResult -> ErrorResult [[J.JSValue]]
 308 queryCompat (QueryResult fields qrdata) =
 309   case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of
 310     [] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata
 311     unknown -> Bad $ OpPrereqError ("Unknown output fields selected: " ++
 312                                     intercalate ", " unknown) ECodeInval