htools: read/save the disk template in Text backend

This requires that we change the signature of loadInst in order to
properly annotate the error messages, which in turn requires more
unittest changes.

Also, this invalidates yet again saved data files…
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>

htools/Ganeti/HTools/QC.hs

@@ -506,7 +506,7 @@ testInstance =
 
 prop_Text_Load_Instance name mem dsk vcpus status
                         (NonEmpty pnode) snode
-                        (NonNegative pdx) (NonNegative sdx) autobal =
+                        (NonNegative pdx) (NonNegative sdx) autobal dt =
     pnode /= snode && pdx /= sdx ==>
     let vcpus_s = show vcpus
         dsk_s = show dsk
@@ -517,20 +517,23 @@ prop_Text_Load_Instance name mem dsk vcpus status
         nl = Data.Map.fromList ndx
         tags = ""
         sbal = if autobal then "Y" else "N"
+        sdt = Types.dtToString dt
         inst = Text.loadInst nl
                [name, mem_s, dsk_s, vcpus_s, status,
-                sbal, pnode, snode, tags]:: Maybe (String, Instance.Instance)
+                sbal, pnode, snode, sdt, tags]
         fail1 = Text.loadInst nl
                [name, mem_s, dsk_s, vcpus_s, status,
-                sbal, pnode, pnode, tags]:: Maybe (String, Instance.Instance)
+                sbal, pnode, pnode, tags]
         _types = ( name::String, mem::Int, dsk::Int
                  , vcpus::Int, status::String
                  , snode::String
                  , autobal::Bool)
     in
       case inst of
-        Nothing -> False
-        Just (_, i) ->
+        Types.Bad msg -> printTestCase ("Failed to load instance: " ++ msg)
+                         False
+        Types.Ok (_, i) -> printTestCase ("Mismatch in some field while\
+                                          \ loading the instance") $
             Instance.name i == name &&
             Instance.vcpus i == vcpus &&
             Instance.mem i == mem &&
@@ -539,13 +542,15 @@ prop_Text_Load_Instance name mem dsk vcpus status
                                  then Node.noSecondary
                                  else sdx) &&
             Instance.autoBalance i == autobal &&
-            isNothing fail1
+            Types.isBad fail1
 
 prop_Text_Load_InstanceFail ktn fields =
-    length fields /= 9 ==>
+    length fields /= 10 ==>
     case Text.loadInst nl fields of
-      Types.Ok _ -> False
-      Types.Bad msg -> "Invalid/incomplete instance data: '" `isPrefixOf` msg
+      Types.Ok _ -> printTestCase "Managed to load instance from invalid\
+                                  \ data" False
+      Types.Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
+                       "Invalid/incomplete instance data: '" `isPrefixOf` msg
     where nl = Data.Map.fromList ktn
 
 prop_Text_Load_Node name tm nm fm td fd tc fo =

htools/Ganeti/HTools/Text.hs

@@ -93,11 +93,12 @@ serializeInstance nl inst =
                     then ""
                     else Container.nameOf nl sidx)
     in
-      printf "%s|%d|%d|%d|%s|%s|%s|%s|%s"
+      printf "%s|%d|%d|%d|%s|%s|%s|%s|%s|%s"
              iname (Instance.mem inst) (Instance.dsk inst)
              (Instance.vcpus inst) (Instance.runSt inst)
              (if Instance.autoBalance inst then "Y" else "N")
-             pnode snode (intercalate "," (Instance.tags inst))
+             pnode snode (dtToString (Instance.diskTemplate inst))
+             (intercalate "," (Instance.tags inst))
 
 -- | Generate instance file data from instance objects.
 serializeInstances :: Node.List -> Instance.List -> String
@@ -148,15 +149,13 @@ loadNode ktg [name, tm, nm, fm, td, fd, tc, fo, gu] = do
 loadNode _ s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
 
 -- | Load an instance from a field list.
-loadInst :: (Monad m) =>
-            NameAssoc                     -- ^ Association list with
-                                          -- the current nodes
-         -> [String]                      -- ^ Input data as a list of
-                                          -- fields
-         -> m (String, Instance.Instance) -- ^ The result, a tuple of
-                                          -- instance name and the
-                                          -- instance object
-loadInst ktn [name, mem, dsk, vcpus, status, auto_bal, pnode, snode, tags] = do
+loadInst :: NameAssoc -- ^ Association list with the current nodes
+         -> [String]  -- ^ Input data as a list of fields
+         -> Result (String, Instance.Instance) -- ^ A tuple of
+                                               -- instance name and
+                                               -- the instance object
+loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
+             , dt, tags ] = do
   pidx <- lookupNode ktn name pnode
   sidx <- (if null snode then return Node.noSecondary
            else lookupNode ktn name snode)
@@ -168,11 +167,12 @@ loadInst ktn [name, mem, dsk, vcpus, status, auto_bal, pnode, snode, tags] = do
                     "N" -> return False
                     _ -> fail $ "Invalid auto_balance value '" ++ auto_bal ++
                          "' for instance " ++ name
+  disk_template <- annotateResult ("Instance " ++ name) (dtFromString dt)
   when (sidx == pidx) $ fail $ "Instance " ++ name ++
            " has same primary and secondary node - " ++ pnode
   let vtags = sepSplit ',' tags
       newinst = Instance.create name vmem vdsk vvcpus status vtags
-                auto_balance pidx sidx DTDrbd8
+                auto_balance pidx sidx disk_template
   return (name, newinst)
 loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"