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