Statistics
| Branch: | Tag: | Revision:

root / Ganeti / HTools / Rapi.hs @ 608efcce

History | View | Annotate | Download (3.1 kB)

1
{-| Implementation of the RAPI client interface.
2

    
3
-}
4

    
5
module Ganeti.HTools.Rapi
6
    (
7
      loadData
8
    ) where
9

    
10
import Network.Curl
11
import Network.Curl.Types ()
12
import Network.Curl.Code
13
import Data.List
14
import Control.Monad
15
import Text.JSON (JSObject, JSValue)
16
import Text.Printf (printf)
17

    
18
import Ganeti.HTools.Utils
19
import Ganeti.HTools.Loader
20
import Ganeti.HTools.Types
21
import qualified Ganeti.HTools.Node as Node
22
import qualified Ganeti.HTools.Instance as Instance
23

    
24
-- | Read an URL via curl and return the body if successful
25
getUrl :: (Monad m) => String -> IO (m String)
26
getUrl url = do
27
  (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
28
                                     CurlSSLVerifyHost 0]
29
  return (case code of
30
            CurlOK -> return body
31
            _ -> fail $ printf "Curl error for '%s', error %s"
32
                 url (show code))
33

    
34
-- | Append the default port if not passed in
35
formatHost :: String -> String
36
formatHost master =
37
    if elem ':' master then  master
38
    else "https://" ++ master ++ ":5080"
39

    
40
getInstances :: NameAssoc
41
             -> String
42
             -> Result [(String, Instance.Instance)]
43
getInstances ktn body = do
44
  arr <- loadJSArray body
45
  ilist <- mapM (parseInstance ktn) arr
46
  return ilist
47

    
48
getNodes :: String -> Result [(String, Node.Node)]
49
getNodes body = do
50
  arr <- loadJSArray body
51
  nlist <- mapM parseNode arr
52
  return nlist
53

    
54
parseInstance :: [(String, Ndx)]
55
              -> JSObject JSValue
56
              -> Result (String, Instance.Instance)
57
parseInstance ktn a = do
58
  name <- fromObj "name" a
59
  disk <- fromObj "disk_usage" a
60
  mem <- fromObj "beparams" a >>= fromObj "memory"
61
  pnode <- fromObj "pnode" a >>= lookupNode ktn name
62
  snodes <- fromObj "snodes" a
63
  snode <- (if null snodes then return Node.noSecondary
64
            else readEitherString (head snodes) >>= lookupNode ktn name)
65
  running <- fromObj "status" a
66
  let inst = Instance.create name mem disk running pnode snode
67
  return (name, inst)
68

    
69
parseNode :: JSObject JSValue -> Result (String, Node.Node)
70
parseNode a = do
71
    name <- fromObj "name" a
72
    offline <- fromObj "offline" a
73
    node <- (case offline of
74
               True -> return $ Node.create name 0 0 0 0 0 True
75
               _ -> do
76
                 drained <- fromObj "drained" a
77
                 mtotal <- fromObj "mtotal" a
78
                 mnode <- fromObj "mnode" a
79
                 mfree <- fromObj "mfree" a
80
                 dtotal <- fromObj "dtotal" a
81
                 dfree <- fromObj "dfree" a
82
                 return $ Node.create name mtotal mnode mfree
83
                        dtotal dfree (offline || drained))
84
    return (name, node)
85

    
86
loadData :: String -- ^ Cluster or URL to use as source
87
         -> IO (Result (Node.AssocList, Instance.AssocList))
88
loadData master = do -- IO monad
89
  let url = formatHost master
90
  node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
91
  inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
92
  return $ do -- Result monad
93
    node_data <- node_body >>= getNodes
94
    let (node_names, node_idx) = assignIndices node_data
95
    inst_data <- inst_body >>= getInstances node_names
96
    let (_, inst_idx) = assignIndices inst_data
97
    return (node_idx, inst_idx)