1 {-| Implementation of the RAPI client interface.
7 Copyright (C) 2009 Google Inc.
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.
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.
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
26 module Ganeti.HTools.Rapi
32 import Network.Curl.Types ()
33 import Network.Curl.Code
36 import Text.JSON (JSObject, JSValue)
37 import Text.Printf (printf)
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
45 -- | Read an URL via curl and return the body if successful.
46 getUrl :: (Monad m) => String -> IO (m String)
48 (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
50 CurlTimeout (fromIntegral queryTimeout),
52 (fromIntegral connTimeout)]
55 _ -> fail $ printf "Curl error for '%s', error %s"
58 -- | Append the default port if not passed in.
59 formatHost :: String -> String
61 if elem ':' master then master
62 else "https://" ++ master ++ ":5080"
64 -- | Parse a instance list in JSON format.
65 getInstances :: NameAssoc
67 -> Result [(String, Instance.Instance)]
68 getInstances ktn body = loadJSArray body >>= mapM (parseInstance ktn)
70 -- | Parse a node list in JSON format.
71 getNodes :: String -> Result [(String, Node.Node)]
72 getNodes body = loadJSArray body >>= mapM parseNode
74 -- | Construct an instance from a JSON object.
75 parseInstance :: [(String, Ndx)]
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
91 -- | Construct a node from a JSON object.
92 parseNode :: JSObject JSValue -> Result (String, Node.Node)
94 name <- fromObj "name" a
95 offline <- fromObj "offline" a
97 then return $ Node.create name 0 0 0 0 0 0 True
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))
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)