Revision ad1c1e41

b/htest/Test/Ganeti/OpCodes.hs
451 451 
  sample_opcodes <- sample' (vectorOf num_opcodes
452 452 
                             (arbitrary::Gen OpCodes.MetaOpCode))
453 453 
  let opcodes = head sample_opcodes
454 
      with_sum = map (\o -> (OpCodes.opSummary $
455 
                             OpCodes.metaOpCode o, o)) opcodes
454 456 
      serialized = J.encode opcodes
455 457 
  -- check for non-ASCII fields, usually due to 'arbitrary :: String'
456 458 
  mapM_ (\op -> when (any (not . isAscii) (J.encode op)) .
......
465 467 
               \decoded = [opcodes.OpCode.LoadOpCode(o) for o in op_data]\n\
466 468 
               \for op in decoded:\n\
467 469 
               \  op.Validate(True)\n\
468 
               \encoded = [op.__getstate__() for op in decoded]\n\
470 
               \encoded = [(op.Summary(), op.__getstate__())\n\
471 
               \           for op in decoded]\n\
469 472 
               \print serializer.Dump(encoded)" serialized
470 473 
     >>= checkPythonResult
471 
  let deserialised = J.decode py_stdout::J.Result [OpCodes.MetaOpCode]
474 
  let deserialised =
475 
        J.decode py_stdout::J.Result [(String, OpCodes.MetaOpCode)]
472 476 
  decoded <- case deserialised of
473 477 
               J.Ok ops -> return ops
474 478 
               J.Error msg ->
......
477 481 
                 -- for proper types
478 482 
                 >> fail "Unable to decode opcodes"
479 483 
  HUnit.assertEqual "Mismatch in number of returned opcodes"
480 
    (length opcodes) (length decoded)
484 
    (length decoded) (length with_sum)
481 485 
  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
482 
        ) $ zip opcodes decoded
486 
        ) $ zip decoded with_sum
483 487 

  		





  484
  488
  
    
-- | Custom HUnit test case that forks a Python process and checks


  		





  485
  489
  
    
-- correspondence between Haskell OpCodes fields and their Python


  		












  

    
      b/htools/Ganeti/OpCodes.hs
    
  






  38
  38
  
    
  , opID


  		





  39
  39
  
    
  , allOpIDs


  		





  40
  40
  
    
  , allOpFields


  		





  
  41
  
    
  , opSummary


  		





  41
  42
  
    
  , CommonOpParams(..)


  		





  42
  43
  
    
  , defOpParams


  		





  43
  44
  
    
  , MetaOpCode(..)


  		





  ......




  45
  46
  
    
  , setOpComment


  		





  46
  47
  
    
  ) where


  		





  47
  48
  
    

  		





  
  49
  
    
import Data.Maybe (fromMaybe)


  		





  48
  50
  
    
import Text.JSON (readJSON, showJSON, JSON, JSValue, makeObj)


  		





  49
  51
  
    
import qualified Text.JSON


  		





  50
  52
  
    

  		





  51
  53
  
    
import Ganeti.THH


  		





  52
  54
  
    

  		





  53
  55
  
    
import Ganeti.OpParams


  		





  54
  
  
    
import Ganeti.Types (OpSubmitPriority(..))


  		





  
  56
  
    
import Ganeti.Types (OpSubmitPriority(..), fromNonEmpty)


  		





  
  57
  
    
import Ganeti.Query.Language (queryTypeOpToRaw)


  		





  55
  58
  
    

  		





  56
  59
  
    
-- | OpCode representation.


  		





  57
  60
  
    
--


  		





  ......




  548
  551
  
    
  readJSON = loadOpCode


  		





  549
  552
  
    
  showJSON = saveOpCode


  		





  550
  553
  
    

  		





  
  554
  
    
-- | Generates the summary value for an opcode.


  		





  
  555
  
    
opSummaryVal :: OpCode -> Maybe String


  		





  
  556
  
    
opSummaryVal OpClusterVerifyGroup { opGroupName = s } = Just (fromNonEmpty s)


  		





  
  557
  
    
opSummaryVal OpGroupVerifyDisks { opGroupName = s } = Just (fromNonEmpty s)


  		





  
  558
  
    
