code.grnet.gr Git - ganeti-local/blob - Ganeti/HTools/Rapi.hs

   1 {-| Implementation of the RAPI client interface.
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2009 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 module Ganeti.HTools.Rapi
  27     (
  28       loadData
  29     ) where
  30
  31 import Network.Curl
  32 import Network.Curl.Types ()
  33 import Network.Curl.Code
  34 import Data.List
  35 import Control.Monad
  36 import Text.JSON (JSObject, JSValue, fromJSObject)
  37 import Text.Printf (printf)
  38
  39 import Ganeti.HTools.Utils
  40 import Ganeti.HTools.Loader
  41 import Ganeti.HTools.Types
  42 import qualified Ganeti.HTools.Node as Node
  43 import qualified Ganeti.HTools.Instance as Instance
  44
  45 -- | Read an URL via curl and return the body if successful.
  46 getUrl :: (Monad m) => String -> IO (m String)
  47 getUrl url = do
  48   (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
  49                                      CurlSSLVerifyHost 0,
  50                                      CurlTimeout (fromIntegral queryTimeout),
  51                                      CurlConnectTimeout
  52                                      (fromIntegral connTimeout)]
  53   return (case code of
  54             CurlOK -> return body
  55             _ -> fail $ printf "Curl error for '%s', error %s"
  56                  url (show code))
  57
  58 -- | Append the default port if not passed in.
  59 formatHost :: String -> String
  60 formatHost master =
  61     if elem ':' master then  master
  62     else "https://" ++ master ++ ":5080"
  63
  64 -- | Parse a instance list in JSON format.
  65 getInstances :: NameAssoc
  66              -> String
  67              -> Result [(String, Instance.Instance)]
  68 getInstances ktn body =
  69     loadJSArray body >>= mapM (parseInstance ktn . fromJSObject)
  70
  71 -- | Parse a node list in JSON format.
  72 getNodes :: String -> Result [(String, Node.Node)]
  73 getNodes body = loadJSArray body >>= mapM (parseNode . fromJSObject)
  74
  75 -- | Construct an instance from a JSON object.
  76 parseInstance :: [(String, Ndx)]
  77               -> [(String, JSValue)]
  78               -> Result (String, Instance.Instance)
  79 parseInstance ktn a = do
  80   name <- tryFromObj "Parsing new instance" a "name"
  81   let extract s x = tryFromObj ("Instance '" ++ name ++ "'") x s
  82   disk <- extract "disk_usage" a
  83   beparams <- liftM fromJSObject (extract "beparams" a)
  84   mem <- extract "memory" beparams
  85   vcpus <- extract "vcpus" beparams
  86   pnode <- extract "pnode" a >>= lookupNode ktn name
  87   snodes <- extract "snodes" a
  88   snode <- (if null snodes then return Node.noSecondary
  89             else readEitherString (head snodes) >>= lookupNode ktn name)
  90   running <- extract "status" a
  91   tags <- extract "tags" a
  92   let inst = Instance.create name mem disk vcpus running tags pnode snode
  93   return (name, inst)
  94
  95 -- | Construct a node from a JSON object.
  96 parseNode :: [(String, JSValue)] -> Result (String, Node.Node)
  97 parseNode a = do
  98   name <- tryFromObj "Parsing new node" a "name"
  99   let extract s = tryFromObj ("Node '" ++ name ++ "'") a s
 100   offline <- extract "offline"
 101   node <- (if offline
 102            then return $ Node.create name 0 0 0 0 0 0 True
 103            else do
 104              drained <- extract "drained"
 105              mtotal  <- extract "mtotal"
 106              mnode   <- extract "mnode"
 107              mfree   <- extract "mfree"
 108              dtotal  <- extract "dtotal"
 109              dfree   <- extract "dfree"
 110              ctotal  <- extract "ctotal"
 111              return $ Node.create name mtotal mnode mfree
 112                     dtotal dfree ctotal (offline || drained))
 113   return (name, node)
 114
 115 -- | Builds the cluster data from an URL.
 116 loadData :: String -- ^ Cluster or URL to use as source
 117          -> IO (Result (Node.AssocList, Instance.AssocList, [String]))
 118 loadData master = do -- IO monad
 119   let url = formatHost master
 120   node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
 121   inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
 122   return $ do -- Result monad
 123     node_data <- node_body >>= getNodes
 124     let (node_names, node_idx) = assignIndices node_data
 125     inst_data <- inst_body >>= getInstances node_names
 126     let (_, inst_idx) = assignIndices inst_data
 127     return (node_idx, inst_idx, [])