code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/Qlang.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2
   3 {-| Implementation of the Ganeti Query2 language.
   4
   5  -}
   6
   7 {-
   8
   9 Copyright (C) 2012 Google Inc.
  10
  11 This program is free software; you can redistribute it and/or modify
  12 it under the terms of the GNU General Public License as published by
  13 the Free Software Foundation; either version 2 of the License, or
  14 (at your option) any later version.
  15
  16 This program is distributed in the hope that it will be useful, but
  17 WITHOUT ANY WARRANTY; without even the implied warranty of
  18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 General Public License for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with this program; if not, write to the Free Software
  23 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  24 02110-1301, USA.
  25
  26 -}
  27
  28 module Ganeti.Qlang
  29     ( Filter(..)
  30     , FilterValue(..)
  31     , Query(..)
  32     , QueryResult(..)
  33     , QueryFields(..)
  34     , QueryFieldsResult(..)
  35     , FieldDefinition(..)
  36     , ResultEntry(..)
  37     , ItemType(..)
  38     ) where
  39
  40 import Control.Applicative
  41 import Data.Ratio (numerator, denominator)
  42 import Text.JSON.Pretty (pp_value)
  43 import Text.JSON.Types
  44 import Text.JSON
  45
  46 import qualified Ganeti.Constants as C
  47 import Ganeti.THH
  48
  49 -- * THH declarations, that require ordering.
  50
  51 -- | Status of a query field.
  52 $(declareIADT "ResultStatus"
  53   [ ("RSNormal",  'C.rsNormal )
  54   , ("RSUnknown", 'C.rsUnknown )
  55   , ("RSNoData",  'C.rsNodata )
  56   , ("RSUnavail", 'C.rsUnavail )
  57   , ("RSOffline", 'C.rsOffline )
  58   ])
  59 $(makeJSONInstance ''ResultStatus)
  60
  61 -- | Type of a query field.
  62 $(declareSADT "FieldType"
  63   [ ("QFTUnknown",   'C.qftUnknown )
  64   , ("QFTText",      'C.qftText )
  65   , ("QFTBool",      'C.qftBool )
  66   , ("QFTNumber",    'C.qftNumber )
  67   , ("QFTUnit",      'C.qftUnit )
  68   , ("QFTTimestamp", 'C.qftTimestamp )
  69   , ("QFTOther",     'C.qftOther )
  70   ])
  71 $(makeJSONInstance ''FieldType)
  72
  73 -- | Supported items on which Qlang works.
  74 $(declareSADT "ItemType"
  75   [ ("QRCluster",  'C.qrCluster )
  76   , ("QRInstance", 'C.qrInstance )
  77   , ("QRNode",     'C.qrNode )
  78   , ("QRLock",     'C.qrLock )
  79   , ("QRGroup",    'C.qrGroup )
  80   , ("QROs",       'C.qrOs )
  81   , ("QRJob",      'C.qrJob )
  82   , ("QRExport",   'C.qrExport )
  83   ])
  84 $(makeJSONInstance ''ItemType)
  85
  86 -- * Main Qlang queries and responses.
  87
  88 -- | Query2 query.
  89 data Query = Query ItemType Fields (Maybe Filter)
  90
  91 -- | Query2 result.
  92 data QueryResult = QueryResult [ FieldDefinition ] [ ResultEntry ]
  93
  94 -- | Query2 Fields query.
  95 -- (to get supported fields names, descriptions, and types)
  96 data QueryFields = QueryFields ItemType Fields
  97
  98 -- | Query2 Fields result.
  99 data QueryFieldsResult = QueryFieldsResult [ FieldDefinition ]
 100
 101 -- * Sub data types for query2 queries and responses.
 102
 103 -- | List of requested fields.
 104 type Fields = [ String ]
 105
 106 -- | Query2 filter expression.
 107 data Filter
 108     = EmptyFilter                             -- ^ No filter at all
 109     | AndFilter      [ Filter ]               -- ^ & [<expression>, ...]
 110     | OrFilter       [ Filter ]               -- ^ | [<expression>, ...]
 111     | NotFilter      Filter                   -- ^ ! <expression>
 112     | TrueFilter     FilterField              -- ^ ? <field>
 113     | EQFilter       FilterField FilterValue  -- ^ (=|!=) <field> <value>
 114     | LTFilter       FilterField FilterValue  -- ^ < <field> <value>
 115     | GTFilter       FilterField FilterValue  -- ^ > <field> <value>
 116     | LEFilter       FilterField FilterValue  -- ^ <= <field> <value>
 117     | GEFilter       FilterField FilterValue  -- ^ >= <field> <value>
 118     | RegexpFilter   FilterField FilterRegexp -- ^ =~ <field> <regexp>
 119     | ContainsFilter FilterField FilterValue  -- ^ =[] <list-field> <value>
 120       deriving (Show, Read, Eq)
 121
 122 -- | Serialiser for the 'Filter' data type.
 123 showFilter :: Filter -> JSValue
 124 showFilter (EmptyFilter)          = JSNull
 125 showFilter (AndFilter exprs)      =
 126   JSArray $ (showJSON C.qlangOpAnd):(map showJSON exprs)
 127 showFilter (OrFilter  exprs)      =
 128   JSArray $ (showJSON C.qlangOpOr):(map showJSON exprs)
 129 showFilter (NotFilter flt)        =
 130   JSArray [showJSON C.qlangOpNot, showJSON flt]
 131 showFilter (TrueFilter field)     =
 132   JSArray [showJSON C.qlangOpTrue, showJSON field]
 133 showFilter (EQFilter field value) =
 134   JSArray [showJSON C.qlangOpEqual, showJSON field, showJSON value]
 135 showFilter (LTFilter field value) =
 136   JSArray [showJSON C.qlangOpLt, showJSON field, showJSON value]
 137 showFilter (GTFilter field value) =
 138   JSArray [showJSON C.qlangOpGt, showJSON field, showJSON value]
 139 showFilter (LEFilter field value) =
 140   JSArray [showJSON C.qlangOpLe, showJSON field, showJSON value]
 141 showFilter (GEFilter field value) =
 142   JSArray [showJSON C.qlangOpGe, showJSON field, showJSON value]
 143 showFilter (RegexpFilter field regexp) =
 144   JSArray [showJSON C.qlangOpRegexp, showJSON field, showJSON regexp]
 145 showFilter (ContainsFilter field value) =
 146   JSArray [showJSON C.qlangOpContains, showJSON field, showJSON value]
 147
 148 -- | Deserializer for the 'Filter' data type.
 149 readFilter :: JSValue -> Result Filter
 150 readFilter JSNull = Ok EmptyFilter
 151 readFilter (JSArray (JSString op:args)) =
 152   readFilterArray (fromJSString op) args
 153 readFilter v =
 154   Error $ "Cannot deserialise filter: expected array [string, args], got " ++
 155         show (pp_value v)
 156
 157 -- | Helper to deserialise an array corresponding to a single filter
 158 -- and return the built filter. Note this looks generic but is (at
 159 -- least currently) only used for the NotFilter.
 160 readFilterArg :: (Filter -> Filter) -- ^ Constructor
 161               -> [JSValue]          -- ^ Single argument
 162               -> Result Filter
 163 readFilterArg constr [flt] = constr <$> readJSON flt
 164 readFilterArg _ v = Error $ "Cannot deserialise field, expected [filter]\
 165                             \ but got " ++ show (pp_value (showJSON v))
 166
 167 -- | Helper to deserialise an array corresponding to a single field
 168 -- and return the built filter.
 169 readFilterField :: (FilterField -> Filter) -- ^ Constructor
 170                 -> [JSValue]               -- ^ Single argument
 171                 -> Result Filter
 172 readFilterField constr [field] = constr <$> readJSON field
 173 readFilterField _ v = Error $ "Cannot deserialise field, expected [fieldname]\
 174                               \ but got " ++ show (pp_value (showJSON v))
 175
 176 -- | Helper to deserialise an array corresponding to a field and
 177 -- value, returning the built filter.
 178 readFilterFieldValue :: (JSON a) =>
 179                         (FilterField -> a -> Filter) -- ^ Constructor
 180                      -> [JSValue] -- ^ Arguments array
 181                      -> Result Filter
 182 readFilterFieldValue constr [field, value] =
 183   constr <$> readJSON field <*> readJSON value
 184 readFilterFieldValue _ v =
 185   Error $ "Cannot deserialise field/value pair, expected [fieldname, value]\
 186           \ but got " ++ show (pp_value (showJSON v))
 187
 188 -- | Inner deserialiser for 'Filter'.
 189 readFilterArray :: String -> [JSValue] -> Result Filter
 190 readFilterArray op args
 191   | op == C.qlangOpAnd      = AndFilter <$> mapM readJSON args
 192   | op == C.qlangOpOr       = OrFilter  <$> mapM readJSON args
 193   | op == C.qlangOpNot      = readFilterArg        NotFilter args
 194   | op == C.qlangOpTrue     = readFilterField      TrueFilter args
 195   | op == C.qlangOpEqual    = readFilterFieldValue EQFilter args
 196   | op == C.qlangOpLt       = readFilterFieldValue LTFilter args
 197   | op == C.qlangOpGt       = readFilterFieldValue GTFilter args
 198   | op == C.qlangOpLe       = readFilterFieldValue LEFilter args
 199   | op == C.qlangOpGe       = readFilterFieldValue GEFilter args
 200   | op == C.qlangOpRegexp   = readFilterFieldValue RegexpFilter args
 201   | op == C.qlangOpContains = readFilterFieldValue ContainsFilter args
 202   | otherwise = Error $ "Unknown filter operand '" ++ op ++ "'"
 203
 204 instance JSON Filter where
 205   showJSON = showFilter
 206   readJSON = readFilter
 207
 208 -- | Field name to filter on.
 209 type FilterField = String
 210
 211 -- | Value to compare the field value to, for filtering purposes.
 212 data FilterValue = QuotedString String
 213                  | NumericValue Integer
 214                    deriving (Read, Show, Eq)
 215
 216 -- | Serialiser for 'FilterValue'. The Python code just sends this to
 217 -- JSON as-is, so we'll do the same.
 218 showFilterValue :: FilterValue -> JSValue
 219 showFilterValue (QuotedString str) = showJSON str
 220 showFilterValue (NumericValue val) = showJSON val
 221
 222 -- | Decoder for 'FilterValue'. We have to see what it contains, since
 223 -- the context doesn't give us hints on what to expect.
 224 readFilterValue :: JSValue -> Result FilterValue
 225 readFilterValue (JSString a) = Ok . QuotedString $ fromJSString a
 226 readFilterValue (JSRational _ x) =
 227   if denominator x /= 1
 228     then Error $ "Cannot deserialise numeric filter value,\
 229                  \ expecting integral but\
 230                  \ got a fractional value: " ++ show x
 231     else Ok . NumericValue $ numerator x
 232 readFilterValue v = Error $ "Cannot deserialise filter value, expecting\
 233                             \ string or integer, got " ++ show (pp_value v)
 234
 235 instance JSON FilterValue where
 236   showJSON = showFilterValue
 237   readJSON = readFilterValue
 238
 239 -- | Regexp to apply to the filter value, for filteriong purposes.
 240 type FilterRegexp = String
 241
 242 -- | Definition of a field.
 243 data FieldDefinition = FieldDefinition FieldName FieldTitle FieldType FieldDoc
 244
 245 -- | Name of a field.
 246 type FieldName = String
 247 -- | Title of a field, when represented in tabular format.
 248 type FieldTitle = String
 249 -- | Human redable description of a field.
 250 type FieldDoc = String
 251
 252 --- | Single field entry result.
 253 data ResultEntry = ResultEntry ResultStatus (Maybe ResultValue)
 254
 255 -- | Value of a field, in json encoding.
 256 -- (its type will be depending on ResultStatus and FieldType)
 257 type ResultValue = JSValue