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, fromJSObject, decodeStrict)
37 import Text.JSON.Types (JSValue(..))
38 import Text.Printf (printf)
40 import Ganeti.HTools.Utils
41 import Ganeti.HTools.Loader
42 import Ganeti.HTools.Types
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 body >>= mapM (parseInstance ktn . fromJSObject)
72 -- | Parse a node list in JSON format.
73 getNodes :: String -> Result [(String, Node.Node)]
74 getNodes body = loadJSArray body >>= mapM (parseNode . fromJSObject)
76 -- | Construct an instance from a JSON object.
77 parseInstance :: [(String, Ndx)]
78 -> [(String, JSValue)]
79 -> Result (String, Instance.Instance)
80 parseInstance ktn a = do
81 name <- tryFromObj "Parsing new instance" a "name"
82 let owner_name = "Instance '" ++ name ++ "'"
83 let extract s x = tryFromObj owner_name x s
84 disk <- extract "disk_usage" a
85 beparams <- liftM fromJSObject (extract "beparams" a)
86 omem <- extract "oper_ram" a
88 JSRational _ _ -> annotateResult owner_name (fromJVal omem)
89 _ -> extract "memory" beparams)
90 vcpus <- extract "vcpus" beparams
91 pnode <- extract "pnode" a >>= lookupNode ktn name
92 snodes <- extract "snodes" a
93 snode <- (if null snodes then return Node.noSecondary
94 else readEitherString (head snodes) >>= lookupNode ktn name)
95 running <- extract "status" a
96 tags <- extract "tags" a
97 let inst = Instance.create name mem disk vcpus running tags pnode snode
100 -- | Construct a node from a JSON object.
101 parseNode :: [(String, JSValue)] -> Result (String, Node.Node)
103 name <- tryFromObj "Parsing new node" a "name"
104 let extract s = tryFromObj ("Node '" ++ name ++ "'") a s
105 offline <- extract "offline"
106 drained <- extract "drained"
107 node <- (if offline || drained
108 then return $ Node.create name 0 0 0 0 0 0 True
110 mtotal <- extract "mtotal"
111 mnode <- extract "mnode"
112 mfree <- extract "mfree"
113 dtotal <- extract "dtotal"
114 dfree <- extract "dfree"
115 ctotal <- extract "ctotal"
116 return $ Node.create name mtotal mnode mfree
117 dtotal dfree ctotal False)
120 -- | Builds the cluster data from an URL.
121 loadData :: String -- ^ Cluster or URL to use as source
122 -> IO (Result (Node.AssocList, Instance.AssocList, [String]))
123 loadData master = do -- IO monad
124 let url = formatHost master
125 node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
126 inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
127 tags_body <- getUrl $ printf "%s/2/tags" url
128 return $ do -- Result monad
129 node_data <- node_body >>= getNodes
130 let (node_names, node_idx) = assignIndices node_data
131 inst_data <- inst_body >>= getInstances node_names
132 let (_, inst_idx) = assignIndices inst_data
133 tags_data <- tags_body >>= (fromJResult . decodeStrict)
134 return (node_idx, inst_idx, tags_data)