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     , checkRS
  39     ) where
  40
  41 import Control.Applicative
  42 import Data.Ratio (numerator, denominator)
  43 import Text.JSON.Pretty (pp_value)
  44 import Text.JSON.Types
  45 import Text.JSON
  46
  47 import qualified Ganeti.Constants as C
  48 import Ganeti.THH
  49
  50 -- * THH declarations, that require ordering.
  51
  52 -- | Status of a query field.
  53 $(declareIADT "ResultStatus"
  54   [ ("RSNormal",  'C.rsNormal )
  55   , ("RSUnknown", 'C.rsUnknown )
  56   , ("RSNoData",  'C.rsNodata )
  57   , ("RSUnavail", 'C.rsUnavail )
  58   , ("RSOffline", 'C.rsOffline )
  59   ])
  60 $(makeJSONInstance ''ResultStatus)
  61
  62 -- | Check that ResultStatus is success or fail with descriptive
  63 -- message.
  64 checkRS :: (Monad m) => ResultStatus -> a -> m a
  65 checkRS RSNormal val = return val
  66 checkRS RSUnknown  _ = fail "Unknown field"
  67 checkRS RSNoData   _ = fail "No data for a field"
  68 checkRS RSUnavail  _ = fail "Ganeti reports unavailable data"
  69 checkRS RSOffline  _ = fail "Ganeti reports resource as offline"
  70
  71 -- | Type of a query field.
  72 $(declareSADT "FieldType"
  73   [ ("QFTUnknown",   'C.qftUnknown )
  74   , ("QFTText",      'C.qftText )
  75   , ("QFTBool",      'C.qftBool )
  76   , ("QFTNumber",    'C.qftNumber )
  77   , ("QFTUnit",      'C.qftUnit )
  78   , ("QFTTimestamp", 'C.qftTimestamp )
  79   , ("QFTOther",     'C.qftOther )
  80   ])
  81 $(makeJSONInstance ''FieldType)
  82
  83 -- | Supported items on which Qlang works.
  84 $(declareSADT "ItemType"
  85   [ ("QRCluster",  'C.qrCluster )
  86   , ("QRInstance", 'C.qrInstance )
  87   , ("QRNode",     'C.qrNode )
  88   , ("QRLock",     'C.qrLock )
  89   , ("QRGroup",    'C.qrGroup )
  90   , ("QROs",       'C.qrOs )
  91   , ("QRJob",      'C.qrJob )
  92   , ("QRExport",   'C.qrExport )
  93   ])
  94 $(makeJSONInstance ''ItemType)
  95
  96 -- * Main Qlang queries and responses.
  97
  98 -- | Query2 query.
  99 data Query = Query ItemType Fields (Maybe Filter)
 100
 101 -- | Query2 result.
 102 data QueryResult = QueryResult [ FieldDefinition ] [ ResultEntry ]
 103
 104 -- | Query2 Fields query.
 105 -- (to get supported fields names, descriptions, and types)
 106 data QueryFields = QueryFields ItemType Fields
 107
 108 -- | Query2 Fields result.
 109 data QueryFieldsResult = QueryFieldsResult [ FieldDefinition ]
 110
 111 -- * Sub data types for query2 queries and responses.
 112
 113 -- | List of requested fields.
 114 type Fields = [ String ]
 115
 116 -- | Query2 filter expression.
 117 data Filter
 118     = EmptyFilter                             -- ^ No filter at all
 119     | AndFilter      [ Filter ]               -- ^ & [<expression>, ...]
 120     | OrFilter       [ Filter ]               -- ^ | [<expression>, ...]
 121     | NotFilter      Filter                   -- ^ ! <expression>
 122     | TrueFilter     FilterField              -- ^ ? <field>
 123     | EQFilter       FilterField FilterValue  -- ^ (=|!=) <field> <value>
 124     | LTFilter       FilterField FilterValue  -- ^ < <field> <value>
 125     | GTFilter       FilterField FilterValue  -- ^ > <field> <value>
 126     | LEFilter       FilterField FilterValue  -- ^ <= <field> <value>
 127     | GEFilter       FilterField FilterValue  -- ^ >= <field> <value>
 128     | RegexpFilter   FilterField FilterRegexp -- ^ =~ <field> <regexp>
 129     | ContainsFilter FilterField FilterValue  -- ^ =[] <list-field> <value>
 130       deriving (Show, Read, Eq)
 131
 132 -- | Serialiser for the 'Filter' data type.
 133 showFilter :: Filter -> JSValue
 134 showFilter (EmptyFilter)          = JSNull
 135 showFilter (AndFilter exprs)      =
 136   JSArray $ (showJSON C.qlangOpAnd):(map showJSON exprs)
 137 showFilter (OrFilter  exprs)      =
 138   JSArray $ (showJSON C.qlangOpOr):(map showJSON exprs)
 139 showFilter (NotFilter flt)        =
 140   JSArray [showJSON C.qlangOpNot, showJSON flt]
 141 showFilter (TrueFilter field)     =
 142   JSArray [showJSON C.qlangOpTrue, showJSON field]
 143 showFilter (EQFilter field value) =
 144   JSArray [showJSON C.qlangOpEqual, showJSON field, showJSON value]
 145 showFilter (LTFilter field value) =
 146   JSArray [showJSON C.qlangOpLt, showJSON field, showJSON value]
 147 showFilter (GTFilter field value) =
 148   JSArray [showJSON C.qlangOpGt, showJSON field, showJSON value]
 149 showFilter (LEFilter field value) =
 150   JSArray [showJSON C.qlangOpLe, showJSON field, showJSON value]
 151 showFilter (GEFilter field value) =
 152   JSArray [showJSON C.qlangOpGe, showJSON field, showJSON value]
 153 showFilter (RegexpFilter field regexp) =
 154   JSArray [showJSON C.qlangOpRegexp, showJSON field, showJSON regexp]
 155 showFilter (ContainsFilter field value) =
 156   JSArray [showJSON C.qlangOpContains, showJSON field, showJSON value]
 157
 158 -- | Deserializer for the 'Filter' data type.
 159 readFilter :: JSValue -> Result Filter
 160 readFilter JSNull = Ok EmptyFilter
 161 readFilter (JSArray (JSString op:args)) =
 162   readFilterArray (fromJSString op) args
 163 readFilter v =
 164   Error $ "Cannot deserialise filter: expected array [string, args], got " ++
 165         show (pp_value v)
 166
 167 -- | Helper to deserialise an array corresponding to a single filter
 168 -- and return the built filter. Note this looks generic but is (at
 169 -- least currently) only used for the NotFilter.
 170 readFilterArg :: (Filter -> Filter) -- ^ Constructor
 171               -> [JSValue]          -- ^ Single argument
 172               -> Result Filter
 173 readFilterArg constr [flt] = constr <$> readJSON flt
 174 readFilterArg _ v = Error $ "Cannot deserialise field, expected [filter]\
 175                             \ but got " ++ show (pp_value (showJSON v))
 176
 177 -- | Helper to deserialise an array corresponding to a single field
 178 -- and return the built filter.
 179 readFilterField :: (FilterField -> Filter) -- ^ Constructor
 180                 -> [JSValue]               -- ^ Single argument
 181                 -> Result Filter
 182 readFilterField constr [field] = constr <$> readJSON field
 183 readFilterField _ v = Error $ "Cannot deserialise field, expected [fieldname]\
 184                               \ but got " ++ show (pp_value (showJSON v))
 185
 186 -- | Helper to deserialise an array corresponding to a field and
 187 -- value, returning the built filter.
 188 readFilterFieldValue :: (JSON a) =>
 189                         (FilterField -> a -> Filter) -- ^ Constructor
 190                      -> [JSValue] -- ^ Arguments array
 191                      -> Result Filter
 192 readFilterFieldValue constr [field, value] =
 193   constr <$> readJSON field <*> readJSON value
 194 readFilterFieldValue _ v =
 195   Error $ "Cannot deserialise field/value pair, expected [fieldname, value]\
 196           \ but got " ++ show (pp_value (showJSON v))
 197
 198 -- | Inner deserialiser for 'Filter'.
 199 readFilterArray :: String -> [JSValue] -> Result Filter
 200 readFilterArray op args
 201   | op == C.qlangOpAnd      = AndFilter <$> mapM readJSON args
 202   | op == C.qlangOpOr       = OrFilter  <$> mapM readJSON args
 203   | op == C.qlangOpNot      = readFilterArg        NotFilter args
 204   | op == C.qlangOpTrue     = readFilterField      TrueFilter args
 205   | op == C.qlangOpEqual    = readFilterFieldValue EQFilter args
 206   | op == C.qlangOpLt       = readFilterFieldValue LTFilter args
 207   | op == C.qlangOpGt       = readFilterFieldValue GTFilter args
 208   | op == C.qlangOpLe       = readFilterFieldValue LEFilter args
 209   | op == C.qlangOpGe       = readFilterFieldValue GEFilter args
 210   | op == C.qlangOpRegexp   = readFilterFieldValue RegexpFilter args
 211   | op == C.qlangOpContains = readFilterFieldValue ContainsFilter args
 212   | otherwise = Error $ "Unknown filter operand '" ++ op ++ "'"
 213
 214 instance JSON Filter where
 215   showJSON = showFilter
 216   readJSON = readFilter
 217
 218 -- | Field name to filter on.
 219 type FilterField = String
 220
 221 -- | Value to compare the field value to, for filtering purposes.
 222 data FilterValue = QuotedString String
 223                  | NumericValue Integer
 224                    deriving (Read, Show, Eq)
 225
 226 -- | Serialiser for 'FilterValue'. The Python code just sends this to
 227 -- JSON as-is, so we'll do the same.
 228 showFilterValue :: FilterValue -> JSValue
 229 showFilterValue (QuotedString str) = showJSON str
 230 showFilterValue (NumericValue val) = showJSON val
 231
 232 -- | Decoder for 'FilterValue'. We have to see what it contains, since
 233 -- the context doesn't give us hints on what to expect.
 234 readFilterValue :: JSValue -> Result FilterValue
 235 readFilterValue (JSString a) = Ok . QuotedString $ fromJSString a
 236 readFilterValue (JSRational _ x) =
 237   if denominator x /= 1
 238     then Error $ "Cannot deserialise numeric filter value,\
 239                  \ expecting integral but\
 240                  \ got a fractional value: " ++ show x
 241     else Ok . NumericValue $ numerator x
 242 readFilterValue v = Error $ "Cannot deserialise filter value, expecting\
 243                             \ string or integer, got " ++ show (pp_value v)
 244
 245 instance JSON FilterValue where
 246   showJSON = showFilterValue
 247   readJSON = readFilterValue
 248
 249 -- | Regexp to apply to the filter value, for filteriong purposes.
 250 type FilterRegexp = String
 251
 252 -- | Definition of a field.
 253 data FieldDefinition = FieldDefinition FieldName FieldTitle FieldType FieldDoc
 254
 255 -- | Name of a field.
 256 type FieldName = String
 257 -- | Title of a field, when represented in tabular format.
 258 type FieldTitle = String
 259 -- | Human redable description of a field.
 260 type FieldDoc = String
 261
 262 --- | Single field entry result.
 263 data ResultEntry = ResultEntry ResultStatus (Maybe ResultValue)
 264
 265 -- | Value of a field, in json encoding.
 266 -- (its type will be depending on ResultStatus and FieldType)
 267 type ResultValue = JSValue