Revision 91c1a265 test/hs/Test/Ganeti/Query/Query.hs

b/test/hs/Test/Ganeti/Query/Query.hs
1 
{-# LANGUAGE TemplateHaskell #-}
1 
{-# LANGUAGE TemplateHaskell, BangPatterns #-}
2 2 
{-# OPTIONS_GHC -fno-warn-orphans #-}
3 3 

  		





  4
  4
  
    
{-| Unittests for ganeti-htools.


  		





  ......




  36
  36
  
    
import Data.List


  		





  37
  37
  
    
import qualified Data.Map as Map


  		





  38
  38
  
    
import Data.Maybe


  		





  
  39
  
    
import qualified Data.Set as Set


  		





  39
  40
  
    
import Text.JSON (JSValue(..), showJSON)


  		





  40
  41
  
    

  		





  41
  42
  
    
import Test.Ganeti.TestHelper


  		





  ......




  44
  45
  
    

  		





  45
  46
  
    
import Ganeti.BasicTypes


  		





  46
  47
  
    
import Ganeti.Errors


  		





  
  48
  
    
import Ganeti.JSON


  		





  
  49
  
    
import Ganeti.Objects


  		





  47
  50
  
    
import Ganeti.Query.Filter


  		





  48
  51
  
    
import qualified Ganeti.Query.Group as Group


  		





  49
  52
  
    
import Ganeti.Query.Language


  		





  50
  53
  
    
import qualified Ganeti.Query.Node as Node


  		





  51
  54
  
    
import Ganeti.Query.Query


  		





  52
  55
  
    
import qualified Ganeti.Query.Job as Job


  		





  
  56
  
    
import Ganeti.Utils (sepSplit)


  		





  53
  57
  
    

  		





  54
  58
  
    
{-# ANN module "HLint: ignore Use camelCase" #-}


  		





  55
  59
  
    

  		





  ......




  163
  167
  
    
    (sortBy field_sort . map (\(f, _, _) -> f) $ Map.elems Node.fieldsMap)


  		





  164
  168
  
    
    (sortBy field_sort fdefs)


  		





  165
  169
  
    

  		





  
  170
  
    
-- | Check if cluster node names are unique (first elems).


  		





  
  171
  
    
areNodeNamesSane :: ConfigData -> Bool


  		





  
  172
  
    
areNodeNamesSane cfg =


  		





  
  173
  
    
  let fqdns = map nodeName . Map.elems . fromContainer $ configNodes cfg


  		





  
  174
  
    
      names = map (head . sepSplit '.') fqdns


  		





  
  175
  
    
  in length names == length (nub names)


  		





  
  176
  
    

  		





  
  177
  
    
-- | Check that the nodes reported by a name filter are sane.


  		





  
  178
  
    
prop_queryNode_filter :: Property


  		





  
  179
  
    
prop_queryNode_filter =


  		





  
  180
  
    
  forAll (choose (1, maxNodes)) $ \nodes ->


  		





  
  181
  
    
  forAll (genEmptyCluster nodes `suchThat`


  		





  
  182
  
    
          areNodeNamesSane) $ \cluster -> monadicIO $ do


  		





  
  183
  
    
    let node_list = map nodeName . Map.elems . fromContainer $


  		





  
  184
  
    
                    configNodes cluster


  		





  
  185
  
    
    count <- pick $ choose (1, nodes)


  		





  
  186
  
    
    fqdn_set <- pick . genSetHelper node_list $ Just count


  		





  
  187
  
    
    let fqdns = Set.elems fqdn_set


  		





  
  188
  
    
        names = map (head . sepSplit '.') fqdns


  		





  
  189
  
    
        flt = makeSimpleFilter "name" $ map Left names


  		





  
  190
  
    
    QueryResult _ fdata <-


  		





  
  191
  
    
      run (query cluster False (Query (ItemTypeOpCode QRNode)


  		





  
  192
  
    
                                ["name"] flt)) >>= resultProp


  		





  
  193
  
    
    stop $ conjoin


  		





  
  194
  
    
      [ printTestCase "Invalid node names" $


  		





  
  195
  
    
        map (map rentryValue) fdata ==? map (\f -> [Just (showJSON f)]) fqdns


  		





  
  196
  
    
      ]


  		





  
  197
  
    

  		





  166
  198
  
    
-- ** Group queries


  		





  167
  199
  
    

  		





  168
  200
  
    
prop_queryGroup_noUnknown :: Property


  		





  ......




  328
  360
  
    
  [ 'prop_queryNode_noUnknown


  		





  329
  361
  
    
  , 'prop_queryNode_Unknown


  		





  330
  362
  
    
  , 'prop_queryNode_types


  		





  
  363
  
    
  , 'prop_queryNode_filter


  		





  331
  364
  
    
  , 'case_queryNode_allfields


  		





  332
  365
  
    
  , 'prop_queryGroup_noUnknown


  		





  333
  366
  
    
  , 'prop_queryGroup_Unknown


  		












Also available in:
  Unified diff