Revision cd67e337

b/htools/Ganeti/Query/Query.hs
45 45
-}
46 46

  
47 47
module Ganeti.Query.Query
48

  
49 48
    ( query
50 49
    , queryFields
50
    , queryCompat
51 51
    , getRequestedNames
52
    , nameField
52 53
    ) where
53 54

  
54 55
import Control.Monad (filterM)
55 56
import Control.Monad.Trans (lift)
57
import Data.List (intercalate)
56 58
import Data.Maybe (fromMaybe)
57 59
import qualified Data.Map as Map
60
import qualified Text.JSON as J
58 61

  
59 62
import Ganeti.BasicTypes
60 63
import Ganeti.Config
......
209 212

  
210 213
queryFields (QueryFields qkind _) =
211 214
  Bad $ "QueryFields '" ++ show qkind ++ "' not supported"
215

  
216
-- | Classic query converter. It gets a standard query result on input
217
-- and computes the classic style results.
218
queryCompat :: QueryResult -> Result [[J.JSValue]]
219
queryCompat (QueryResult fields qrdata) =
220
  case map fdefName $ filter ((== QFTUnknown) . fdefKind) fields of
221
    [] -> Ok $ map (map (maybe J.JSNull J.showJSON . rentryValue)) qrdata
222
    unknown -> Bad $ "Unknown output fields selected: " ++
223
                     intercalate ", " unknown
b/htools/Ganeti/Query/Server.hs
51 51
import Ganeti.Luxi
52 52
import qualified Ganeti.Query.Language as Qlang
53 53
import Ganeti.Query.Query
54
import Ganeti.Query.Filter (makeSimpleFilter)
54 55

  
55 56
-- | A type for functions that can return the configuration when
56 57
-- executed.
57 58
type ConfigReader = IO (Result ConfigData)
58 59

  
60
-- | Helper for classic queries.
61
handleClassicQuery :: ConfigData      -- ^ Cluster config
62
                   -> Qlang.ItemType  -- ^ Query type
63
                   -> [String]        -- ^ Requested names (empty means all)
64
                   -> [String]        -- ^ Requested fields
65
                   -> Bool            -- ^ Whether to do sync queries or not
66
                   -> IO (Result JSValue)
67
handleClassicQuery _ _ _ _ True = return . Bad $ "Sync queries are not allowed"
68
handleClassicQuery cfg qkind names fields _ = do
69
  let flt = makeSimpleFilter (nameField qkind) names
70
  qr <- query cfg True (Qlang.Query qkind fields flt)
71
  return $ showJSON <$> (qr >>= queryCompat)
72

  
59 73
-- | Minimal wrapper to handle the missing config case.
60 74
handleCallWrapper :: Result ConfigData -> LuxiOp -> IO (Result JSValue)
61 75
handleCallWrapper (Bad msg) _ =
......
136 150
  let result = queryFields (Qlang.QueryFields qkind qfields)
137 151
  return $ J.showJSON <$> result
138 152

  
153
handleCall cfg (QueryNodes names fields lock) =
154
  handleClassicQuery cfg Qlang.QRNode names fields lock
155

  
156
handleCall cfg (QueryGroups names fields lock) =
157
  handleClassicQuery cfg Qlang.QRGroup names fields lock
158

  
139 159
handleCall _ op =
140 160
  return . Bad $ "Luxi call '" ++ strOfOp op ++ "' not implemented"
141 161

  

Also available in: Unified diff