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 return (uuid, Group.create name uuid AllocPreferred)
136 -- | Loads the raw cluster data from an URL.
137 readData :: String -- ^ Cluster or URL to use as source
138 -> IO (Result String, Result String, Result String, Result String)
140 let url = formatHost master
141 group_body <- getUrl $ printf "%s/2/groups?bulk=1" url
142 node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
143 inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
144 tags_body <- getUrl $ printf "%s/2/tags" url
145 return (group_body, node_body, inst_body, tags_body)
147 -- | Builds the cluster data from the raw Rapi content
148 parseData :: (Result String, Result String, Result String, Result String)
149 -> Result (Group.List, Node.List, Instance.List, [String])
150 parseData (group_body, node_body, inst_body, tags_body) = do
151 group_data <- group_body >>= getGroups
152 let (group_names, group_idx) = assignIndices group_data
153 node_data <- node_body >>= getNodes group_names
154 let (node_names, node_idx) = assignIndices node_data
155 inst_data <- inst_body >>= getInstances node_names
156 let (_, inst_idx) = assignIndices inst_data
157 tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict)
158 return (group_idx, node_idx, inst_idx, tags_data)
160 -- | Top level function for data loading
161 loadData :: String -- ^ Cluster or URL to use as source
162 -> IO (Result (Group.List, Node.List, Instance.List, [String]))
163 loadData master = readData master >>= return . parseData