Revision a0090487 htools/Ganeti/Luxi.hs
| b/htools/Ganeti/Luxi.hs | ||
|---|---|---|
| 1 |
{-# LANGUAGE TemplateHaskell #-}
|
|
| 2 |
|
|
| 1 | 3 |
{-| Implementation of the Ganeti LUXI interface.
|
| 2 | 4 |
|
| 3 | 5 |
-} |
| ... | ... | |
| 46 | 48 |
|
| 47 | 49 |
import Ganeti.Jobs (JobStatus) |
| 48 | 50 |
import Ganeti.OpCodes (OpCode) |
| 51 |
import Ganeti.THH |
|
| 49 | 52 |
|
| 50 | 53 |
-- * Utility functions |
| 51 | 54 |
|
| ... | ... | |
| 59 | 62 |
|
| 60 | 63 |
-- * Generic protocol functionality |
| 61 | 64 |
|
| 62 |
-- | Currently supported Luxi operations. |
|
| 63 |
data LuxiOp = QueryInstances [String] [String] Bool |
|
| 64 |
| QueryNodes [String] [String] Bool |
|
| 65 |
| QueryGroups [String] [String] Bool |
|
| 66 |
| QueryJobs [Int] [String] |
|
| 67 |
| QueryExports [String] Bool |
|
| 68 |
| QueryConfigValues [String] |
|
| 69 |
| QueryClusterInfo |
|
| 70 |
| QueryTags String String |
|
| 71 |
| SubmitJob [OpCode] |
|
| 72 |
| SubmitManyJobs [[OpCode]] |
|
| 73 |
| WaitForJobChange Int [String] JSValue JSValue Int |
|
| 74 |
| ArchiveJob Int |
|
| 75 |
| AutoArchiveJobs Int Int |
|
| 76 |
| CancelJob Int |
|
| 77 |
| SetDrainFlag Bool |
|
| 78 |
| SetWatcherPause Double |
|
| 79 |
deriving (Show, Read) |
|
| 65 |
-- | Currently supported Luxi operations and JSON serialization. |
|
| 66 |
$(genLuxiOp "LuxiOp" |
|
| 67 |
[ ("QueryNodes",
|
|
| 68 |
[ ("names", [t| [String] |], [| id |])
|
|
| 69 |
, ("fields", [t| [String] |], [| id |])
|
|
| 70 |
, ("lock", [t| Bool |], [| id |])
|
|
| 71 |
], |
|
| 72 |
[| J.showJSON |]) |
|
| 73 |
, ("QueryGroups",
|
|
| 74 |
[ ("names", [t| [String] |], [| id |])
|
|
| 75 |
, ("fields", [t| [String] |], [| id |])
|
|
| 76 |
, ("lock", [t| Bool |], [| id |])
|
|
| 77 |
], |
|
| 78 |
[| J.showJSON |]) |
|
| 79 |
, ("QueryInstances",
|
|
| 80 |
[ ("names", [t| [String] |], [| id |])
|
|
| 81 |
, ("fields", [t| [String] |], [| id |])
|
|
| 82 |
, ("lock", [t| Bool |], [| id |])
|
|
| 83 |
], |
|
| 84 |
[| J.showJSON |]) |
|
| 85 |
, ("QueryJobs",
|
|
| 86 |
[ ("ids", [t| [Int] |], [| map show |])
|
|
| 87 |
, ("fields", [t| [String] |], [| id |])
|
|
| 88 |
], |
|
| 89 |
[| J.showJSON |]) |
|
| 90 |
, ("QueryExports",
|
|
| 91 |
[ ("nodes", [t| [String] |], [| id |])
|
|
| 92 |
, ("lock", [t| Bool |], [| id |])
|
|
| 93 |
], |
|
| 94 |
[| J.showJSON |]) |
|
| 95 |
, ("QueryConfigValues",
|
|
| 96 |
[ ("fields", [t| [String] |], [| id |]) ],
|
|
| 97 |
[| J.showJSON |]) |
|
| 98 |
, ("QueryClusterInfo",
|
|
| 99 |
[], |
|
| 100 |
[| J.showJSON |]) |
|
| 101 |
, ("QueryTags",
|
|
| 102 |
[ ("kind", [t| String |], [| id |])
|
|
| 103 |
, ("name", [t| String |], [| id |])
|
|
| 104 |
], |
|
| 105 |
[| J.showJSON |]) |
|
| 106 |
, ("SubmitJob",
|
|
| 107 |
[ ("job", [t| [OpCode] |], [| id |]) ],
|
|
| 108 |
[| J.showJSON |]) |
|
| 109 |
, ("SubmitManyJobs",
|
|
| 110 |
[ ("ops", [t| [[OpCode]] |], [| id |]) ],
|
|
| 111 |
[| J.showJSON |]) |
|
| 112 |
, ("WaitForJobChange",
|
|
| 113 |
[ ("job", [t| Int |], [| J.showJSON |])
|
|
| 114 |
, ("fields", [t| [String]|], [| J.showJSON |])
|
|
| 115 |
, ("prev_job", [t| JSValue |], [| J.showJSON |])
|
|
| 116 |
, ("prev_log", [t| JSValue |], [| J.showJSON |])
|
|
| 117 |
, ("tmout", [t| Int |], [| J.showJSON |])
|
|
| 118 |
], |
|
| 119 |
[| \(j, f, pj, pl, t) -> JSArray [j, f, pj, pl, t] |]) |
|
| 120 |
, ("ArchiveJob",
|
|
| 121 |
[ ("job", [t| Int |], [| show |]) ],
|
|
| 122 |
[| J.showJSON |]) |
|
| 123 |
, ("AutoArchiveJobs",
|
|
| 124 |
[ ("age", [t| Int |], [| id |])
|
|
| 125 |
, ("tmout", [t| Int |], [| id |])
|
|
| 126 |
], |
|
| 127 |
[| J.showJSON |]) |
|
| 128 |
, ("CancelJob",
|
|
| 129 |
[("job", [t| Int |], [| show |]) ],
|
|
| 130 |
[| J.showJSON |]) |
|
| 131 |
, ("SetDrainFlag",
|
|
| 132 |
[ ("flag", [t| Bool |], [| id |]) ],
|
|
| 133 |
[| J.showJSON |]) |
|
| 134 |
, ("SetWatcherPause",
|
|
| 135 |
[ ("duration", [t| Double |], [| \x -> [x] |]) ],
|
|
| 136 |
[| J.showJSON |]) |
|
| 137 |
]) |
|
| 80 | 138 |
|
| 81 | 139 |
-- | The serialisation of LuxiOps into strings in messages. |
| 82 |
strOfOp :: LuxiOp -> String |
|
| 83 |
strOfOp QueryNodes {} = "QueryNodes"
|
|
| 84 |
strOfOp QueryGroups {} = "QueryGroups"
|
|
| 85 |
strOfOp QueryInstances {} = "QueryInstances"
|
|
| 86 |
strOfOp QueryJobs {} = "QueryJobs"
|
|
| 87 |
strOfOp QueryExports {} = "QueryExports"
|
|
| 88 |
strOfOp QueryConfigValues {} = "QueryConfigValues"
|
|
| 89 |
strOfOp QueryClusterInfo {} = "QueryClusterInfo"
|
|
| 90 |
strOfOp QueryTags {} = "QueryTags"
|
|
| 91 |
strOfOp SubmitManyJobs {} = "SubmitManyJobs"
|
|
| 92 |
strOfOp WaitForJobChange {} = "WaitForJobChange"
|
|
| 93 |
strOfOp SubmitJob {} = "SubmitJob"
|
|
| 94 |
strOfOp ArchiveJob {} = "ArchiveJob"
|
|
| 95 |
strOfOp AutoArchiveJobs {} = "AutoArchiveJobs"
|
|
| 96 |
strOfOp CancelJob {} = "CancelJob"
|
|
| 97 |
strOfOp SetDrainFlag {} = "SetDrainFlag"
|
|
| 98 |
strOfOp SetWatcherPause {} = "SetWatcherPause"
|
|
| 140 |
$(genStrOfOp ''LuxiOp "strOfOp") |
|
| 99 | 141 |
|
| 100 | 142 |
-- | The end-of-message separator. |
| 101 | 143 |
eOM :: Char |
| ... | ... | |
| 108 | 150 |
| Result |
| 109 | 151 |
|
| 110 | 152 |
-- | The serialisation of MsgKeys into strings in messages. |
| 111 |
strOfKey :: MsgKeys -> String |
|
| 112 |
strOfKey Method = "method" |
|
| 113 |
strOfKey Args = "args" |
|
| 114 |
strOfKey Success = "success" |
|
| 115 |
strOfKey Result = "result" |
|
| 153 |
$(genStrOfKey ''MsgKeys "strOfKey") |
|
| 116 | 154 |
|
| 117 | 155 |
-- | Luxi client encapsulation. |
| 118 | 156 |
data Client = Client { socket :: S.Socket -- ^ The socket of the client
|
| ... | ... | |
| 161 | 199 |
writeIORef (rbuf s) nbuf |
| 162 | 200 |
return msg |
| 163 | 201 |
|
| 164 |
-- | Compute the serialized form of a Luxi operation. |
|
| 165 |
opToArgs :: LuxiOp -> JSValue |
|
| 166 |
opToArgs (QueryNodes names fields lock) = J.showJSON (names, fields, lock) |
|
| 167 |
opToArgs (QueryGroups names fields lock) = J.showJSON (names, fields, lock) |
|
| 168 |
opToArgs (QueryInstances names fields lock) = J.showJSON (names, fields, lock) |
|
| 169 |
opToArgs (QueryJobs ids fields) = J.showJSON (map show ids, fields) |
|
| 170 |
opToArgs (QueryExports nodes lock) = J.showJSON (nodes, lock) |
|
| 171 |
opToArgs (QueryConfigValues fields) = J.showJSON fields |
|
| 172 |
opToArgs (QueryClusterInfo) = J.showJSON () |
|
| 173 |
opToArgs (QueryTags kind name) = J.showJSON (kind, name) |
|
| 174 |
opToArgs (SubmitJob j) = J.showJSON j |
|
| 175 |
opToArgs (SubmitManyJobs ops) = J.showJSON ops |
|
| 176 |
-- This is special, since the JSON library doesn't export an instance |
|
| 177 |
-- of a 5-tuple |
|
| 178 |
opToArgs (WaitForJobChange a b c d e) = |
|
| 179 |
JSArray [ J.showJSON a, J.showJSON b, J.showJSON c |
|
| 180 |
, J.showJSON d, J.showJSON e] |
|
| 181 |
opToArgs (ArchiveJob a) = J.showJSON (show a) |
|
| 182 |
opToArgs (AutoArchiveJobs a b) = J.showJSON (a, b) |
|
| 183 |
opToArgs (CancelJob a) = J.showJSON (show a) |
|
| 184 |
opToArgs (SetDrainFlag flag) = J.showJSON flag |
|
| 185 |
opToArgs (SetWatcherPause duration) = J.showJSON [duration] |
|
| 186 |
|
|
| 187 | 202 |
-- | Serialize a request to String. |
| 188 | 203 |
buildCall :: LuxiOp -- ^ The method |
| 189 | 204 |
-> String -- ^ The serialized form |
Also available in: Unified diff