1 {-| Implementation of the RAPI client interface.
7 Copyright (C) 2009, 2010 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
33 import Network.Curl.Types ()
35 import Text.JSON (JSObject, JSValue, fromJSObject, decodeStrict)
36 import Text.JSON.Types (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.Group as Group
43 import qualified Ganeti.HTools.Node as Node
44 import qualified Ganeti.HTools.Instance as Instance
46 -- | Read an URL via curl and return the body if successful.
47 getUrl :: (Monad m) => String -> IO (m String)
49 (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
51 CurlTimeout (fromIntegral queryTimeout),
53 (fromIntegral connTimeout)]
56 _ -> fail $ printf "Curl error for '%s', error %s"
59 -- | Append the default port if not passed in.
60 formatHost :: String -> String
62 if ':' `elem` master then master
63 else "https://" ++ master ++ ":5080"
65 -- | Parse a instance list in JSON format.
66 getInstances :: NameAssoc
68 -> Result [(String, Instance.Instance)]
69 getInstances ktn body =
70 loadJSArray "Parsing instance data" body >>=
71 mapM (parseInstance ktn . fromJSObject)
73 -- | Parse a node list in JSON format.
74 getNodes :: NameAssoc -> String -> Result [(String, Node.Node)]
75 getNodes ktg body = loadJSArray "Parsing node data" body >>=
76 mapM (parseNode ktg . fromJSObject)
78 -- | Parse a group list in JSON format.
79 getGroups :: String -> Result [(String, Group.Group)]
80 getGroups body = loadJSArray "Parsing group data" body >>=
81 mapM (parseGroup . fromJSObject)
83 -- | Construct an instance from a JSON object.
84 parseInstance :: NameAssoc
85 -> [(String, JSValue)]
86 -> Result (String, Instance.Instance)
87 parseInstance ktn a = do
88 name <- tryFromObj "Parsing new instance" a "name"
89 let owner_name = "Instance '" ++ name ++ "'"
90 let extract s x = tryFromObj owner_name x s
91 disk <- extract "disk_usage" a
92 beparams <- liftM fromJSObject (extract "beparams" a)
93 omem <- extract "oper_ram" a
95 JSRational _ _ -> annotateResult owner_name (fromJVal omem)
96 _ -> extract "memory" beparams)
97 vcpus <- extract "vcpus" beparams
98 pnode <- extract "pnode" a >>= lookupNode ktn name
99 snodes <- extract "snodes" a
100 snode <- (if null snodes then return Node.noSecondary
101 else readEitherString (head snodes) >>= lookupNode ktn name)
102 running <- extract "status" a
103 tags <- extract "tags" a
104 let inst = Instance.create name mem disk vcpus running tags pnode snode
107 -- | Construct a node from a JSON object.
108 parseNode :: NameAssoc -> [(String, JSValue)] -> Result (String, Node.Node)
110 name <- tryFromObj "Parsing new node" a "name"
111 let extract s = tryFromObj ("Node '" ++ name ++ "'") a s
112 offline <- extract "offline"
113 drained <- extract "drained"
114 guuid <- extract "group.uuid" >>= lookupGroup ktg name
115 node <- (if offline || drained
116 then return $ Node.create name 0 0 0 0 0 0 True guuid
118 mtotal <- extract "mtotal"
119 mnode <- extract "mnode"
120 mfree <- extract "mfree"
121 dtotal <- extract "dtotal"
122 dfree <- extract "dfree"
123 ctotal <- extract "ctotal"
124 return $ Node.create name mtotal mnode mfree
125 dtotal dfree ctotal False guuid)
128 -- | Construct a group from a JSON object.
129 parseGroup :: [(String, JSValue)] -> Result (String, Group.Group)
131 name <- tryFromObj "Parsing new group" a "name"
132 let extract s = tryFromObj ("Group '" ++ name ++ "'") a s
133 uuid <- extract "uuid"
134 apol <- extract "alloc_policy"
135 return (uuid, Group.create name uuid apol)
137 -- | Loads the raw cluster data from an URL.
138 readData :: String -- ^ Cluster or URL to use as source
139 -> IO (Result String, Result String, Result String, Result String)
141 let url = formatHost master
142 group_body <- getUrl $ printf "%s/2/groups?bulk=1" url
143 node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
144 inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
145 tags_body <- getUrl $ printf "%s/2/tags" url
146 return (group_body, node_body, inst_body, tags_body)
148 -- | Builds the cluster data from the raw Rapi content
149 parseData :: (Result String, Result String, Result String, Result String)
150 -> Result ClusterData
151 parseData (group_body, node_body, inst_body, tags_body) = do
152 group_data <- group_body >>= getGroups
153 let (group_names, group_idx) = assignIndices group_data
154 node_data <- node_body >>= getNodes group_names
155 let (node_names, node_idx) = assignIndices node_data
156 inst_data <- inst_body >>= getInstances node_names
157 let (_, inst_idx) = assignIndices inst_data
158 tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict)
159 return (ClusterData group_idx node_idx inst_idx tags_data)
161 -- | Top level function for data loading
162 loadData :: String -- ^ Cluster or URL to use as source
163 -> IO (Result ClusterData)
164 loadData master = readData master >>= return . parseData