Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / HTools / Rapi.hs @ 96a12113

History | View | Annotate | Download (6.7 kB)

1 a7654563 Iustin Pop
{-| Implementation of the RAPI client interface.
2 a7654563 Iustin Pop
3 a7654563 Iustin Pop
-}
4 a7654563 Iustin Pop
5 e2fa2baf Iustin Pop
{-
6 e2fa2baf Iustin Pop
7 4d8e5008 Iustin Pop
Copyright (C) 2009, 2010, 2011 Google Inc.
8 e2fa2baf Iustin Pop
9 e2fa2baf Iustin Pop
This program is free software; you can redistribute it and/or modify
10 e2fa2baf Iustin Pop
it under the terms of the GNU General Public License as published by
11 e2fa2baf Iustin Pop
the Free Software Foundation; either version 2 of the License, or
12 e2fa2baf Iustin Pop
(at your option) any later version.
13 e2fa2baf Iustin Pop
14 e2fa2baf Iustin Pop
This program is distributed in the hope that it will be useful, but
15 e2fa2baf Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
16 e2fa2baf Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 e2fa2baf Iustin Pop
General Public License for more details.
18 e2fa2baf Iustin Pop
19 e2fa2baf Iustin Pop
You should have received a copy of the GNU General Public License
20 e2fa2baf Iustin Pop
along with this program; if not, write to the Free Software
21 e2fa2baf Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22 e2fa2baf Iustin Pop
02110-1301, USA.
23 e2fa2baf Iustin Pop
24 e2fa2baf Iustin Pop
-}
25 e2fa2baf Iustin Pop
26 c478f837 Iustin Pop
{-# LANGUAGE BangPatterns, CPP #-}
27 c9224fa4 Iustin Pop
28 669d7e3d Iustin Pop
module Ganeti.HTools.Rapi
29 dd4c56ed Iustin Pop
    (
30 040afc35 Iustin Pop
      loadData
31 748bfcc2 Iustin Pop
    , parseData
32 dd4c56ed Iustin Pop
    ) where
33 a7654563 Iustin Pop
34 3986684e Iustin Pop
import Data.Maybe (fromMaybe)
35 c478f837 Iustin Pop
#ifndef NO_CURL
36 a7654563 Iustin Pop
import Network.Curl
37 b8b9a53c Iustin Pop
import Network.Curl.Types ()
38 c478f837 Iustin Pop
#endif
39 a7654563 Iustin Pop
import Control.Monad
40 28f19313 Iustin Pop
import Text.JSON (JSObject, fromJSObject, decodeStrict)
41 6402a260 Iustin Pop
import Text.JSON.Types (JSValue(..))
42 a7654563 Iustin Pop
import Text.Printf (printf)
43 040afc35 Iustin Pop
44 9ba5c28f Iustin Pop
import Ganeti.HTools.Utils
45 040afc35 Iustin Pop
import Ganeti.HTools.Loader
46 e4c5beaf Iustin Pop
import Ganeti.HTools.Types
47 a679e9dc Iustin Pop
import qualified Ganeti.HTools.Group as Group
48 040afc35 Iustin Pop
import qualified Ganeti.HTools.Node as Node
49 040afc35 Iustin Pop
import qualified Ganeti.HTools.Instance as Instance
50 a69ff623 Iustin Pop
import qualified Ganeti.Constants as C
51 a7654563 Iustin Pop
52 c478f837 Iustin Pop
-- | Read an URL via curl and return the body if successful.
53 c478f837 Iustin Pop
getUrl :: (Monad m) => String -> IO (m String)
54 c478f837 Iustin Pop
55 c478f837 Iustin Pop
#ifdef NO_CURL
56 c478f837 Iustin Pop
getUrl _ = return $ fail "RAPI/curl backend disabled at compile time"
57 c478f837 Iustin Pop
58 c478f837 Iustin Pop
#else
59 c478f837 Iustin Pop
60 525bfb36 Iustin Pop
-- | The curl options we use.
61 4d8e5008 Iustin Pop
curlOpts :: [CurlOption]
62 4d8e5008 Iustin Pop
curlOpts = [ CurlSSLVerifyPeer False
63 4d8e5008 Iustin Pop
           , CurlSSLVerifyHost 0
64 4d8e5008 Iustin Pop
           , CurlTimeout (fromIntegral queryTimeout)
65 4d8e5008 Iustin Pop
           , CurlConnectTimeout (fromIntegral connTimeout)
66 4d8e5008 Iustin Pop
           ]
67 4d8e5008 Iustin Pop
68 a7654563 Iustin Pop
getUrl url = do
69 c9224fa4 Iustin Pop
  (code, !body) <- curlGetString url curlOpts
70 a7654563 Iustin Pop
  return (case code of
71 ba00ad4d Iustin Pop
            CurlOK -> return body
72 ba00ad4d Iustin Pop
            _ -> fail $ printf "Curl error for '%s', error %s"
73 aab26f2d Iustin Pop
                 url (show code))
74 c478f837 Iustin Pop
#endif
75 aab26f2d Iustin Pop
76 9188aeef Iustin Pop
-- | Append the default port if not passed in.
77 e015b554 Iustin Pop
formatHost :: String -> String
78 e015b554 Iustin Pop
formatHost master =
79 5182e970 Iustin Pop
    if ':' `elem` master then  master
80 a69ff623 Iustin Pop
    else "https://" ++ master ++ ":" ++ show C.defaultRapiPort
81 e015b554 Iustin Pop
82 9188aeef Iustin Pop
-- | Parse a instance list in JSON format.
83 040afc35 Iustin Pop
getInstances :: NameAssoc
84 040afc35 Iustin Pop
             -> String
85 040afc35 Iustin Pop
             -> Result [(String, Instance.Instance)]
86 262f3e6c Iustin Pop
getInstances ktn body =
87 c8b662f1 Iustin Pop
    loadJSArray "Parsing instance data" body >>=
88 c8b662f1 Iustin Pop
    mapM (parseInstance ktn . fromJSObject)
89 a7654563 Iustin Pop
90 9188aeef Iustin Pop
-- | Parse a node list in JSON format.
91 10ef6b4e Iustin Pop
getNodes :: NameAssoc -> String -> Result [(String, Node.Node)]
92 10ef6b4e Iustin Pop
getNodes ktg body = loadJSArray "Parsing node data" body >>=
93 10ef6b4e Iustin Pop
                mapM (parseNode ktg . fromJSObject)
94 a7654563 Iustin Pop
95 a679e9dc Iustin Pop
-- | Parse a group list in JSON format.
96 a679e9dc Iustin Pop
getGroups :: String -> Result [(String, Group.Group)]
97 a679e9dc Iustin Pop
getGroups body = loadJSArray "Parsing group data" body >>=
98 a679e9dc Iustin Pop
                mapM (parseGroup . fromJSObject)
99 a679e9dc Iustin Pop
100 9188aeef Iustin Pop
-- | Construct an instance from a JSON object.
101 6ff78049 Iustin Pop
parseInstance :: NameAssoc
102 28f19313 Iustin Pop
              -> JSRecord
103 040afc35 Iustin Pop
              -> Result (String, Instance.Instance)
104 040afc35 Iustin Pop
parseInstance ktn a = do
105 117dc2d8 Iustin Pop
  name <- tryFromObj "Parsing new instance" a "name"
106 6a062ff9 Iustin Pop
  let owner_name = "Instance '" ++ name ++ "', error while parsing data"
107 6402a260 Iustin Pop
  let extract s x = tryFromObj owner_name x s
108 117dc2d8 Iustin Pop
  disk <- extract "disk_usage" a
109 117dc2d8 Iustin Pop
  beparams <- liftM fromJSObject (extract "beparams" a)
110 6402a260 Iustin Pop
  omem <- extract "oper_ram" a
111 6402a260 Iustin Pop
  mem <- (case omem of
112 6402a260 Iustin Pop
            JSRational _ _ -> annotateResult owner_name (fromJVal omem)
113 6402a260 Iustin Pop
            _ -> extract "memory" beparams)
114 117dc2d8 Iustin Pop
  vcpus <- extract "vcpus" beparams
115 117dc2d8 Iustin Pop
  pnode <- extract "pnode" a >>= lookupNode ktn name
116 117dc2d8 Iustin Pop
  snodes <- extract "snodes" a
117 040afc35 Iustin Pop
  snode <- (if null snodes then return Node.noSecondary
118 040afc35 Iustin Pop
            else readEitherString (head snodes) >>= lookupNode ktn name)
119 117dc2d8 Iustin Pop
  running <- extract "status" a
120 17e7af2b Iustin Pop
  tags <- extract "tags" a
121 a041ebb5 Iustin Pop
  auto_balance <- extract "auto_balance" beparams
122 5a4a3b7f Iustin Pop
  dt <- extract "disk_template" a
123 a041ebb5 Iustin Pop
  let inst = Instance.create name mem disk vcpus running tags
124 5a4a3b7f Iustin Pop
             auto_balance pnode snode dt
125 040afc35 Iustin Pop
  return (name, inst)
126 a7654563 Iustin Pop
127 9188aeef Iustin Pop
-- | Construct a node from a JSON object.
128 28f19313 Iustin Pop
parseNode :: NameAssoc -> JSRecord -> Result (String, Node.Node)
129 10ef6b4e Iustin Pop
parseNode ktg a = do
130 117dc2d8 Iustin Pop
  name <- tryFromObj "Parsing new node" a "name"
131 6a062ff9 Iustin Pop
  let desc = "Node '" ++ name ++ "', error while parsing data"
132 3986684e Iustin Pop
      extract s = tryFromObj desc a s
133 117dc2d8 Iustin Pop
  offline <- extract "offline"
134 b45222ce Iustin Pop
  drained <- extract "drained"
135 3986684e Iustin Pop
  vm_cap  <- annotateResult desc $ maybeFromObj a "vm_capable"
136 3986684e Iustin Pop
  let vm_cap' = fromMaybe True vm_cap
137 3986684e Iustin Pop
  guuid   <- annotateResult desc $ maybeFromObj a "group.uuid"
138 3986684e Iustin Pop
  guuid' <-  lookupGroup ktg name (fromMaybe defaultGroupID guuid)
139 3986684e Iustin Pop
  node <- (if offline || drained || not vm_cap'
140 3986684e Iustin Pop
           then return $ Node.create name 0 0 0 0 0 0 True guuid'
141 262f3e6c Iustin Pop
           else do
142 117dc2d8 Iustin Pop
             mtotal  <- extract "mtotal"
143 117dc2d8 Iustin Pop
             mnode   <- extract "mnode"
144 117dc2d8 Iustin Pop
             mfree   <- extract "mfree"
145 117dc2d8 Iustin Pop
             dtotal  <- extract "dtotal"
146 117dc2d8 Iustin Pop
             dfree   <- extract "dfree"
147 117dc2d8 Iustin Pop
             ctotal  <- extract "ctotal"
148 262f3e6c Iustin Pop
             return $ Node.create name mtotal mnode mfree
149 3986684e Iustin Pop
                    dtotal dfree ctotal False guuid')
150 262f3e6c Iustin Pop
  return (name, node)
151 00b15752 Iustin Pop
152 a679e9dc Iustin Pop
-- | Construct a group from a JSON object.
153 28f19313 Iustin Pop
parseGroup :: JSRecord -> Result (String, Group.Group)
154 a679e9dc Iustin Pop
parseGroup a = do
155 a679e9dc Iustin Pop
  name <- tryFromObj "Parsing new group" a "name"
156 a679e9dc Iustin Pop
  let extract s = tryFromObj ("Group '" ++ name ++ "'") a s
157 a679e9dc Iustin Pop
  uuid <- extract "uuid"
158 2ddabf4f Iustin Pop
  apol <- extract "alloc_policy"
159 2ddabf4f Iustin Pop
  return (uuid, Group.create name uuid apol)
160 a679e9dc Iustin Pop
161 748bfcc2 Iustin Pop
-- | Loads the raw cluster data from an URL.
162 748bfcc2 Iustin Pop
readData :: String -- ^ Cluster or URL to use as source
163 a679e9dc Iustin Pop
         -> IO (Result String, Result String, Result String, Result String)
164 748bfcc2 Iustin Pop
readData master = do
165 040afc35 Iustin Pop
  let url = formatHost master
166 a679e9dc Iustin Pop
  group_body <- getUrl $ printf "%s/2/groups?bulk=1" url
167 040afc35 Iustin Pop
  node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
168 040afc35 Iustin Pop
  inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
169 ea017cbc Iustin Pop
  tags_body <- getUrl $ printf "%s/2/tags" url
170 a679e9dc Iustin Pop
  return (group_body, node_body, inst_body, tags_body)
171 748bfcc2 Iustin Pop
172 525bfb36 Iustin Pop
-- | Builds the cluster data from the raw Rapi content.
173 a679e9dc Iustin Pop
parseData :: (Result String, Result String, Result String, Result String)
174 f4f6eb0b Iustin Pop
          -> Result ClusterData
175 a679e9dc Iustin Pop
parseData (group_body, node_body, inst_body, tags_body) = do
176 3667467d Iustin Pop
  group_data <- group_body >>= getGroups
177 10ef6b4e Iustin Pop
  let (group_names, group_idx) = assignIndices group_data
178 10ef6b4e Iustin Pop
  node_data <- node_body >>= getNodes group_names
179 748bfcc2 Iustin Pop
  let (node_names, node_idx) = assignIndices node_data
180 748bfcc2 Iustin Pop
  inst_data <- inst_body >>= getInstances node_names
181 748bfcc2 Iustin Pop
  let (_, inst_idx) = assignIndices inst_data
182 748bfcc2 Iustin Pop
  tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict)
183 f4f6eb0b Iustin Pop
  return (ClusterData group_idx node_idx inst_idx tags_data)
184 748bfcc2 Iustin Pop
185 525bfb36 Iustin Pop
-- | Top level function for data loading.
186 748bfcc2 Iustin Pop
loadData :: String -- ^ Cluster or URL to use as source
187 f4f6eb0b Iustin Pop
         -> IO (Result ClusterData)
188 2a8e2dc9 Iustin Pop
loadData = fmap parseData . readData