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.
import Network.Curl.Types ()
import Network.Curl.Code
import Data.Either ()
import Network.Curl.Types ()
import Network.Curl.Code
import Data.Either ()
import Control.Monad
import Text.JSON
import Text.Printf (printf)
import Control.Monad
import Text.JSON
import Text.Printf (printf)
loadJSArray :: String -> Either String [JSObject JSValue]
loadJSArray s = resultToEither $ decodeStrict s
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 :: 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 =
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]
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 =
readString :: JSValue -> Either String String
readString v =
JSString s -> Right $ fromJSString s
_ -> Left "Wrong JSON type"
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
getUrl :: String -> IO (Either String String)
getUrl url = do
CurlSSLVerifyHost 0]
return (case code of
CurlOK -> Right body
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 =
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
+ body <- tryRapi url1 url2
let inst = body `combine` loadJSArray `combine` (parseList parseInstance)
return inst
getNodes :: String -> IO (Either String String)
getNodes master =
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
+ body <- tryRapi url1 url2
let inst = body `combine` loadJSArray `combine` (parseList parseNode)
return inst
let inst = body `combine` loadJSArray `combine` (parseList parseNode)
return inst
parseInstance a =
let name = getStringElement "name" a
disk = case getIntElement "disk_usage" a of
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)
- bep = (resultToEither $ valFromObj "beparams" a)
+ bep = fromObj "beparams" a
pnode = getStringElement "pnode" a
snode = (listHead $ getListElement "snodes" a) `combine` readString
pnode = getStringElement "pnode" a
snode = (listHead $ getListElement "snodes" a) `combine` readString
+ mem = case bep of
+ Left _ -> getIntElement "admin_ram" a
+ Right _ -> bep
- 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 =
parseNode :: JSObject JSValue -> Either String String
parseNode a =