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)
  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   return (case code of
  51             CurlOK -> return body
  52             _ -> fail $ printf "Curl error for '%s', error %s"
  53                  url (show code))
  54
  55 -- | Append the default port if not passed in.
  56 formatHost :: String -> String
  57 formatHost master =
  58     if elem ':' master then  master
  59     else "https://" ++ master ++ ":5080"
  60
  61 -- | Parse a instance list in JSON format.
  62 getInstances :: NameAssoc
  63              -> String
  64              -> Result [(String, Instance.Instance)]
  65 getInstances ktn body = do
  66   arr <- loadJSArray body
  67   ilist <- mapM (parseInstance ktn) arr
  68   return ilist
  69
  70 -- | Parse a node list in JSON format.
  71 getNodes :: String -> Result [(String, Node.Node)]
  72 getNodes body = do
  73   arr <- loadJSArray body
  74   nlist <- mapM parseNode arr
  75   return nlist
  76
  77 -- | Construct an instance from a JSON object.
  78 parseInstance :: [(String, Ndx)]
  79               -> JSObject JSValue
  80               -> Result (String, Instance.Instance)
  81 parseInstance ktn a = do
  82   name <- fromObj "name" a
  83   disk <- fromObj "disk_usage" a
  84   mem <- fromObj "beparams" a >>= fromObj "memory"
  85   vcpus <- fromObj "beparams" a >>= fromObj "vcpus"
  86   pnode <- fromObj "pnode" a >>= lookupNode ktn name
  87   snodes <- fromObj "snodes" a
  88   snode <- (if null snodes then return Node.noSecondary
  89             else readEitherString (head snodes) >>= lookupNode ktn name)
  90   running <- fromObj "status" a
  91   let inst = Instance.create name mem disk vcpus running pnode snode
  92   return (name, inst)
  93
  94 -- | Construct a node from a JSON object.
  95 parseNode :: JSObject JSValue -> Result (String, Node.Node)
  96 parseNode a = do
  97     name <- fromObj "name" a
  98     offline <- fromObj "offline" a
  99     node <- (case offline of
 100                True -> return $ Node.create name 0 0 0 0 0 0 True
 101                _ -> do
 102                  drained <- fromObj "drained" a
 103                  mtotal  <- fromObj "mtotal"  a
 104                  mnode   <- fromObj "mnode"   a
 105                  mfree   <- fromObj "mfree"   a
 106                  dtotal  <- fromObj "dtotal"  a
 107                  dfree   <- fromObj "dfree"   a
 108                  ctotal  <- fromObj "ctotal"  a
 109                  return $ Node.create name mtotal mnode mfree
 110                         dtotal dfree ctotal (offline || drained))
 111     return (name, node)
 112
 113 -- | Builds the cluster data from an URL.
 114 loadData :: String -- ^ Cluster or URL to use as source
 115          -> IO (Result (Node.AssocList, Instance.AssocList))
 116 loadData master = do -- IO monad
 117   let url = formatHost master
 118   node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
 119   inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
 120   return $ do -- Result monad
 121     node_data <- node_body >>= getNodes
 122     let (node_names, node_idx) = assignIndices node_data
 123     inst_data <- inst_body >>= getInstances node_names
 124     let (_, inst_idx) = assignIndices inst_data
 125     return (node_idx, inst_idx)