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.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 =
69 loadJSArray "Parsing instance data" body >>=
70 mapM (parseInstance ktn . fromJSObject)
72 -- | Parse a node list in JSON format.
73 getNodes :: String -> Result [(String, Node.Node)]
74 getNodes body = loadJSArray "Parsing node data" body >>=
75 mapM (parseNode . fromJSObject)
77 -- | Construct an instance from a JSON object.
78 parseInstance :: NameAssoc
79 -> [(String, JSValue)]
80 -> Result (String, Instance.Instance)
81 parseInstance ktn a = do
82 name <- tryFromObj "Parsing new instance" a "name"
83 let owner_name = "Instance '" ++ name ++ "'"
84 let extract s x = tryFromObj owner_name x s
85 disk <- extract "disk_usage" a
86 beparams <- liftM fromJSObject (extract "beparams" a)
87 omem <- extract "oper_ram" a
89 JSRational _ _ -> annotateResult owner_name (fromJVal omem)
90 _ -> extract "memory" beparams)
91 vcpus <- extract "vcpus" beparams
92 pnode <- extract "pnode" a >>= lookupNode ktn name
93 snodes <- extract "snodes" a
94 snode <- (if null snodes then return Node.noSecondary
95 else readEitherString (head snodes) >>= lookupNode ktn name)
96 running <- extract "status" a
97 tags <- extract "tags" a
98 let inst = Instance.create name mem disk vcpus running tags pnode snode
101 -- | Construct a node from a JSON object.
102 parseNode :: [(String, JSValue)] -> Result (String, Node.Node)
104 name <- tryFromObj "Parsing new node" a "name"
105 let extract s = tryFromObj ("Node '" ++ name ++ "'") a s
106 offline <- extract "offline"
107 drained <- extract "drained"
108 guuid <- extract "group.uuid"
109 node <- (if offline || drained
110 then return $ Node.create name 0 0 0 0 0 0 True guuid
112 mtotal <- extract "mtotal"
113 mnode <- extract "mnode"
114 mfree <- extract "mfree"
115 dtotal <- extract "dtotal"
116 dfree <- extract "dfree"
117 ctotal <- extract "ctotal"
118 return $ Node.create name mtotal mnode mfree
119 dtotal dfree ctotal False guuid)
122 -- | Loads the raw cluster data from an URL.
123 readData :: String -- ^ Cluster or URL to use as source
124 -> IO (Result String, Result String, Result String)
126 let url = formatHost master
127 node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
128 inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
129 tags_body <- getUrl $ printf "%s/2/tags" url
130 return (node_body, inst_body, tags_body)
132 -- | Builds the cluster data from the raw Rapi content
133 parseData :: (Result String, Result String, Result String)
134 -> Result (Node.List, Instance.List, [String])
135 parseData (node_body, inst_body, tags_body) = do
136 node_data <- node_body >>= getNodes
137 let (node_names, node_idx) = assignIndices node_data
138 inst_data <- inst_body >>= getInstances node_names
139 let (_, inst_idx) = assignIndices inst_data
140 tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict)
141 return (node_idx, inst_idx, tags_data)
143 -- | Top level function for data loading
144 loadData :: String -- ^ Cluster or URL to use as source
145 -> IO (Result (Node.List, Instance.List, [String]))
146 loadData master = readData master >>= return . parseData