Statistics
| Branch: | Tag: | Revision:

root / Ganeti / HTools / Rapi.hs @ 1297ce13

History | View | Annotate | Download (2.8 kB)

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

    
3
-}
4

    
5
module Ganeti.HTools.Rapi
6
    (
7
      getNodes
8
    , getInstances
9
    ) where
10

    
11
import Network.Curl
12
import Network.Curl.Types ()
13
import Network.Curl.Code
14
import Data.Either ()
15
import Data.Maybe
16
import Data.List
17
import Control.Monad
18
import Text.JSON (JSObject, JSValue)
19
import Text.Printf (printf)
20
import Ganeti.HTools.Utils
21

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

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

    
38
getInstances :: String -> IO (Result String)
39
getInstances master = do
40
  let url2 = printf "%s/2/instances?bulk=1" (formatHost master)
41
  body <- getUrl url2
42
  return $ (do x <- body
43
               arr <- loadJSArray x
44
               ilist <- mapM parseInstance arr
45
               return $ unlines ilist)
46

    
47
getNodes :: String -> IO (Result String)
48
getNodes master = do
49
  let url2 = printf "%s/2/nodes?bulk=1" (formatHost master)
50
  body <- getUrl url2
51
  return $ (do x <- body
52
               arr <- loadJSArray x
53
               nlist <- mapM parseNode arr
54
               return $ unlines nlist)
55

    
56
parseInstance :: JSObject JSValue -> Result String
57
parseInstance a =
58
    let name = getStringElement "name" a
59
        disk = getIntElement "disk_usage" a
60
        mem = getObjectElement "beparams" a >>= getIntElement "memory"
61
        pnode = getStringElement "pnode" a
62
        snode = (liftM head $ getListElement "snodes" a) >>= readEitherString
63
        running = getStringElement "status" a
64
    in
65
      name |+ (show `liftM` mem) |+
66
              (show `liftM` disk) |+
67
              running |+ pnode |+ snode
68

    
69
boolToYN :: (Monad m) => Bool -> m String
70
boolToYN True = return "Y"
71
boolToYN _ = return "N"
72

    
73
parseNode :: JSObject JSValue -> Result String
74
parseNode a =
75
    let name = getStringElement "name" a
76
        offline = getBoolElement "offline" a
77
        drained = getBoolElement "drained" a
78
        mtotal = getIntElement "mtotal" a
79
        mnode = getIntElement "mnode" a
80
        mfree = getIntElement "mfree" a
81
        dtotal = getIntElement "dtotal" a
82
        dfree = getIntElement "dfree" a
83
    in name |+
84
       (case offline of
85
          Ok True -> Ok "0|0|0|0|0|Y"
86
          _ ->
87
              (show `liftM` mtotal) |+ (show `liftM` mnode) |+
88
              (show `liftM` mfree) |+ (show `liftM` dtotal) |+
89
              (show `liftM` dfree) |+
90
              ((liftM2 (||) offline drained) >>= boolToYN)
91
       )