opSummaryVal OpClusterRename { opName = s } = Just (fromNonEmpty s)


  		





  
  559
  
    
opSummaryVal OpQuery { opWhat = s } = Just (queryTypeOpToRaw s)


  		





  
  560
  
    
opSummaryVal OpQueryFields { opWhat = s } = Just (queryTypeOpToRaw s)


  		





  
  561
  
    
opSummaryVal OpNodeRemove { opNodeName = s } = Just (fromNonEmpty s)


  		





  
  562
  
    
opSummaryVal OpNodeAdd { opNodeName = s } = Just (fromNonEmpty s)


  		





  
  563
  
    
opSummaryVal OpNodeModifyStorage { opNodeName = s } = Just (fromNonEmpty s)


  		





  
  564
  
    
opSummaryVal OpRepairNodeStorage  { opNodeName = s } = Just (fromNonEmpty s)


  		





  
  565
  
    
opSummaryVal OpNodeSetParams { opNodeName = s } = Just (fromNonEmpty s)


  		





  
  566
  
    
opSummaryVal OpNodePowercycle { opNodeName = s } = Just (fromNonEmpty s)


  		





  
  567
  
    
opSummaryVal OpNodeMigrate { opNodeName = s } = Just (fromNonEmpty s)


  		





  
  568
  
    
opSummaryVal OpNodeEvacuate { opNodeName = s } = Just (fromNonEmpty s)


  		





  
  569
  
    
opSummaryVal OpInstanceCreate { opInstanceName = s } = Just s


  		





  
  570
  
    
opSummaryVal OpInstanceReinstall { opInstanceName = s } = Just s


  		





  
  571
  
    
opSummaryVal OpInstanceRemove { opInstanceName = s } = Just s


  		





  
  572
  
    
-- FIXME: instance rename should show both names; currently it shows none


  		





  
  573
  
    
-- opSummaryVal OpInstanceRename { opInstanceName = s } = Just s


  		





  
  574
  
    
opSummaryVal OpInstanceStartup { opInstanceName = s } = Just s


  		





  
  575
  
    
opSummaryVal OpInstanceShutdown { opInstanceName = s } = Just s


  		





  
  576
  
    
opSummaryVal OpInstanceReboot { opInstanceName = s } = Just s


  		





  
  577
  
    
opSummaryVal OpInstanceReplaceDisks { opInstanceName = s } = Just s


  		





  
  578
  
    
opSummaryVal OpInstanceFailover { opInstanceName = s } = Just s


  		





  
  579
  
    
opSummaryVal OpInstanceMigrate { opInstanceName = s } = Just s


  		





  
  580
  
    
opSummaryVal OpInstanceMove { opInstanceName = s } = Just s


  		





  
  581
  
    
opSummaryVal OpInstanceConsole { opInstanceName = s } = Just s


  		





  
  582
  
    
opSummaryVal OpInstanceActivateDisks { opInstanceName = s } = Just s


  		





  
  583
  
    
opSummaryVal OpInstanceDeactivateDisks { opInstanceName = s } = Just s


  		





  
  584
  
    
opSummaryVal OpInstanceRecreateDisks { opInstanceName = s } = Just s


  		





  
  585
  
    
opSummaryVal OpInstanceSetParams { opInstanceName = s } = Just s


  		





  
  586
  
    
opSummaryVal OpInstanceGrowDisk { opInstanceName = s } = Just s


  		





  
  587
  
    
opSummaryVal OpInstanceChangeGroup { opInstanceName = s } = Just s


  		





  
  588
  
    
opSummaryVal OpGroupAdd { opGroupName = s } = Just (fromNonEmpty s)


  		





  
  589
  
    
opSummaryVal OpGroupAssignNodes { opGroupName = s } = Just (fromNonEmpty s)


  		





  
  590
  
    
opSummaryVal OpGroupSetParams { opGroupName = s } = Just (fromNonEmpty s)


  		





  
  591
  
    
opSummaryVal OpGroupRemove { opGroupName = s } = Just (fromNonEmpty s)


  		





  
  592
  
    
opSummaryVal OpGroupEvacuate { opGroupName = s } = Just (fromNonEmpty s)


  		





  
  593
  
    
