Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Query / Query.hs @ 518023a9

History | View | Annotate | Download (3.1 kB)

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
module Ganeti.Query.Query
27
    ( query
28
    , queryFields
29
    ) where
30

    
31
import Data.Maybe (fromMaybe)
32
import qualified Data.Map as Map
33

    
34
import Ganeti.BasicTypes
35
import Ganeti.HTools.JSON
36
import Ganeti.Qlang
37
import Ganeti.Query.Common
38
import Ganeti.Query.Types
39
import Ganeti.Query.Node
40
import Ganeti.Objects
41

    
42
-- * Helper functions
43

    
44
-- | Builds an unknown field definition.
45
mkUnknownFDef :: String -> FieldData a b
46
mkUnknownFDef name =
47
  ( FieldDefinition name name QFTUnknown ("Unknown field '" ++ name ++ "'")
48
  , FieldUnknown )
49

    
50
-- | Runs a field getter on the existing contexts.
51
execGetter :: ConfigData -> b -> a -> FieldGetter a b -> ResultEntry
52
execGetter _   _ item (FieldSimple getter)  = getter item
53
execGetter cfg _ item (FieldConfig getter)  = getter cfg item
54
execGetter _  rt item (FieldRuntime getter) = getter rt item
55
execGetter _   _ _    FieldUnknown          = rsUnknown
56

    
57
-- * Main query execution
58

    
59
-- | Helper to build the list of requested fields. This transforms the
60
-- list of string fields to a list of field defs and getters, with
61
-- some of them possibly being unknown fields.
62
getSelectedFields :: FieldMap a b  -- ^ Defined fields
63
                  -> [String]      -- ^ Requested fields
64
                  -> FieldList a b -- ^ Selected fields
65
getSelectedFields defined =
66
  map (\name -> fromMaybe (mkUnknownFDef name) $ name `Map.lookup` defined)
67

    
68
-- | Main query execution function.
69
query :: ConfigData   -- ^ The current configuration
70
      -> Query        -- ^ The query (item, fields, filter)
71
      -> IO (Result QueryResult) -- ^ Result
72

    
73
query cfg (Query QRNode fields _) = return $ do
74
  let selected = getSelectedFields nodeFieldsMap fields
75
      (fdefs, fgetters) = unzip selected
76
      nodes = Map.elems . fromContainer $ configNodes cfg
77
      fdata = map (\node -> map (execGetter cfg NodeRuntime node) fgetters)
78
              nodes
79
  return QueryResult { qresFields = fdefs, qresData = fdata }
80

    
81
query _ (Query qkind _ _) =
82
  return . Bad $ "Query '" ++ show qkind ++ "' not supported"
83

    
84
-- | Query fields call.
85
queryFields :: QueryFields -> Result QueryFieldsResult
86
queryFields (QueryFields QRNode fields) =
87
  let selected = if null fields
88
                   then map snd $ Map.toAscList nodeFieldsMap
89
                   else getSelectedFields nodeFieldsMap fields
90
  in Ok $ QueryFieldsResult (map fst selected)
91

    
92
queryFields (QueryFields qkind _) =
93
  Bad $ "QueryFields '" ++ show qkind ++ "' not supported"