htools: return new state from new IAllocator modes

[ganeti-local] / htools / Ganeti / HTools / Rapi.hs

diff --git a/htools/Ganeti/HTools/Rapi.hs b/htools/Ganeti/HTools/Rapi.hs
index 936fc44..ce310ed 100644 (file)
--- a/htools/Ganeti/HTools/Rapi.hs
+++ b/htools/Ganeti/HTools/Rapi.hs
@@ -37,7 +37,7 @@ import Network.Curl
 import Network.Curl.Types ()
 #endif
 import Control.Monad
 import Network.Curl.Types ()
 #endif
 import Control.Monad

-import Text.JSON (JSObject, JSValue, fromJSObject, decodeStrict)
+import Text.JSON (JSObject, fromJSObject, decodeStrict)

 import Text.JSON.Types (JSValue(..))
 import Text.Printf (printf)
 
 import Text.JSON.Types (JSValue(..))
 import Text.Printf (printf)
 

@@ -47,6 +47,7 @@ import Ganeti.HTools.Types
 import qualified Ganeti.HTools.Group as Group
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance
 import qualified Ganeti.HTools.Group as Group
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance

+import qualified Ganeti.Constants as C

 
 -- | Read an URL via curl and return the body if successful.
 getUrl :: (Monad m) => String -> IO (m String)
 
 -- | Read an URL via curl and return the body if successful.
 getUrl :: (Monad m) => String -> IO (m String)

@@ -56,7 +57,7 @@ getUrl _ = return $ fail "RAPI/curl backend disabled at compile time"
 
 #else
 
 
 #else
 

--- | The curl options we use
+-- | The curl options we use.

 curlOpts :: [CurlOption]
 curlOpts = [ CurlSSLVerifyPeer False
            , CurlSSLVerifyHost 0
 curlOpts :: [CurlOption]
 curlOpts = [ CurlSSLVerifyPeer False
            , CurlSSLVerifyHost 0

@@ -76,7 +77,7 @@ getUrl url = do
 formatHost :: String -> String
 formatHost master =
     if ':' `elem` master then  master
 formatHost :: String -> String
 formatHost master =
     if ':' `elem` master then  master

-    else "https://" ++ master ++ ":5080"
+    else "https://" ++ master ++ ":" ++ show C.defaultRapiPort

 
 -- | Parse a instance list in JSON format.
 getInstances :: NameAssoc
 
 -- | Parse a instance list in JSON format.
 getInstances :: NameAssoc

@@ -96,18 +97,13 @@ getGroups :: String -> Result [(String, Group.Group)]
 getGroups body = loadJSArray "Parsing group data" body >>=
                 mapM (parseGroup . fromJSObject)
 
 getGroups body = loadJSArray "Parsing group data" body >>=
                 mapM (parseGroup . fromJSObject)
 

-getFakeGroups :: Result [(String, Group.Group)]
-getFakeGroups =
-  return [(defaultGroupID,
-           Group.create "default" defaultGroupID AllocPreferred)]
-

 -- | Construct an instance from a JSON object.
 parseInstance :: NameAssoc
 -- | Construct an instance from a JSON object.
 parseInstance :: NameAssoc

-              -> [(String, JSValue)]
+              -> JSRecord

               -> Result (String, Instance.Instance)
 parseInstance ktn a = do
   name <- tryFromObj "Parsing new instance" a "name"
               -> Result (String, Instance.Instance)
 parseInstance ktn a = do
   name <- tryFromObj "Parsing new instance" a "name"

-  let owner_name = "Instance '" ++ name ++ "'"
+  let owner_name = "Instance '" ++ name ++ "', error while parsing data"

   let extract s x = tryFromObj owner_name x s
   disk <- extract "disk_usage" a
   beparams <- liftM fromJSObject (extract "beparams" a)
   let extract s x = tryFromObj owner_name x s
   disk <- extract "disk_usage" a
   beparams <- liftM fromJSObject (extract "beparams" a)

@@ -123,15 +119,16 @@ parseInstance ktn a = do
   running <- extract "status" a
   tags <- extract "tags" a
   auto_balance <- extract "auto_balance" beparams
   running <- extract "status" a
   tags <- extract "tags" a
   auto_balance <- extract "auto_balance" beparams

+  dt <- extract "disk_template" a

   let inst = Instance.create name mem disk vcpus running tags
   let inst = Instance.create name mem disk vcpus running tags

-             auto_balance pnode snode
+             auto_balance pnode snode dt

   return (name, inst)
 
 -- | Construct a node from a JSON object.
   return (name, inst)
 
 -- | Construct a node from a JSON object.

-parseNode :: NameAssoc -> [(String, JSValue)] -> Result (String, Node.Node)
+parseNode :: NameAssoc -> JSRecord -> Result (String, Node.Node)

 parseNode ktg a = do
   name <- tryFromObj "Parsing new node" a "name"
 parseNode ktg a = do
   name <- tryFromObj "Parsing new node" a "name"

-  let desc = "Node '" ++ name ++ "'"
+  let desc = "Node '" ++ name ++ "', error while parsing data"

       extract s = tryFromObj desc a s
   offline <- extract "offline"
   drained <- extract "drained"
       extract s = tryFromObj desc a s
   offline <- extract "offline"
   drained <- extract "drained"

@@ -153,7 +150,7 @@ parseNode ktg a = do
   return (name, node)
 
 -- | Construct a group from a JSON object.
   return (name, node)
 
 -- | Construct a group from a JSON object.

-parseGroup :: [(String, JSValue)] -> Result (String, Group.Group)
+parseGroup :: JSRecord -> Result (String, Group.Group)

 parseGroup a = do
   name <- tryFromObj "Parsing new group" a "name"
   let extract s = tryFromObj ("Group '" ++ name ++ "'") a s
 parseGroup a = do
   name <- tryFromObj "Parsing new group" a "name"
   let extract s = tryFromObj ("Group '" ++ name ++ "'") a s

@@ -172,16 +169,11 @@ readData master = do
   tags_body <- getUrl $ printf "%s/2/tags" url
   return (group_body, node_body, inst_body, tags_body)
 
   tags_body <- getUrl $ printf "%s/2/tags" url
   return (group_body, node_body, inst_body, tags_body)
 

--- | Builds the cluster data from the raw Rapi content
+-- | Builds the cluster data from the raw Rapi content.

 parseData :: (Result String, Result String, Result String, Result String)
           -> Result ClusterData
 parseData (group_body, node_body, inst_body, tags_body) = do
 parseData :: (Result String, Result String, Result String, Result String)
           -> Result ClusterData
 parseData (group_body, node_body, inst_body, tags_body) = do

-  group_data <-
-      -- TODO: handle different ganeti versions properly, not via "all
-      -- errors mean Ganeti 2.3"
-      case group_body of
-        Bad _ -> getFakeGroups
-        Ok v -> getGroups v
+  group_data <- group_body >>= getGroups

   let (group_names, group_idx) = assignIndices group_data
   node_data <- node_body >>= getNodes group_names
   let (node_names, node_idx) = assignIndices node_data
   let (group_names, group_idx) = assignIndices group_data
   node_data <- node_body >>= getNodes group_names
   let (node_names, node_idx) = assignIndices node_data

@@ -190,7 +182,7 @@ parseData (group_body, node_body, inst_body, tags_body) = do
   tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict)
   return (ClusterData group_idx node_idx inst_idx tags_data)
 
   tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict)
   return (ClusterData group_idx node_idx inst_idx tags_data)
 

--- | Top level function for data loading
+-- | Top level function for data loading.

 loadData :: String -- ^ Cluster or URL to use as source
          -> IO (Result ClusterData)
 loadData = fmap parseData . readData
 loadData :: String -- ^ Cluster or URL to use as source
          -> IO (Result ClusterData)
 loadData = fmap parseData . readData