opSummaryVal OpBackupPrepare { opInstanceName = s } = Just s


  		





  
  594
  
    
opSummaryVal OpBackupExport { opInstanceName = s } = Just s


  		





  
  595
  
    
opSummaryVal OpBackupRemove { opInstanceName = s } = Just s


  		





  
  596
  
    
opSummaryVal OpTagsGet { opKind = k } =


  		





  
  597
  
    
  Just . fromMaybe "None" $ tagNameOf k


  		





  
  598
  
    
opSummaryVal OpTagsSearch { opTagSearchPattern = s } = Just (fromNonEmpty s)


  		





  
  599
  
    
opSummaryVal OpTestDelay { opDelayDuration = d } = Just (show d)


  		





  
  600
  
    
opSummaryVal OpTestAllocator { opIallocator = s } =


  		





  
  601
  
    
  -- FIXME: Python doesn't handle None fields well, so we have behave the same


  		





  
  602
  
    
  Just $ maybe "None" fromNonEmpty s


  		





  
  603
  
    
opSummaryVal OpNetworkAdd { opNetworkName = s} = Just (fromNonEmpty s)


  		





  
  604
  
    
opSummaryVal OpNetworkRemove { opNetworkName = s} = Just (fromNonEmpty s)


  		





  
  605
  
    
opSummaryVal OpNetworkSetParams { opNetworkName = s} = Just (fromNonEmpty s)


  		





  
  606
  
    
opSummaryVal OpNetworkConnect { opNetworkName = s} = Just (fromNonEmpty s)


  		





  
  607
  
    
opSummaryVal OpNetworkDisconnect { opNetworkName = s} = Just (fromNonEmpty s)


  		





  
  608
  
    
opSummaryVal _ = Nothing


  		





  
  609
  
    

  		





  
  610
  
    
-- | Computes the summary of the opcode.


  		





  
  611
  
    
opSummary :: OpCode -> String


  		





  
  612
  
    
opSummary op =


  		





  
  613
  
    
  case opSummaryVal op of


  		





  
  614
  
    
    Nothing -> op_suffix


  		





  
  615
  
    
    Just s -> op_suffix ++ "(" ++ s ++ ")"


  		





  
  616
  
    
  where op_suffix = drop 3 $ opID op


  		





  
  617
  
    

  		





  551
  618
  
    
-- | Generic\/common opcode parameters.


  		





  552
  619
  
    
$(buildObject "CommonOpParams" "op"


  		





  553
  620
  
    
  [ pDryRun


  		





  ......




  568
  635
  
    
                 }


  		





  569
  636
  
    

  		





  570
  637
  
    
-- | The top-level opcode type.


  		





  571
  
  
    
data MetaOpCode = MetaOpCode CommonOpParams OpCode


  		





  572
  
  
    
                  deriving (Show, Eq)


  		





  
  638
  
    
data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams


  		





  
  639
  
    
                             , metaOpCode :: OpCode


  		





  
  640
  
    
                             } deriving (Show, Eq)


  		





  573
  641
  
    

  		





  574
  642
  
    
-- | JSON serialisation for 'MetaOpCode'.


  		





  575
  643
  
    
showMeta :: MetaOpCode -> JSValue


  		












  

    
      b/htools/Ganeti/OpParams.hs
    
  






  35
  35
  
    
  ( TagType(..)


  		





  36
  36
  
    
  , TagObject(..)


  		





  37
  37
  
    
  , tagObjectFrom


  		





  
  38
  
    
  , tagNameOf


  		





  38
  39
  
    
  , decodeTagObject


  		





  39
  40
  
    
  , encodeTagObject


  		





  40
  41
  
    
  , ReplaceDisksMode(..)


  		












  

    
      b/htools/Ganeti/Query/Language.hs
    
  






  48
  48
  
    
    , ResultValue


  		





  49
  49
  
    
    , ItemType(..)


  		





  50
  50
  
    
    , QueryTypeOp(..)


  		





  
  51
  
    
    , queryTypeOpToRaw


  		





  51
  52
  
    
    , QueryTypeLuxi(..)


  		





  52
  53
  
    
    , checkRS


  		





  53
  54
  
    
    ) where


  		












Also available in:
  Unified diff