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

-}

Iustin Pop's avatar
Iustin Pop committed
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
{-

Copyright (C) 2009 Google Inc.

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
Iustin Pop's avatar
Iustin Pop committed
29
    ) where
30
31

import Network.Curl
32
import Network.Curl.Types ()
33
import Network.Curl.Code
34
import Data.List
35
import Control.Monad
36
import Text.JSON (JSObject, JSValue, fromJSObject)
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
Iustin Pop's avatar
Iustin Pop committed
42
43
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
44

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

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

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

Iustin Pop's avatar
Iustin Pop committed
71
-- | Parse a node list in JSON format.
Iustin Pop's avatar
Iustin Pop committed
72
getNodes :: String -> Result [(String, Node.Node)]
73
getNodes body = loadJSArray body >>= mapM (parseNode . fromJSObject)
74

Iustin Pop's avatar
Iustin Pop committed
75
-- | Construct an instance from a JSON object.
76
parseInstance :: [(String, Ndx)]
77
              -> [(String, JSValue)]
Iustin Pop's avatar
Iustin Pop committed
78
79
80
81
              -> Result (String, Instance.Instance)
parseInstance ktn a = do
  name <- fromObj "name" a
  disk <- fromObj "disk_usage" a
82
83
  mem <- fromObj "beparams" a >>= fromObj "memory" . fromJSObject
  vcpus <- fromObj "beparams" a >>= fromObj "vcpus" . fromJSObject
Iustin Pop's avatar
Iustin Pop committed
84
  pnode <- fromObj "pnode" a >>= lookupNode ktn name
Iustin Pop's avatar
Iustin Pop committed
85
  snodes <- fromObj "snodes" a
Iustin Pop's avatar
Iustin Pop committed
86
87
88
  snode <- (if null snodes then return Node.noSecondary
            else readEitherString (head snodes) >>= lookupNode ktn name)
  running <- fromObj "status" a
89
  let inst = Instance.create name mem disk vcpus running pnode snode
Iustin Pop's avatar
Iustin Pop committed
90
  return (name, inst)
91

Iustin Pop's avatar
Iustin Pop committed
92
-- | Construct a node from a JSON object.
93
parseNode :: [(String, JSValue)] -> Result (String, Node.Node)
Iustin Pop's avatar
Iustin Pop committed
94
parseNode a = do
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
  name <- fromObj "name" a
  offline <- fromObj "offline" a
  node <- (if offline
           then return $ Node.create name 0 0 0 0 0 0 True
           else do
             drained <- fromObj "drained" a
             mtotal  <- fromObj "mtotal"  a
             mnode   <- fromObj "mnode"   a
             mfree   <- fromObj "mfree"   a
             dtotal  <- fromObj "dtotal"  a
             dfree   <- fromObj "dfree"   a
             ctotal  <- fromObj "ctotal"  a
             return $ Node.create name mtotal mnode mfree
                    dtotal dfree ctotal (offline || drained))
  return (name, node)
Iustin Pop's avatar
Iustin Pop committed
110

Iustin Pop's avatar
Iustin Pop committed
111
-- | Builds the cluster data from an URL.
Iustin Pop's avatar
Iustin Pop committed
112
loadData :: String -- ^ Cluster or URL to use as source
113
         -> IO (Result (Node.AssocList, Instance.AssocList))
Iustin Pop's avatar
Iustin Pop committed
114
115
116
117
118
119
loadData master = do -- IO monad
  let url = formatHost master
  node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
  inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
  return $ do -- Result monad
    node_data <- node_body >>= getNodes
120
    let (node_names, node_idx) = assignIndices node_data
Iustin Pop's avatar
Iustin Pop committed
121
    inst_data <- inst_body >>= getInstances node_names
122
123
    let (_, inst_idx) = assignIndices inst_data
    return (node_idx, inst_idx)