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 = loadJSArray body >>= mapM (parseInstance ktn)
  66
  67 -- | Parse a node list in JSON format.
  68 getNodes :: String -> Result [(String, Node.Node)]
  69 getNodes body = loadJSArray body >>= mapM parseNode
  70
  71 -- | Construct an instance from a JSON object.
  72 parseInstance :: [(String, Ndx)]
  73               -> JSObject JSValue
  74               -> Result (String, Instance.Instance)
  75 parseInstance ktn a = do
  76   name <- fromObj "name" a
  77   disk <- fromObj "disk_usage" a
  78   mem <- fromObj "beparams" a >>= fromObj "memory"
  79   vcpus <- fromObj "beparams" a >>= fromObj "vcpus"
  80   pnode <- fromObj "pnode" a >>= lookupNode ktn name
  81   snodes <- fromObj "snodes" a
  82   snode <- (if null snodes then return Node.noSecondary
  83             else readEitherString (head snodes) >>= lookupNode ktn name)
  84   running <- fromObj "status" a
  85   let inst = Instance.create name mem disk vcpus running pnode snode
  86   return (name, inst)
  87
  88 -- | Construct a node from a JSON object.
  89 parseNode :: JSObject JSValue -> Result (String, Node.Node)
  90 parseNode a = do
  91     name <- fromObj "name" a
  92     offline <- fromObj "offline" a
  93     node <- (if offline
  94              then return $ Node.create name 0 0 0 0 0 0 True
  95              else do
  96                drained <- fromObj "drained" a
  97                mtotal  <- fromObj "mtotal"  a
  98                mnode   <- fromObj "mnode"   a
  99                mfree   <- fromObj "mfree"   a
 100                dtotal  <- fromObj "dtotal"  a
 101                dfree   <- fromObj "dfree"   a
 102                ctotal  <- fromObj "ctotal"  a
 103                return $ Node.create name mtotal mnode mfree
 104                       dtotal dfree ctotal (offline || drained))
 105     return (name, node)
 106
 107 -- | Builds the cluster data from an URL.
 108 loadData :: String -- ^ Cluster or URL to use as source
 109          -> IO (Result (Node.AssocList, Instance.AssocList))
 110 loadData master = do -- IO monad
 111   let url = formatHost master
 112   node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
 113   inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
 114   return $ do -- Result monad
 115     node_data <- node_body >>= getNodes
 116     let (node_names, node_idx) = assignIndices node_data
 117     inst_data <- inst_body >>= getInstances node_names
 118     let (_, inst_idx) = assignIndices inst_data
 119     return (node_idx, inst_idx)