Rapi.hs 6.2 KB
Newer Older
1
2
3
4
{-| Implementation of the RAPI client interface.

-}

Iustin Pop's avatar
Iustin Pop committed
5
6
{-

7
Copyright (C) 2009, 2010 Google Inc.
Iustin Pop's avatar
Iustin Pop committed
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

26
module Ganeti.HTools.Rapi
Iustin Pop's avatar
Iustin Pop committed
27
    (
Iustin Pop's avatar
Iustin Pop committed
28
      loadData
29
    , parseData
Iustin Pop's avatar
Iustin Pop committed
30
    ) where
31
32

import Network.Curl
33
import Network.Curl.Types ()
34
import Control.Monad
35
import Text.JSON (JSObject, JSValue, fromJSObject, decodeStrict)
36
import Text.JSON.Types (JSValue(..))
37
import Text.Printf (printf)
Iustin Pop's avatar
Iustin Pop committed
38

39
import Ganeti.HTools.Utils
Iustin Pop's avatar
Iustin Pop committed
40
import Ganeti.HTools.Loader
Iustin Pop's avatar
Iustin Pop committed
41
import Ganeti.HTools.Types
42
import qualified Ganeti.HTools.Group as Group
Iustin Pop's avatar
Iustin Pop committed
43
44
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
45

Iustin Pop's avatar
Iustin Pop committed
46
-- | Read an URL via curl and return the body if successful.
Iustin Pop's avatar
Iustin Pop committed
47
getUrl :: (Monad m) => String -> IO (m String)
48
49
getUrl url = do
  (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
Iustin Pop's avatar
Iustin Pop committed
50
51
52
53
                                     CurlSSLVerifyHost 0,
                                     CurlTimeout (fromIntegral queryTimeout),
                                     CurlConnectTimeout
                                     (fromIntegral connTimeout)]
54
  return (case code of
Iustin Pop's avatar
Iustin Pop committed
55
56
            CurlOK -> return body
            _ -> fail $ printf "Curl error for '%s', error %s"
Iustin Pop's avatar
Iustin Pop committed
57
58
                 url (show code))

Iustin Pop's avatar
Iustin Pop committed
59
-- | Append the default port if not passed in.
60
61
formatHost :: String -> String
formatHost master =
62
    if ':' `elem` master then  master
63
64
    else "https://" ++ master ++ ":5080"

Iustin Pop's avatar
Iustin Pop committed
65
-- | Parse a instance list in JSON format.
Iustin Pop's avatar
Iustin Pop committed
66
67
68
getInstances :: NameAssoc
             -> String
             -> Result [(String, Instance.Instance)]
69
getInstances ktn body =
Iustin Pop's avatar
Iustin Pop committed
70
71
    loadJSArray "Parsing instance data" body >>=
    mapM (parseInstance ktn . fromJSObject)
72

Iustin Pop's avatar
Iustin Pop committed
73
-- | Parse a node list in JSON format.
Iustin Pop's avatar
Iustin Pop committed
74
75
76
getNodes :: NameAssoc -> String -> Result [(String, Node.Node)]
getNodes ktg body = loadJSArray "Parsing node data" body >>=
                mapM (parseNode ktg . fromJSObject)
77

78
79
80
81
82
-- | Parse a group list in JSON format.
getGroups :: String -> Result [(String, Group.Group)]
getGroups body = loadJSArray "Parsing group data" body >>=
                mapM (parseGroup . fromJSObject)

Iustin Pop's avatar
Iustin Pop committed
83
-- | Construct an instance from a JSON object.
84
parseInstance :: NameAssoc
85
              -> [(String, JSValue)]
Iustin Pop's avatar
Iustin Pop committed
86
87
              -> Result (String, Instance.Instance)
parseInstance ktn a = do
88
  name <- tryFromObj "Parsing new instance" a "name"
89
90
  let owner_name = "Instance '" ++ name ++ "'"
  let extract s x = tryFromObj owner_name x s
91
92
  disk <- extract "disk_usage" a
  beparams <- liftM fromJSObject (extract "beparams" a)
93
94
95
96
  omem <- extract "oper_ram" a
  mem <- (case omem of
            JSRational _ _ -> annotateResult owner_name (fromJVal omem)
            _ -> extract "memory" beparams)
97
98
99
  vcpus <- extract "vcpus" beparams
  pnode <- extract "pnode" a >>= lookupNode ktn name
  snodes <- extract "snodes" a
Iustin Pop's avatar
Iustin Pop committed
100
101
  snode <- (if null snodes then return Node.noSecondary
            else readEitherString (head snodes) >>= lookupNode ktn name)
102
  running <- extract "status" a
Iustin Pop's avatar
Iustin Pop committed
103
104
  tags <- extract "tags" a
  let inst = Instance.create name mem disk vcpus running tags pnode snode
Iustin Pop's avatar
Iustin Pop committed
105
  return (name, inst)
106

Iustin Pop's avatar
Iustin Pop committed
107
-- | Construct a node from a JSON object.
Iustin Pop's avatar
Iustin Pop committed
108
109
parseNode :: NameAssoc -> [(String, JSValue)] -> Result (String, Node.Node)
parseNode ktg a = do
110
111
112
  name <- tryFromObj "Parsing new node" a "name"
  let extract s = tryFromObj ("Node '" ++ name ++ "'") a s
  offline <- extract "offline"
113
  drained <- extract "drained"
Iustin Pop's avatar
Iustin Pop committed
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
117
           else do
118
119
120
121
122
123
             mtotal  <- extract "mtotal"
             mnode   <- extract "mnode"
             mfree   <- extract "mfree"
             dtotal  <- extract "dtotal"
             dfree   <- extract "dfree"
             ctotal  <- extract "ctotal"
124
             return $ Node.create name mtotal mnode mfree
125
                    dtotal dfree ctotal False guuid)
126
  return (name, node)
Iustin Pop's avatar
Iustin Pop committed
127

128
129
130
131
132
133
134
135
-- | Construct a group from a JSON object.
parseGroup :: [(String, JSValue)] -> Result (String, Group.Group)
parseGroup a = do
  name <- tryFromObj "Parsing new group" a "name"
  let extract s = tryFromObj ("Group '" ++ name ++ "'") a s
  uuid <- extract "uuid"
  return (uuid, Group.create name uuid AllocPreferred)

136
137
-- | Loads the raw cluster data from an URL.
readData :: String -- ^ Cluster or URL to use as source
138
         -> IO (Result String, Result String, Result String, Result String)
139
readData master = do
Iustin Pop's avatar
Iustin Pop committed
140
  let url = formatHost master
141
  group_body <- getUrl $ printf "%s/2/groups?bulk=1" url
Iustin Pop's avatar
Iustin Pop committed
142
143
  node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
  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)
146
147

-- | Builds the cluster data from the raw Rapi content
148
149
150
151
parseData :: (Result String, Result String, Result String, Result String)
          -> Result (Group.List, Node.List, Instance.List, [String])
parseData (group_body, node_body, inst_body, tags_body) = do
  group_data <- group_body >>= getGroups
Iustin Pop's avatar
Iustin Pop committed
152
153
  let (group_names, group_idx) = assignIndices group_data
  node_data <- node_body >>= getNodes group_names
154
155
156
157
  let (node_names, node_idx) = assignIndices node_data
  inst_data <- inst_body >>= getInstances node_names
  let (_, inst_idx) = assignIndices inst_data
  tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict)
158
  return (group_idx, node_idx, inst_idx, tags_data)
159
160
161

-- | Top level function for data loading
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