Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
S
snf-ganeti
Manage
Activity
Members
Labels
Plan
Issues
0
Issue boards
Milestones
Wiki
Code
Merge requests
0
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Model registry
Operate
Environments
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
itminedu
snf-ganeti
Commits
a7654563
Commit
a7654563
authored
16 years ago
by
Iustin Pop
Browse files
Options
Downloads
Patches
Plain Diff
Initial support for reading from RAPI
parent
e4f08c46
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
src/Rapi.hs
+115
-0
115 additions, 0 deletions
src/Rapi.hs
src/hbal.hs
+5
-0
5 additions, 0 deletions
src/hbal.hs
with
120 additions
and
0 deletions
src/Rapi.hs
0 → 100644
+
115
−
0
View file @
a7654563
{-| Implementation of the RAPI client interface.
-}
module
Rapi
where
import
Network.Curl
import
Network.Curl.Types
import
Network.Curl.Code
import
Data.Either
(
either
)
import
Data.Maybe
import
Control.Monad
import
Text.JSON
import
Text.Printf
(
printf
)
import
Utils
{-- Our cheap monad-like stuff.
Thi is needed since Either e a is already a monad instance somewhere
in the standard libraries (Control.Monad.Error) and we don't need that
entire thing.
-}
combine
::
(
Either
String
a
)
->
(
a
->
Either
String
b
)
->
(
Either
String
b
)
combine
(
Left
s
)
_
=
Left
s
combine
(
Right
s
)
f
=
f
s
ensureList
::
[
Either
String
a
]
->
Either
String
[
a
]
ensureList
lst
=
foldr
(
\
elem
accu
->
case
(
elem
,
accu
)
of
(
Left
x
,
_
)
->
Left
x
(
_
,
Left
x
)
->
Left
x
-- should never happen
(
Right
e
,
Right
a
)
->
Right
(
e
:
a
)
)
(
Right
[]
)
lst
loadJSArray
::
String
->
Either
String
[
JSObject
JSValue
]
loadJSArray
s
=
resultToEither
$
decodeStrict
s
getStringElement
::
String
->
JSObject
JSValue
->
Either
String
String
getStringElement
key
o
=
resultToEither
$
valFromObj
key
o
getIntElement
::
String
->
JSObject
JSValue
->
Either
String
String
getIntElement
key
o
=
let
tmp
=
resultToEither
$
((
valFromObj
key
o
)
::
Result
Int
)
in
case
tmp
of
Left
x
->
Left
x
Right
x
->
Right
$
show
x
concatElems
a
b
=
case
a
of
Left
_
->
a
Right
[]
->
b
Right
x
->
case
b
of
Left
_
->
b
Right
y
->
Right
(
x
++
"|"
++
y
)
getUrl
::
String
->
IO
(
Either
String
String
)
getUrl
url
=
do
(
code
,
body
)
<-
curlGetString
url
[
CurlSSLVerifyPeer
False
,
CurlSSLVerifyHost
0
]
return
(
case
code
of
CurlOK
->
Right
body
_
->
Left
$
printf
"url:%s, error: %s"
url
(
show
code
))
getInstances
::
String
->
IO
(
Either
String
String
)
getInstances
master
=
let
url
=
printf
"https://%s:5080/2/instances?bulk=1"
master
in
do
body
<-
getUrl
url
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
in
do
body
<-
getUrl
url
let
inst
=
body
`
combine
`
loadJSArray
`
combine
`
(
parseList
parseNode
)
return
inst
parseList
::
(
JSObject
JSValue
->
Either
String
String
)
->
[
JSObject
JSValue
]
->
Either
String
String
parseList
fn
idata
=
let
ml
=
ensureList
$
map
fn
idata
in
ml
`
combine
`
(
Right
.
unlines
)
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
Right
x
->
Right
x
bep
=
(
resultToEither
$
valFromObj
"beparams"
a
)
in
case
bep
of
Left
x
->
Left
x
Right
x
->
let
mem
=
getIntElement
"memory"
x
in
concatElems
name
$
concatElems
mem
disk
parseNode
::
JSObject
JSValue
->
Either
String
String
parseNode
a
=
let
name
=
getStringElement
"name"
a
mtotal
=
getIntElement
"mtotal"
a
mfree
=
getIntElement
"mfree"
a
dtotal
=
getIntElement
"dtotal"
a
dfree
=
getIntElement
"dfree"
a
in
concatElems
name
$
concatElems
mtotal
$
concatElems
mfree
$
concatElems
dtotal
dfree
This diff is collapsed.
Click to expand it.
src/hbal.hs
+
5
−
0
View file @
a7654563
...
...
@@ -16,6 +16,7 @@ import Text.Printf (printf)
import
qualified
Container
import
qualified
Cluster
import
Rapi
-- | Command line options structure.
data
Options
=
Options
...
...
@@ -110,6 +111,10 @@ parseOpts argv =
-- | Main function.
main
::
IO
()
main
=
do
i
<-
getInstances
"gnta1"
n
<-
getNodes
"gnta1"
print
i
print
n
cmd_args
<-
System
.
getArgs
(
opts
,
_
)
<-
parseOpts
cmd_args
(
nl
,
il
,
ktn
,
kti
)
<-
liftM2
Cluster
.
loadData
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment