Node operations: take into account auto_balance
[ganeti-local] / htools / Ganeti / HTools / Rapi.hs
index eb30076..936fc44 100644 (file)
@@ -23,7 +23,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 -}
 
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP #-}
 
 module Ganeti.HTools.Rapi
     (
@@ -32,8 +32,10 @@ module Ganeti.HTools.Rapi
     ) where
 
 import Data.Maybe (fromMaybe)
+#ifndef NO_CURL
 import Network.Curl
 import Network.Curl.Types ()
+#endif
 import Control.Monad
 import Text.JSON (JSObject, JSValue, fromJSObject, decodeStrict)
 import Text.JSON.Types (JSValue(..))
@@ -46,6 +48,14 @@ import qualified Ganeti.HTools.Group as Group
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance
 
+-- | Read an URL via curl and return the body if successful.
+getUrl :: (Monad m) => String -> IO (m String)
+
+#ifdef NO_CURL
+getUrl _ = return $ fail "RAPI/curl backend disabled at compile time"
+
+#else
+
 -- | The curl options we use
 curlOpts :: [CurlOption]
 curlOpts = [ CurlSSLVerifyPeer False
@@ -54,14 +64,13 @@ curlOpts = [ CurlSSLVerifyPeer False
            , CurlConnectTimeout (fromIntegral connTimeout)
            ]
 
--- | Read an URL via curl and return the body if successful.
-getUrl :: (Monad m) => String -> IO (m String)
 getUrl url = do
   (code, !body) <- curlGetString url curlOpts
   return (case code of
             CurlOK -> return body
             _ -> fail $ printf "Curl error for '%s', error %s"
                  url (show code))
+#endif
 
 -- | Append the default port if not passed in.
 formatHost :: String -> String
@@ -89,8 +98,8 @@ getGroups body = loadJSArray "Parsing group data" body >>=
 
 getFakeGroups :: Result [(String, Group.Group)]
 getFakeGroups =
-  return $ [(defaultGroupID,
-             Group.create "default" defaultGroupID AllocPreferred)]
+  return [(defaultGroupID,
+           Group.create "default" defaultGroupID AllocPreferred)]
 
 -- | Construct an instance from a JSON object.
 parseInstance :: NameAssoc
@@ -113,7 +122,9 @@ parseInstance ktn a = do
             else readEitherString (head snodes) >>= lookupNode ktn name)
   running <- extract "status" a
   tags <- extract "tags" a
-  let inst = Instance.create name mem disk vcpus running tags pnode snode
+  auto_balance <- extract "auto_balance" beparams
+  let inst = Instance.create name mem disk vcpus running tags
+             auto_balance pnode snode
   return (name, inst)
 
 -- | Construct a node from a JSON object.
@@ -182,4 +193,4 @@ parseData (group_body, node_body, inst_body, tags_body) = do
 -- | Top level function for data loading
 loadData :: String -- ^ Cluster or URL to use as source
          -> IO (Result ClusterData)
-loadData master = readData master >>= return . parseData
+loadData = fmap parseData . readData