From aab26f2db73a8137d6cf669eb52a96aeebf08ef2 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Fri, 13 Feb 2009 22:26:23 +0100
Subject: [PATCH] Add compatibility with rapi v1
The patch adds compatibility with RAPI v1, and this required some new
JSON functions as valFromObj doesn't behave nicely.
Some other unrelated changes were done too.
---
src/Rapi.hs | 79 +++++++++++++++++++++++++++++++++++------------------
1 file changed, 52 insertions(+), 27 deletions(-)
diff --git a/src/Rapi.hs b/src/Rapi.hs
index 20c30910e..8f0ca9ccd 100644
--- a/src/Rapi.hs
+++ b/src/Rapi.hs
@@ -9,7 +9,7 @@ import Network.Curl
import Network.Curl.Types ()
import Network.Curl.Code
import Data.Either ()
-import Data.Maybe ()
+import Data.Maybe
import Control.Monad
import Text.JSON
import Text.Printf (printf)
@@ -47,22 +47,25 @@ listHead lst =
loadJSArray :: String -> Either String [JSObject JSValue]
loadJSArray s = resultToEither $ decodeStrict s
+fromObj :: JSON a => String -> JSObject JSValue -> Either String a
+fromObj k o =
+ case lookup k (fromJSObject o) of
+ Nothing -> Left $ printf "key '%s' not found" k
+ Just val -> resultToEither $ readJSON val
+
getStringElement :: String -> JSObject JSValue -> Either String String
-getStringElement key o =
- resultToEither $ valFromObj key o
+getStringElement key o = fromObj key o
getIntElement :: String -> JSObject JSValue -> Either String String
getIntElement key o =
- let tmp = resultToEither $ ((valFromObj key o)::Result Int)
+ let tmp = (fromObj key o)::Either String Int
in case tmp of
Left x -> Left x
Right x -> Right $ show x
getListElement :: String -> JSObject JSValue
-> Either String [JSValue]
-getListElement key o =
- let tmp = resultToEither $ ((valFromObj key o)::Result [JSValue])
- in tmp
+getListElement key o = fromObj key o
readString :: JSValue -> Either String String
readString v =
@@ -70,14 +73,20 @@ readString v =
JSString s -> Right $ fromJSString s
_ -> Left "Wrong JSON type"
-concatElems a b =
- case a of
- Left _ -> a
- Right [] -> b
- Right x ->
- case b of
- Left _ -> b
- Right y -> Right (x ++ "|" ++ y)
+concatElems :: Either String String
+ -> Either String String
+ -> Either String String
+concatElems = apply2 (\x y -> x ++ "|" ++ y)
+
+apply2 :: (a -> b -> c)
+ -> Either String a
+ -> Either String b
+ -> Either String c
+apply2 fn a b =
+ case (a, b) of
+ (Right x, Right y) -> Right $ fn x y
+ (Left x, _) -> Left x
+ (_, Left y) -> Left y
getUrl :: String -> IO (Either String String)
getUrl url = do
@@ -85,21 +94,35 @@ getUrl url = do
CurlSSLVerifyHost 0]
return (case code of
CurlOK -> Right body
- _ -> Left $ printf "url:%s, error: %s" url (show code))
+ _ -> Left $ printf "Curl error for '%s', error %s"
+ url (show code))
+
+tryRapi :: String -> String -> IO (Either String String)
+tryRapi url1 url2 =
+ do
+ body1 <- getUrl url1
+ body2 <- getUrl url2
+ return (case body1 of
+ Left _ -> body2
+ Right _ -> body1)
getInstances :: String -> IO (Either String String)
getInstances master =
- let url = printf "https://%s:5080/2/instances?bulk=1" master
+ let
+ url2 = printf "https://%s:5080/2/instances?bulk=1" master
+ url1 = printf "http://%s:5080/instances?bulk=1" master
in do
- body <- getUrl url
+ body <- tryRapi url1 url2
let inst = body `combine` loadJSArray `combine` (parseList parseInstance)
return inst
getNodes :: String -> IO (Either String String)
getNodes master =
- let url = printf "https://%s:5080/2/nodes?bulk=1" master
+ let
+ url2 = printf "https://%s:5080/2/nodes?bulk=1" master
+ url1 = printf "http://%s:5080/nodes?bulk=1" master
in do
- body <- getUrl url
+ body <- tryRapi url1 url2
let inst = body `combine` loadJSArray `combine` (parseList parseNode)
return inst
@@ -114,17 +137,19 @@ parseInstance :: JSObject JSValue -> Either String String
parseInstance a =
let name = getStringElement "name" a
disk = case getIntElement "disk_usage" a of
- Left _ -> getIntElement "sda_size" a
+ Left _ -> apply2 (\x y -> show $ ((read x)::Int) + ((read y)::Int))
+ (getIntElement "sda_size" a)
+ (getIntElement "sdb_size" a)
Right x -> Right x
- bep = (resultToEither $ valFromObj "beparams" a)
+ bep = fromObj "beparams" a
pnode = getStringElement "pnode" a
snode = (listHead $ getListElement "snodes" a) `combine` readString
+ mem = case bep of
+ Left _ -> getIntElement "admin_ram" a
+ Right _ -> bep
in
- case bep of
- Left x -> Left x
- Right x -> let mem = getIntElement "memory" x
- in concatElems name $ concatElems mem $
- concatElems disk $ concatElems pnode snode
+ concatElems name $ concatElems mem $
+ concatElems disk $ concatElems pnode snode
parseNode :: JSObject JSValue -> Either String String
parseNode a =
--
GitLab