root / Ganeti / HTools / Cluster.hs @ dbba5246
History | View | Annotate | Download (28.4 kB)
1 | e4f08c46 | Iustin Pop | {-| Implementation of cluster-wide logic. |
---|---|---|---|
2 | e4f08c46 | Iustin Pop | |
3 | e4f08c46 | Iustin Pop | This module holds all pure cluster-logic; I\/O related functionality |
4 | 7ae514ba | Iustin Pop | goes into the "Main" module for the individual binaries. |
5 | e4f08c46 | Iustin Pop | |
6 | e4f08c46 | Iustin Pop | -} |
7 | e4f08c46 | Iustin Pop | |
8 | 669d7e3d | Iustin Pop | module Ganeti.HTools.Cluster |
9 | e4f08c46 | Iustin Pop | ( |
10 | e4f08c46 | Iustin Pop | -- * Types |
11 | f9fc7a63 | Iustin Pop | Placement |
12 | e4f08c46 | Iustin Pop | , Solution(..) |
13 | e4f08c46 | Iustin Pop | , Table(..) |
14 | e4f08c46 | Iustin Pop | , Removal |
15 | b0517d61 | Iustin Pop | , Score |
16 | 58709f92 | Iustin Pop | , IMove(..) |
17 | e4f08c46 | Iustin Pop | -- * Generic functions |
18 | e4f08c46 | Iustin Pop | , totalResources |
19 | e4f08c46 | Iustin Pop | -- * First phase functions |
20 | e4f08c46 | Iustin Pop | , computeBadItems |
21 | e4f08c46 | Iustin Pop | -- * Second phase functions |
22 | e4f08c46 | Iustin Pop | , computeSolution |
23 | e4f08c46 | Iustin Pop | , applySolution |
24 | e4f08c46 | Iustin Pop | , printSolution |
25 | 7dfaafb1 | Iustin Pop | , printSolutionLine |
26 | 142538ff | Iustin Pop | , formatCmds |
27 | e4f08c46 | Iustin Pop | , printNodes |
28 | e4f08c46 | Iustin Pop | -- * Balacing functions |
29 | 58709f92 | Iustin Pop | , applyMove |
30 | e4f08c46 | Iustin Pop | , checkMove |
31 | e4f08c46 | Iustin Pop | , compCV |
32 | e4f08c46 | Iustin Pop | , printStats |
33 | 4a340313 | Iustin Pop | -- * IAllocator functions |
34 | 5e15f460 | Iustin Pop | , allocateOnSingle |
35 | 5e15f460 | Iustin Pop | , allocateOnPair |
36 | dbba5246 | Iustin Pop | , tryAlloc |
37 | dbba5246 | Iustin Pop | , tryReloc |
38 | e4f08c46 | Iustin Pop | ) where |
39 | e4f08c46 | Iustin Pop | |
40 | e4f08c46 | Iustin Pop | import Data.List |
41 | e4f08c46 | Iustin Pop | import Data.Maybe (isNothing, fromJust) |
42 | e4f08c46 | Iustin Pop | import Text.Printf (printf) |
43 | e4f08c46 | Iustin Pop | import Data.Function |
44 | 9d3fada5 | Iustin Pop | import Control.Monad |
45 | e4f08c46 | Iustin Pop | |
46 | 669d7e3d | Iustin Pop | import qualified Ganeti.HTools.Container as Container |
47 | 669d7e3d | Iustin Pop | import qualified Ganeti.HTools.Instance as Instance |
48 | 669d7e3d | Iustin Pop | import qualified Ganeti.HTools.Node as Node |
49 | e4c5beaf | Iustin Pop | import Ganeti.HTools.Types |
50 | 669d7e3d | Iustin Pop | import Ganeti.HTools.Utils |
51 | e4f08c46 | Iustin Pop | |
52 | 9188aeef | Iustin Pop | -- * Types |
53 | 9188aeef | Iustin Pop | |
54 | 9188aeef | Iustin Pop | -- | A separate name for the cluster score type. |
55 | e4f08c46 | Iustin Pop | type Score = Double |
56 | e4f08c46 | Iustin Pop | |
57 | e4f08c46 | Iustin Pop | -- | The description of an instance placement. |
58 | 608efcce | Iustin Pop | type Placement = (Idx, Ndx, Ndx, Score) |
59 | e4f08c46 | Iustin Pop | |
60 | 9188aeef | Iustin Pop | -- | A cluster solution described as the solution delta and the list |
61 | 9188aeef | Iustin Pop | -- of placements. |
62 | e4f08c46 | Iustin Pop | data Solution = Solution Int [Placement] |
63 | e4f08c46 | Iustin Pop | deriving (Eq, Ord, Show) |
64 | e4f08c46 | Iustin Pop | |
65 | e4f08c46 | Iustin Pop | -- | A removal set. |
66 | 262a08a2 | Iustin Pop | data Removal = Removal Node.List [Instance.Instance] |
67 | e4f08c46 | Iustin Pop | |
68 | e4f08c46 | Iustin Pop | -- | An instance move definition |
69 | 00b51a14 | Iustin Pop | data IMove = Failover -- ^ Failover the instance (f) |
70 | 608efcce | Iustin Pop | | ReplacePrimary Ndx -- ^ Replace primary (f, r:np, f) |
71 | 608efcce | Iustin Pop | | ReplaceSecondary Ndx -- ^ Replace secondary (r:ns) |
72 | 608efcce | Iustin Pop | | ReplaceAndFailover Ndx -- ^ Replace secondary, failover (r:np, f) |
73 | 608efcce | Iustin Pop | | FailoverAndReplace Ndx -- ^ Failover, replace secondary (f, r:ns) |
74 | e4f08c46 | Iustin Pop | deriving (Show) |
75 | e4f08c46 | Iustin Pop | |
76 | e4f08c46 | Iustin Pop | -- | The complete state for the balancing solution |
77 | 262a08a2 | Iustin Pop | data Table = Table Node.List Instance.List Score [Placement] |
78 | e4f08c46 | Iustin Pop | deriving (Show) |
79 | e4f08c46 | Iustin Pop | |
80 | 9188aeef | Iustin Pop | -- * Utility functions |
81 | 9188aeef | Iustin Pop | |
82 | 9188aeef | Iustin Pop | -- | Returns the delta of a solution or -1 for Nothing. |
83 | 9188aeef | Iustin Pop | solutionDelta :: Maybe Solution -> Int |
84 | 9188aeef | Iustin Pop | solutionDelta sol = case sol of |
85 | 9188aeef | Iustin Pop | Just (Solution d _) -> d |
86 | 9188aeef | Iustin Pop | _ -> -1 |
87 | e4f08c46 | Iustin Pop | |
88 | e4f08c46 | Iustin Pop | -- | Cap the removal list if needed. |
89 | e4f08c46 | Iustin Pop | capRemovals :: [a] -> Int -> [a] |
90 | e4f08c46 | Iustin Pop | capRemovals removals max_removals = |
91 | e4f08c46 | Iustin Pop | if max_removals > 0 then |
92 | e4f08c46 | Iustin Pop | take max_removals removals |
93 | e4f08c46 | Iustin Pop | else |
94 | e4f08c46 | Iustin Pop | removals |
95 | e4f08c46 | Iustin Pop | |
96 | e4f08c46 | Iustin Pop | -- | Check if the given node list fails the N+1 check. |
97 | e4f08c46 | Iustin Pop | verifyN1Check :: [Node.Node] -> Bool |
98 | e4f08c46 | Iustin Pop | verifyN1Check nl = any Node.failN1 nl |
99 | e4f08c46 | Iustin Pop | |
100 | e4f08c46 | Iustin Pop | -- | Verifies the N+1 status and return the affected nodes. |
101 | e4f08c46 | Iustin Pop | verifyN1 :: [Node.Node] -> [Node.Node] |
102 | e4f08c46 | Iustin Pop | verifyN1 nl = filter Node.failN1 nl |
103 | e4f08c46 | Iustin Pop | |
104 | 9188aeef | Iustin Pop | {-| Computes the pair of bad nodes and instances. |
105 | 9188aeef | Iustin Pop | |
106 | 9188aeef | Iustin Pop | The bad node list is computed via a simple 'verifyN1' check, and the |
107 | 9188aeef | Iustin Pop | bad instance list is the list of primary and secondary instances of |
108 | 9188aeef | Iustin Pop | those nodes. |
109 | 9188aeef | Iustin Pop | |
110 | 9188aeef | Iustin Pop | -} |
111 | 9188aeef | Iustin Pop | computeBadItems :: Node.List -> Instance.List -> |
112 | 9188aeef | Iustin Pop | ([Node.Node], [Instance.Instance]) |
113 | 9188aeef | Iustin Pop | computeBadItems nl il = |
114 | dbba5246 | Iustin Pop | let bad_nodes = verifyN1 $ getOnline nl |
115 | 9188aeef | Iustin Pop | bad_instances = map (\idx -> Container.find idx il) $ |
116 | 9188aeef | Iustin Pop | sort $ nub $ concat $ |
117 | 9188aeef | Iustin Pop | map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes |
118 | 9188aeef | Iustin Pop | in |
119 | 9188aeef | Iustin Pop | (bad_nodes, bad_instances) |
120 | 9188aeef | Iustin Pop | |
121 | 9188aeef | Iustin Pop | -- | Compute the total free disk and memory in the cluster. |
122 | d85a0a0f | Iustin Pop | totalResources :: Node.List -> (Int, Int) |
123 | 9188aeef | Iustin Pop | totalResources nl = |
124 | 9188aeef | Iustin Pop | foldl' |
125 | 9188aeef | Iustin Pop | (\ (mem, dsk) node -> (mem + (Node.f_mem node), |
126 | 9188aeef | Iustin Pop | dsk + (Node.f_dsk node))) |
127 | 9188aeef | Iustin Pop | (0, 0) (Container.elems nl) |
128 | 9188aeef | Iustin Pop | |
129 | 9188aeef | Iustin Pop | -- | Compute the mem and disk covariance. |
130 | 9188aeef | Iustin Pop | compDetailedCV :: Node.List -> (Double, Double, Double, Double, Double) |
131 | 9188aeef | Iustin Pop | compDetailedCV nl = |
132 | 9188aeef | Iustin Pop | let |
133 | 9188aeef | Iustin Pop | all_nodes = Container.elems nl |
134 | 9188aeef | Iustin Pop | (offline, nodes) = partition Node.offline all_nodes |
135 | 9188aeef | Iustin Pop | mem_l = map Node.p_mem nodes |
136 | 9188aeef | Iustin Pop | dsk_l = map Node.p_dsk nodes |
137 | 9188aeef | Iustin Pop | mem_cv = varianceCoeff mem_l |
138 | 9188aeef | Iustin Pop | dsk_cv = varianceCoeff dsk_l |
139 | 9188aeef | Iustin Pop | n1_l = length $ filter Node.failN1 nodes |
140 | 9188aeef | Iustin Pop | n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes) |
141 | 9188aeef | Iustin Pop | res_l = map Node.p_rem nodes |
142 | 9188aeef | Iustin Pop | res_cv = varianceCoeff res_l |
143 | 9188aeef | Iustin Pop | offline_inst = sum . map (\n -> (length . Node.plist $ n) + |
144 | 9188aeef | Iustin Pop | (length . Node.slist $ n)) $ offline |
145 | 9188aeef | Iustin Pop | online_inst = sum . map (\n -> (length . Node.plist $ n) + |
146 | 9188aeef | Iustin Pop | (length . Node.slist $ n)) $ nodes |
147 | 9188aeef | Iustin Pop | off_score = (fromIntegral offline_inst) / |
148 | 9188aeef | Iustin Pop | (fromIntegral $ online_inst + offline_inst) |
149 | 9188aeef | Iustin Pop | in (mem_cv, dsk_cv, n1_score, res_cv, off_score) |
150 | 9188aeef | Iustin Pop | |
151 | 9188aeef | Iustin Pop | -- | Compute the /total/ variance. |
152 | 9188aeef | Iustin Pop | compCV :: Node.List -> Double |
153 | 9188aeef | Iustin Pop | compCV nl = |
154 | 9188aeef | Iustin Pop | let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl |
155 | 9188aeef | Iustin Pop | in mem_cv + dsk_cv + n1_score + res_cv + off_score |
156 | 9188aeef | Iustin Pop | |
157 | dbba5246 | Iustin Pop | -- | Compute online nodes from a Node.List |
158 | dbba5246 | Iustin Pop | getOnline :: Node.List -> [Node.Node] |
159 | dbba5246 | Iustin Pop | getOnline = filter (not . Node.offline) . Container.elems |
160 | dbba5246 | Iustin Pop | |
161 | 9188aeef | Iustin Pop | -- * hn1 functions |
162 | 9188aeef | Iustin Pop | |
163 | 9188aeef | Iustin Pop | -- | Add an instance and return the new node and instance maps. |
164 | 262a08a2 | Iustin Pop | addInstance :: Node.List -> Instance.Instance -> |
165 | 262a08a2 | Iustin Pop | Node.Node -> Node.Node -> Maybe Node.List |
166 | e4f08c46 | Iustin Pop | addInstance nl idata pri sec = |
167 | e4f08c46 | Iustin Pop | let pdx = Node.idx pri |
168 | e4f08c46 | Iustin Pop | sdx = Node.idx sec |
169 | e4f08c46 | Iustin Pop | in do |
170 | e4f08c46 | Iustin Pop | pnode <- Node.addPri pri idata |
171 | e4f08c46 | Iustin Pop | snode <- Node.addSec sec idata pdx |
172 | e4f08c46 | Iustin Pop | new_nl <- return $ Container.addTwo sdx snode |
173 | e4f08c46 | Iustin Pop | pdx pnode nl |
174 | e4f08c46 | Iustin Pop | return new_nl |
175 | e4f08c46 | Iustin Pop | |
176 | e4f08c46 | Iustin Pop | -- | Remove an instance and return the new node and instance maps. |
177 | 262a08a2 | Iustin Pop | removeInstance :: Node.List -> Instance.Instance -> Node.List |
178 | e4f08c46 | Iustin Pop | removeInstance nl idata = |
179 | e4f08c46 | Iustin Pop | let pnode = Instance.pnode idata |
180 | e4f08c46 | Iustin Pop | snode = Instance.snode idata |
181 | e4f08c46 | Iustin Pop | pn = Container.find pnode nl |
182 | e4f08c46 | Iustin Pop | sn = Container.find snode nl |
183 | e4f08c46 | Iustin Pop | new_nl = Container.addTwo |
184 | e4f08c46 | Iustin Pop | pnode (Node.removePri pn idata) |
185 | e4f08c46 | Iustin Pop | snode (Node.removeSec sn idata) nl in |
186 | e4f08c46 | Iustin Pop | new_nl |
187 | e4f08c46 | Iustin Pop | |
188 | e4f08c46 | Iustin Pop | -- | Remove an instance and return the new node map. |
189 | 262a08a2 | Iustin Pop | removeInstances :: Node.List -> [Instance.Instance] -> Node.List |
190 | e4f08c46 | Iustin Pop | removeInstances = foldl' removeInstance |
191 | e4f08c46 | Iustin Pop | |
192 | e4f08c46 | Iustin Pop | |
193 | 9188aeef | Iustin Pop | {-| Compute a new version of a cluster given a solution. |
194 | e4f08c46 | Iustin Pop | |
195 | e4f08c46 | Iustin Pop | This is not used for computing the solutions, but for applying a |
196 | e4f08c46 | Iustin Pop | (known-good) solution to the original cluster for final display. |
197 | e4f08c46 | Iustin Pop | |
198 | e4f08c46 | Iustin Pop | It first removes the relocated instances after which it places them on |
199 | e4f08c46 | Iustin Pop | their new nodes. |
200 | e4f08c46 | Iustin Pop | |
201 | e4f08c46 | Iustin Pop | -} |
202 | 262a08a2 | Iustin Pop | applySolution :: Node.List -> Instance.List -> [Placement] -> Node.List |
203 | e4f08c46 | Iustin Pop | applySolution nl il sol = |
204 | c5c295bc | Iustin Pop | let odxes = map (\ (a, b, c, _) -> (Container.find a il, |
205 | c5c295bc | Iustin Pop | Node.idx (Container.find b nl), |
206 | c5c295bc | Iustin Pop | Node.idx (Container.find c nl)) |
207 | e4f08c46 | Iustin Pop | ) sol |
208 | e4f08c46 | Iustin Pop | idxes = (\ (x, _, _) -> x) (unzip3 odxes) |
209 | e4f08c46 | Iustin Pop | nc = removeInstances nl idxes |
210 | e4f08c46 | Iustin Pop | in |
211 | e4f08c46 | Iustin Pop | foldl' (\ nz (a, b, c) -> |
212 | e4f08c46 | Iustin Pop | let new_p = Container.find b nz |
213 | e4f08c46 | Iustin Pop | new_s = Container.find c nz in |
214 | e4f08c46 | Iustin Pop | fromJust (addInstance nz a new_p new_s) |
215 | e4f08c46 | Iustin Pop | ) nc odxes |
216 | e4f08c46 | Iustin Pop | |
217 | e4f08c46 | Iustin Pop | |
218 | 9188aeef | Iustin Pop | -- ** First phase functions |
219 | e4f08c46 | Iustin Pop | |
220 | 9188aeef | Iustin Pop | {-| Given a list 1,2,3..n build a list of pairs [(1, [2..n]), (2, |
221 | e4f08c46 | Iustin Pop | [3..n]), ...] |
222 | e4f08c46 | Iustin Pop | |
223 | e4f08c46 | Iustin Pop | -} |
224 | e4f08c46 | Iustin Pop | genParts :: [a] -> Int -> [(a, [a])] |
225 | e4f08c46 | Iustin Pop | genParts l count = |
226 | e4f08c46 | Iustin Pop | case l of |
227 | e4f08c46 | Iustin Pop | [] -> [] |
228 | e4f08c46 | Iustin Pop | x:xs -> |
229 | e4f08c46 | Iustin Pop | if length l < count then |
230 | e4f08c46 | Iustin Pop | [] |
231 | e4f08c46 | Iustin Pop | else |
232 | e4f08c46 | Iustin Pop | (x, xs) : (genParts xs count) |
233 | e4f08c46 | Iustin Pop | |
234 | e4f08c46 | Iustin Pop | -- | Generates combinations of count items from the names list. |
235 | e4f08c46 | Iustin Pop | genNames :: Int -> [b] -> [[b]] |
236 | e4f08c46 | Iustin Pop | genNames count1 names1 = |
237 | e4f08c46 | Iustin Pop | let aux_fn count names current = |
238 | e4f08c46 | Iustin Pop | case count of |
239 | e4f08c46 | Iustin Pop | 0 -> [current] |
240 | e4f08c46 | Iustin Pop | _ -> |
241 | e4f08c46 | Iustin Pop | concatMap |
242 | e4f08c46 | Iustin Pop | (\ (x, xs) -> aux_fn (count - 1) xs (x:current)) |
243 | e4f08c46 | Iustin Pop | (genParts names count) |
244 | e4f08c46 | Iustin Pop | in |
245 | e4f08c46 | Iustin Pop | aux_fn count1 names1 [] |
246 | e4f08c46 | Iustin Pop | |
247 | 9188aeef | Iustin Pop | {-| Checks if removal of instances results in N+1 pass. |
248 | e4f08c46 | Iustin Pop | |
249 | e4f08c46 | Iustin Pop | Note: the check removal cannot optimize by scanning only the affected |
250 | e4f08c46 | Iustin Pop | nodes, since the cluster is known to be not healthy; only the check |
251 | e4f08c46 | Iustin Pop | placement can make this shortcut. |
252 | e4f08c46 | Iustin Pop | |
253 | e4f08c46 | Iustin Pop | -} |
254 | 262a08a2 | Iustin Pop | checkRemoval :: Node.List -> [Instance.Instance] -> Maybe Removal |
255 | e4f08c46 | Iustin Pop | checkRemoval nl victims = |
256 | e4f08c46 | Iustin Pop | let nx = removeInstances nl victims |
257 | e4f08c46 | Iustin Pop | failN1 = verifyN1Check (Container.elems nx) |
258 | e4f08c46 | Iustin Pop | in |
259 | e4f08c46 | Iustin Pop | if failN1 then |
260 | e4f08c46 | Iustin Pop | Nothing |
261 | e4f08c46 | Iustin Pop | else |
262 | e4f08c46 | Iustin Pop | Just $ Removal nx victims |
263 | e4f08c46 | Iustin Pop | |
264 | e4f08c46 | Iustin Pop | |
265 | 9188aeef | Iustin Pop | -- | Computes the removals list for a given depth. |
266 | 262a08a2 | Iustin Pop | computeRemovals :: Node.List |
267 | e4f08c46 | Iustin Pop | -> [Instance.Instance] |
268 | e4f08c46 | Iustin Pop | -> Int |
269 | 669d7e3d | Iustin Pop | -> [Maybe Removal] |
270 | e4f08c46 | Iustin Pop | computeRemovals nl bad_instances depth = |
271 | e4f08c46 | Iustin Pop | map (checkRemoval nl) $ genNames depth bad_instances |
272 | e4f08c46 | Iustin Pop | |
273 | 9188aeef | Iustin Pop | -- ** Second phase functions |
274 | e4f08c46 | Iustin Pop | |
275 | 9188aeef | Iustin Pop | -- | Single-node relocation cost. |
276 | 608efcce | Iustin Pop | nodeDelta :: Ndx -> Ndx -> Ndx -> Int |
277 | e4f08c46 | Iustin Pop | nodeDelta i p s = |
278 | e4f08c46 | Iustin Pop | if i == p || i == s then |
279 | e4f08c46 | Iustin Pop | 0 |
280 | e4f08c46 | Iustin Pop | else |
281 | e4f08c46 | Iustin Pop | 1 |
282 | e4f08c46 | Iustin Pop | |
283 | 9188aeef | Iustin Pop | -- | Compute best solution. |
284 | 9188aeef | Iustin Pop | -- |
285 | 9188aeef | Iustin Pop | -- This function compares two solutions, choosing the minimum valid |
286 | 9188aeef | Iustin Pop | -- solution. |
287 | e4f08c46 | Iustin Pop | compareSolutions :: Maybe Solution -> Maybe Solution -> Maybe Solution |
288 | e4f08c46 | Iustin Pop | compareSolutions a b = case (a, b) of |
289 | e4f08c46 | Iustin Pop | (Nothing, x) -> x |
290 | e4f08c46 | Iustin Pop | (x, Nothing) -> x |
291 | e4f08c46 | Iustin Pop | (x, y) -> min x y |
292 | e4f08c46 | Iustin Pop | |
293 | e4f08c46 | Iustin Pop | -- | Check if a given delta is worse then an existing solution. |
294 | e4f08c46 | Iustin Pop | tooHighDelta :: Maybe Solution -> Int -> Int -> Bool |
295 | e4f08c46 | Iustin Pop | tooHighDelta sol new_delta max_delta = |
296 | e4f08c46 | Iustin Pop | if new_delta > max_delta && max_delta >=0 then |
297 | e4f08c46 | Iustin Pop | True |
298 | e4f08c46 | Iustin Pop | else |
299 | e4f08c46 | Iustin Pop | case sol of |
300 | e4f08c46 | Iustin Pop | Nothing -> False |
301 | e4f08c46 | Iustin Pop | Just (Solution old_delta _) -> old_delta <= new_delta |
302 | e4f08c46 | Iustin Pop | |
303 | e4f08c46 | Iustin Pop | {-| Check if placement of instances still keeps the cluster N+1 compliant. |
304 | e4f08c46 | Iustin Pop | |
305 | e4f08c46 | Iustin Pop | This is the workhorse of the allocation algorithm: given the |
306 | e4f08c46 | Iustin Pop | current node and instance maps, the list of instances to be |
307 | e4f08c46 | Iustin Pop | placed, and the current solution, this will return all possible |
308 | e4f08c46 | Iustin Pop | solution by recursing until all target instances are placed. |
309 | e4f08c46 | Iustin Pop | |
310 | e4f08c46 | Iustin Pop | -} |
311 | 262a08a2 | Iustin Pop | checkPlacement :: Node.List -- ^ The current node list |
312 | e4f08c46 | Iustin Pop | -> [Instance.Instance] -- ^ List of instances still to place |
313 | e4f08c46 | Iustin Pop | -> [Placement] -- ^ Partial solution until now |
314 | e4f08c46 | Iustin Pop | -> Int -- ^ The delta of the partial solution |
315 | e4f08c46 | Iustin Pop | -> Maybe Solution -- ^ The previous solution |
316 | e4f08c46 | Iustin Pop | -> Int -- ^ Abort if the we go above this delta |
317 | e4f08c46 | Iustin Pop | -> Maybe Solution -- ^ The new solution |
318 | e4f08c46 | Iustin Pop | checkPlacement nl victims current current_delta prev_sol max_delta = |
319 | e4f08c46 | Iustin Pop | let target = head victims |
320 | e4f08c46 | Iustin Pop | opdx = Instance.pnode target |
321 | e4f08c46 | Iustin Pop | osdx = Instance.snode target |
322 | e4f08c46 | Iustin Pop | vtail = tail victims |
323 | e4f08c46 | Iustin Pop | have_tail = (length vtail) > 0 |
324 | e4f08c46 | Iustin Pop | nodes = Container.elems nl |
325 | c5c295bc | Iustin Pop | iidx = Instance.idx target |
326 | e4f08c46 | Iustin Pop | in |
327 | e4f08c46 | Iustin Pop | foldl' |
328 | e4f08c46 | Iustin Pop | (\ accu_p pri -> |
329 | e4f08c46 | Iustin Pop | let |
330 | e4f08c46 | Iustin Pop | pri_idx = Node.idx pri |
331 | e4f08c46 | Iustin Pop | upri_delta = current_delta + nodeDelta pri_idx opdx osdx |
332 | e4f08c46 | Iustin Pop | new_pri = Node.addPri pri target |
333 | e4f08c46 | Iustin Pop | fail_delta1 = tooHighDelta accu_p upri_delta max_delta |
334 | e4f08c46 | Iustin Pop | in |
335 | e4f08c46 | Iustin Pop | if fail_delta1 || isNothing(new_pri) then accu_p |
336 | e4f08c46 | Iustin Pop | else let pri_nl = Container.add pri_idx (fromJust new_pri) nl in |
337 | e4f08c46 | Iustin Pop | foldl' |
338 | e4f08c46 | Iustin Pop | (\ accu sec -> |
339 | e4f08c46 | Iustin Pop | let |
340 | e4f08c46 | Iustin Pop | sec_idx = Node.idx sec |
341 | e4f08c46 | Iustin Pop | upd_delta = upri_delta + |
342 | e4f08c46 | Iustin Pop | nodeDelta sec_idx opdx osdx |
343 | e4f08c46 | Iustin Pop | fail_delta2 = tooHighDelta accu upd_delta max_delta |
344 | e4f08c46 | Iustin Pop | new_sec = Node.addSec sec target pri_idx |
345 | e4f08c46 | Iustin Pop | in |
346 | e4f08c46 | Iustin Pop | if sec_idx == pri_idx || fail_delta2 || |
347 | e4f08c46 | Iustin Pop | isNothing new_sec then accu |
348 | e4f08c46 | Iustin Pop | else let |
349 | e4f08c46 | Iustin Pop | nx = Container.add sec_idx (fromJust new_sec) pri_nl |
350 | c5c295bc | Iustin Pop | upd_cv = compCV nx |
351 | c5c295bc | Iustin Pop | plc = (iidx, pri_idx, sec_idx, upd_cv) |
352 | e4f08c46 | Iustin Pop | c2 = plc:current |
353 | e4f08c46 | Iustin Pop | result = |
354 | e4f08c46 | Iustin Pop | if have_tail then |
355 | e4f08c46 | Iustin Pop | checkPlacement nx vtail c2 upd_delta |
356 | e4f08c46 | Iustin Pop | accu max_delta |
357 | e4f08c46 | Iustin Pop | else |
358 | e4f08c46 | Iustin Pop | Just (Solution upd_delta c2) |
359 | e4f08c46 | Iustin Pop | in compareSolutions accu result |
360 | e4f08c46 | Iustin Pop | ) accu_p nodes |
361 | e4f08c46 | Iustin Pop | ) prev_sol nodes |
362 | e4f08c46 | Iustin Pop | |
363 | 9188aeef | Iustin Pop | {-| Auxiliary function for solution computation. |
364 | 9188aeef | Iustin Pop | |
365 | 9188aeef | Iustin Pop | We write this in an explicit recursive fashion in order to control |
366 | 9188aeef | Iustin Pop | early-abort in case we have met the min delta. We can't use foldr |
367 | 9188aeef | Iustin Pop | instead of explicit recursion since we need the accumulator for the |
368 | 9188aeef | Iustin Pop | abort decision. |
369 | 9188aeef | Iustin Pop | |
370 | 9188aeef | Iustin Pop | -} |
371 | 9188aeef | Iustin Pop | advanceSolution :: [Maybe Removal] -- ^ The removal to process |
372 | 9188aeef | Iustin Pop | -> Int -- ^ Minimum delta parameter |
373 | 9188aeef | Iustin Pop | -> Int -- ^ Maximum delta parameter |
374 | 9188aeef | Iustin Pop | -> Maybe Solution -- ^ Current best solution |
375 | 9188aeef | Iustin Pop | -> Maybe Solution -- ^ New best solution |
376 | 9188aeef | Iustin Pop | advanceSolution [] _ _ sol = sol |
377 | 9188aeef | Iustin Pop | advanceSolution (Nothing:xs) m n sol = advanceSolution xs m n sol |
378 | 9188aeef | Iustin Pop | advanceSolution ((Just (Removal nx removed)):xs) min_d max_d prev_sol = |
379 | 9188aeef | Iustin Pop | let new_sol = checkPlacement nx removed [] 0 prev_sol max_d |
380 | 9188aeef | Iustin Pop | new_delta = solutionDelta $! new_sol |
381 | 9188aeef | Iustin Pop | in |
382 | 9188aeef | Iustin Pop | if new_delta >= 0 && new_delta <= min_d then |
383 | 9188aeef | Iustin Pop | new_sol |
384 | 9188aeef | Iustin Pop | else |
385 | 9188aeef | Iustin Pop | advanceSolution xs min_d max_d new_sol |
386 | 9188aeef | Iustin Pop | |
387 | 9188aeef | Iustin Pop | -- | Computes the placement solution. |
388 | 9188aeef | Iustin Pop | solutionFromRemovals :: [Maybe Removal] -- ^ The list of (possible) removals |
389 | 9188aeef | Iustin Pop | -> Int -- ^ Minimum delta parameter |
390 | 9188aeef | Iustin Pop | -> Int -- ^ Maximum delta parameter |
391 | 9188aeef | Iustin Pop | -> Maybe Solution -- ^ The best solution found |
392 | 9188aeef | Iustin Pop | solutionFromRemovals removals min_delta max_delta = |
393 | 9188aeef | Iustin Pop | advanceSolution removals min_delta max_delta Nothing |
394 | 9188aeef | Iustin Pop | |
395 | 9188aeef | Iustin Pop | {-| Computes the solution at the given depth. |
396 | 9188aeef | Iustin Pop | |
397 | 9188aeef | Iustin Pop | This is a wrapper over both computeRemovals and |
398 | 9188aeef | Iustin Pop | solutionFromRemovals. In case we have no solution, we return Nothing. |
399 | 9188aeef | Iustin Pop | |
400 | 9188aeef | Iustin Pop | -} |
401 | 9188aeef | Iustin Pop | computeSolution :: Node.List -- ^ The original node data |
402 | 9188aeef | Iustin Pop | -> [Instance.Instance] -- ^ The list of /bad/ instances |
403 | 9188aeef | Iustin Pop | -> Int -- ^ The /depth/ of removals |
404 | 9188aeef | Iustin Pop | -> Int -- ^ Maximum number of removals to process |
405 | 9188aeef | Iustin Pop | -> Int -- ^ Minimum delta parameter |
406 | 9188aeef | Iustin Pop | -> Int -- ^ Maximum delta parameter |
407 | 9188aeef | Iustin Pop | -> Maybe Solution -- ^ The best solution found (or Nothing) |
408 | 9188aeef | Iustin Pop | computeSolution nl bad_instances depth max_removals min_delta max_delta = |
409 | 9188aeef | Iustin Pop | let |
410 | 9188aeef | Iustin Pop | removals = computeRemovals nl bad_instances depth |
411 | 9188aeef | Iustin Pop | removals' = capRemovals removals max_removals |
412 | 9188aeef | Iustin Pop | in |
413 | 9188aeef | Iustin Pop | solutionFromRemovals removals' min_delta max_delta |
414 | 9188aeef | Iustin Pop | |
415 | 9188aeef | Iustin Pop | -- * hbal functions |
416 | 9188aeef | Iustin Pop | |
417 | 9188aeef | Iustin Pop | -- | Compute best table. Note that the ordering of the arguments is important. |
418 | 9188aeef | Iustin Pop | compareTables :: Table -> Table -> Table |
419 | 9188aeef | Iustin Pop | compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) = |
420 | 9188aeef | Iustin Pop | if a_cv > b_cv then b else a |
421 | 9188aeef | Iustin Pop | |
422 | 9188aeef | Iustin Pop | -- | Applies an instance move to a given node list and instance. |
423 | 262a08a2 | Iustin Pop | applyMove :: Node.List -> Instance.Instance |
424 | 608efcce | Iustin Pop | -> IMove -> (Maybe Node.List, Instance.Instance, Ndx, Ndx) |
425 | 00b51a14 | Iustin Pop | -- Failover (f) |
426 | e4f08c46 | Iustin Pop | applyMove nl inst Failover = |
427 | e4f08c46 | Iustin Pop | let old_pdx = Instance.pnode inst |
428 | e4f08c46 | Iustin Pop | old_sdx = Instance.snode inst |
429 | e4f08c46 | Iustin Pop | old_p = Container.find old_pdx nl |
430 | e4f08c46 | Iustin Pop | old_s = Container.find old_sdx nl |
431 | e4f08c46 | Iustin Pop | int_p = Node.removePri old_p inst |
432 | e4f08c46 | Iustin Pop | int_s = Node.removeSec old_s inst |
433 | b161386d | Iustin Pop | new_nl = do -- Maybe monad |
434 | b161386d | Iustin Pop | new_p <- Node.addPri int_s inst |
435 | b161386d | Iustin Pop | new_s <- Node.addSec int_p inst old_sdx |
436 | b161386d | Iustin Pop | return $ Container.addTwo old_pdx new_s old_sdx new_p nl |
437 | e4f08c46 | Iustin Pop | in (new_nl, Instance.setBoth inst old_sdx old_pdx, old_sdx, old_pdx) |
438 | e4f08c46 | Iustin Pop | |
439 | 00b51a14 | Iustin Pop | -- Replace the primary (f:, r:np, f) |
440 | e4f08c46 | Iustin Pop | applyMove nl inst (ReplacePrimary new_pdx) = |
441 | e4f08c46 | Iustin Pop | let old_pdx = Instance.pnode inst |
442 | e4f08c46 | Iustin Pop | old_sdx = Instance.snode inst |
443 | e4f08c46 | Iustin Pop | old_p = Container.find old_pdx nl |
444 | e4f08c46 | Iustin Pop | old_s = Container.find old_sdx nl |
445 | e4f08c46 | Iustin Pop | tgt_n = Container.find new_pdx nl |
446 | e4f08c46 | Iustin Pop | int_p = Node.removePri old_p inst |
447 | e4f08c46 | Iustin Pop | int_s = Node.removeSec old_s inst |
448 | b161386d | Iustin Pop | new_nl = do -- Maybe monad |
449 | b161386d | Iustin Pop | new_p <- Node.addPri tgt_n inst |
450 | b161386d | Iustin Pop | new_s <- Node.addSec int_s inst new_pdx |
451 | b161386d | Iustin Pop | return $ Container.add new_pdx new_p $ |
452 | b161386d | Iustin Pop | Container.addTwo old_pdx int_p old_sdx new_s nl |
453 | e4f08c46 | Iustin Pop | in (new_nl, Instance.setPri inst new_pdx, new_pdx, old_sdx) |
454 | e4f08c46 | Iustin Pop | |
455 | 00b51a14 | Iustin Pop | -- Replace the secondary (r:ns) |
456 | e4f08c46 | Iustin Pop | applyMove nl inst (ReplaceSecondary new_sdx) = |
457 | e4f08c46 | Iustin Pop | let old_pdx = Instance.pnode inst |
458 | e4f08c46 | Iustin Pop | old_sdx = Instance.snode inst |
459 | e4f08c46 | Iustin Pop | old_s = Container.find old_sdx nl |
460 | e4f08c46 | Iustin Pop | tgt_n = Container.find new_sdx nl |
461 | e4f08c46 | Iustin Pop | int_s = Node.removeSec old_s inst |
462 | b161386d | Iustin Pop | new_nl = Node.addSec tgt_n inst old_pdx >>= |
463 | b161386d | Iustin Pop | \new_s -> return $ Container.addTwo new_sdx |
464 | b161386d | Iustin Pop | new_s old_sdx int_s nl |
465 | e4f08c46 | Iustin Pop | in (new_nl, Instance.setSec inst new_sdx, old_pdx, new_sdx) |
466 | e4f08c46 | Iustin Pop | |
467 | 00b51a14 | Iustin Pop | -- Replace the secondary and failover (r:np, f) |
468 | 79ac6b6f | Iustin Pop | applyMove nl inst (ReplaceAndFailover new_pdx) = |
469 | 79ac6b6f | Iustin Pop | let old_pdx = Instance.pnode inst |
470 | 79ac6b6f | Iustin Pop | old_sdx = Instance.snode inst |
471 | 79ac6b6f | Iustin Pop | old_p = Container.find old_pdx nl |
472 | 79ac6b6f | Iustin Pop | old_s = Container.find old_sdx nl |
473 | 79ac6b6f | Iustin Pop | tgt_n = Container.find new_pdx nl |
474 | 79ac6b6f | Iustin Pop | int_p = Node.removePri old_p inst |
475 | 79ac6b6f | Iustin Pop | int_s = Node.removeSec old_s inst |
476 | b161386d | Iustin Pop | new_nl = do -- Maybe monad |
477 | b161386d | Iustin Pop | new_p <- Node.addPri tgt_n inst |
478 | b161386d | Iustin Pop | new_s <- Node.addSec int_p inst new_pdx |
479 | b161386d | Iustin Pop | return $ Container.add new_pdx new_p $ |
480 | b161386d | Iustin Pop | Container.addTwo old_pdx new_s old_sdx int_s nl |
481 | 79ac6b6f | Iustin Pop | in (new_nl, Instance.setBoth inst new_pdx old_pdx, new_pdx, old_pdx) |
482 | 79ac6b6f | Iustin Pop | |
483 | 19493d33 | Iustin Pop | -- Failver and replace the secondary (f, r:ns) |
484 | 19493d33 | Iustin Pop | applyMove nl inst (FailoverAndReplace new_sdx) = |
485 | 19493d33 | Iustin Pop | let old_pdx = Instance.pnode inst |
486 | 19493d33 | Iustin Pop | old_sdx = Instance.snode inst |
487 | 19493d33 | Iustin Pop | old_p = Container.find old_pdx nl |
488 | 19493d33 | Iustin Pop | old_s = Container.find old_sdx nl |
489 | 19493d33 | Iustin Pop | tgt_n = Container.find new_sdx nl |
490 | 19493d33 | Iustin Pop | int_p = Node.removePri old_p inst |
491 | 19493d33 | Iustin Pop | int_s = Node.removeSec old_s inst |
492 | b161386d | Iustin Pop | new_nl = do -- Maybe monad |
493 | b161386d | Iustin Pop | new_p <- Node.addPri int_s inst |
494 | b161386d | Iustin Pop | new_s <- Node.addSec tgt_n inst old_sdx |
495 | b161386d | Iustin Pop | return $ Container.add new_sdx new_s $ |
496 | b161386d | Iustin Pop | Container.addTwo old_sdx new_p old_pdx int_p nl |
497 | 19493d33 | Iustin Pop | in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx) |
498 | 19493d33 | Iustin Pop | |
499 | 9188aeef | Iustin Pop | -- | Tries to allocate an instance on one given node. |
500 | 262a08a2 | Iustin Pop | allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node |
501 | 262a08a2 | Iustin Pop | -> (Maybe Node.List, Instance.Instance) |
502 | 5e15f460 | Iustin Pop | allocateOnSingle nl inst p = |
503 | 5e15f460 | Iustin Pop | let new_pdx = Node.idx p |
504 | 5e15f460 | Iustin Pop | new_nl = Node.addPri p inst >>= \new_p -> |
505 | 5e15f460 | Iustin Pop | return $ Container.add new_pdx new_p nl |
506 | 5e15f460 | Iustin Pop | in (new_nl, Instance.setBoth inst new_pdx Node.noSecondary) |
507 | 5e15f460 | Iustin Pop | |
508 | 9188aeef | Iustin Pop | -- | Tries to allocate an instance on a given pair of nodes. |
509 | 262a08a2 | Iustin Pop | allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node |
510 | 262a08a2 | Iustin Pop | -> (Maybe Node.List, Instance.Instance) |
511 | 5e15f460 | Iustin Pop | allocateOnPair nl inst tgt_p tgt_s = |
512 | 5e15f460 | Iustin Pop | let new_pdx = Node.idx tgt_p |
513 | 5e15f460 | Iustin Pop | new_sdx = Node.idx tgt_s |
514 | 4a340313 | Iustin Pop | new_nl = do -- Maybe monad |
515 | 4a340313 | Iustin Pop | new_p <- Node.addPri tgt_p inst |
516 | 4a340313 | Iustin Pop | new_s <- Node.addSec tgt_s inst new_pdx |
517 | 4a340313 | Iustin Pop | return $ Container.addTwo new_pdx new_p new_sdx new_s nl |
518 | 4a340313 | Iustin Pop | in (new_nl, Instance.setBoth inst new_pdx new_sdx) |
519 | 4a340313 | Iustin Pop | |
520 | 9188aeef | Iustin Pop | -- | Tries to perform an instance move and returns the best table |
521 | 9188aeef | Iustin Pop | -- between the original one and the new one. |
522 | e4f08c46 | Iustin Pop | checkSingleStep :: Table -- ^ The original table |
523 | e4f08c46 | Iustin Pop | -> Instance.Instance -- ^ The instance to move |
524 | e4f08c46 | Iustin Pop | -> Table -- ^ The current best table |
525 | e4f08c46 | Iustin Pop | -> IMove -- ^ The move to apply |
526 | e4f08c46 | Iustin Pop | -> Table -- ^ The final best table |
527 | e4f08c46 | Iustin Pop | checkSingleStep ini_tbl target cur_tbl move = |
528 | e4f08c46 | Iustin Pop | let |
529 | e4f08c46 | Iustin Pop | Table ini_nl ini_il _ ini_plc = ini_tbl |
530 | 0a0f2533 | Iustin Pop | (tmp_nl, new_inst, pri_idx, sec_idx) = applyMove ini_nl target move |
531 | e4f08c46 | Iustin Pop | in |
532 | e4f08c46 | Iustin Pop | if isNothing tmp_nl then cur_tbl |
533 | e4f08c46 | Iustin Pop | else |
534 | e4f08c46 | Iustin Pop | let tgt_idx = Instance.idx target |
535 | e4f08c46 | Iustin Pop | upd_nl = fromJust tmp_nl |
536 | e4f08c46 | Iustin Pop | upd_cvar = compCV upd_nl |
537 | e4f08c46 | Iustin Pop | upd_il = Container.add tgt_idx new_inst ini_il |
538 | 0a0f2533 | Iustin Pop | upd_plc = (tgt_idx, pri_idx, sec_idx, upd_cvar):ini_plc |
539 | e4f08c46 | Iustin Pop | upd_tbl = Table upd_nl upd_il upd_cvar upd_plc |
540 | e4f08c46 | Iustin Pop | in |
541 | e4f08c46 | Iustin Pop | compareTables cur_tbl upd_tbl |
542 | e4f08c46 | Iustin Pop | |
543 | 40d4eba0 | Iustin Pop | -- | Given the status of the current secondary as a valid new node |
544 | 40d4eba0 | Iustin Pop | -- and the current candidate target node, |
545 | 40d4eba0 | Iustin Pop | -- generate the possible moves for a instance. |
546 | 608efcce | Iustin Pop | possibleMoves :: Bool -> Ndx -> [IMove] |
547 | 40d4eba0 | Iustin Pop | possibleMoves True tdx = |
548 | 40d4eba0 | Iustin Pop | [ReplaceSecondary tdx, |
549 | 40d4eba0 | Iustin Pop | ReplaceAndFailover tdx, |
550 | 40d4eba0 | Iustin Pop | ReplacePrimary tdx, |
551 | 40d4eba0 | Iustin Pop | FailoverAndReplace tdx] |
552 | 40d4eba0 | Iustin Pop | |
553 | 40d4eba0 | Iustin Pop | possibleMoves False tdx = |
554 | 40d4eba0 | Iustin Pop | [ReplaceSecondary tdx, |
555 | 40d4eba0 | Iustin Pop | ReplaceAndFailover tdx] |
556 | 40d4eba0 | Iustin Pop | |
557 | 40d4eba0 | Iustin Pop | -- | Compute the best move for a given instance. |
558 | 608efcce | Iustin Pop | checkInstanceMove :: [Ndx] -- Allowed target node indices |
559 | 256810de | Iustin Pop | -> Table -- Original table |
560 | 256810de | Iustin Pop | -> Instance.Instance -- Instance to move |
561 | 256810de | Iustin Pop | -> Table -- Best new table for this instance |
562 | 256810de | Iustin Pop | checkInstanceMove nodes_idx ini_tbl target = |
563 | 4e25d1c2 | Iustin Pop | let |
564 | 4e25d1c2 | Iustin Pop | opdx = Instance.pnode target |
565 | 4e25d1c2 | Iustin Pop | osdx = Instance.snode target |
566 | 9dc6023f | Iustin Pop | nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx |
567 | 40d4eba0 | Iustin Pop | use_secondary = elem osdx nodes_idx |
568 | 40d4eba0 | Iustin Pop | aft_failover = if use_secondary -- if allowed to failover |
569 | 40d4eba0 | Iustin Pop | then checkSingleStep ini_tbl target ini_tbl Failover |
570 | 40d4eba0 | Iustin Pop | else ini_tbl |
571 | 40d4eba0 | Iustin Pop | all_moves = concatMap (possibleMoves use_secondary) nodes |
572 | 4e25d1c2 | Iustin Pop | in |
573 | 4e25d1c2 | Iustin Pop | -- iterate over the possible nodes for this instance |
574 | 9dc6023f | Iustin Pop | foldl' (checkSingleStep ini_tbl target) aft_failover all_moves |
575 | 4e25d1c2 | Iustin Pop | |
576 | e4f08c46 | Iustin Pop | -- | Compute the best next move. |
577 | 608efcce | Iustin Pop | checkMove :: [Ndx] -- ^ Allowed target node indices |
578 | 256810de | Iustin Pop | -> Table -- ^ The current solution |
579 | e4f08c46 | Iustin Pop | -> [Instance.Instance] -- ^ List of instances still to move |
580 | 256810de | Iustin Pop | -> Table -- ^ The new solution |
581 | 256810de | Iustin Pop | checkMove nodes_idx ini_tbl victims = |
582 | 4e25d1c2 | Iustin Pop | let Table _ _ _ ini_plc = ini_tbl |
583 | 4e25d1c2 | Iustin Pop | -- iterate over all instances, computing the best move |
584 | 256810de | Iustin Pop | best_tbl = |
585 | 256810de | Iustin Pop | foldl' |
586 | 7e7f6ca2 | Iustin Pop | (\ step_tbl elem -> |
587 | 040afc35 | Iustin Pop | if Instance.snode elem == Node.noSecondary then step_tbl |
588 | 7e7f6ca2 | Iustin Pop | else compareTables step_tbl $ |
589 | 7e7f6ca2 | Iustin Pop | checkInstanceMove nodes_idx ini_tbl elem) |
590 | 256810de | Iustin Pop | ini_tbl victims |
591 | aaaa0e43 | Iustin Pop | Table _ _ _ best_plc = best_tbl |
592 | 0a0f2533 | Iustin Pop | in |
593 | 0a0f2533 | Iustin Pop | if length best_plc == length ini_plc then -- no advancement |
594 | 0a0f2533 | Iustin Pop | ini_tbl |
595 | 0a0f2533 | Iustin Pop | else |
596 | 7dfaafb1 | Iustin Pop | best_tbl |
597 | e4f08c46 | Iustin Pop | |
598 | dbba5246 | Iustin Pop | -- * Alocation functions |
599 | dbba5246 | Iustin Pop | |
600 | dbba5246 | Iustin Pop | -- | Try to allocate an instance on the cluster. |
601 | dbba5246 | Iustin Pop | tryAlloc :: (Monad m) => |
602 | dbba5246 | Iustin Pop | Node.List -- ^ The node list |
603 | dbba5246 | Iustin Pop | -> Instance.List -- ^ The instance list |
604 | dbba5246 | Iustin Pop | -> Instance.Instance -- ^ The instance to allocate |
605 | dbba5246 | Iustin Pop | -> Int -- ^ Required number of nodes |
606 | dbba5246 | Iustin Pop | -> m [(Maybe Node.List, [Node.Node])] -- ^ Possible solution list |
607 | dbba5246 | Iustin Pop | tryAlloc nl _ inst 2 = |
608 | dbba5246 | Iustin Pop | let all_nodes = getOnline nl |
609 | dbba5246 | Iustin Pop | all_pairs = liftM2 (,) all_nodes all_nodes |
610 | dbba5246 | Iustin Pop | ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs |
611 | dbba5246 | Iustin Pop | sols = map (\(p, s) -> |
612 | dbba5246 | Iustin Pop | (fst $ allocateOnPair nl inst p s, [p, s])) |
613 | dbba5246 | Iustin Pop | ok_pairs |
614 | dbba5246 | Iustin Pop | in return sols |
615 | dbba5246 | Iustin Pop | |
616 | dbba5246 | Iustin Pop | tryAlloc nl _ inst 1 = |
617 | dbba5246 | Iustin Pop | let all_nodes = getOnline nl |
618 | dbba5246 | Iustin Pop | sols = map (\p -> (fst $ allocateOnSingle nl inst p, [p])) |
619 | dbba5246 | Iustin Pop | all_nodes |
620 | dbba5246 | Iustin Pop | in return sols |
621 | dbba5246 | Iustin Pop | |
622 | dbba5246 | Iustin Pop | tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \ |
623 | dbba5246 | Iustin Pop | \destinations required (" ++ (show reqn) ++ |
624 | dbba5246 | Iustin Pop | "), only two supported" |
625 | dbba5246 | Iustin Pop | |
626 | dbba5246 | Iustin Pop | -- | Try to allocate an instance on the cluster. |
627 | dbba5246 | Iustin Pop | tryReloc :: (Monad m) => |
628 | dbba5246 | Iustin Pop | Node.List -- ^ The node list |
629 | dbba5246 | Iustin Pop | -> Instance.List -- ^ The instance list |
630 | dbba5246 | Iustin Pop | -> Idx -- ^ The index of the instance to move |
631 | dbba5246 | Iustin Pop | -> Int -- ^ The numver of nodes required |
632 | dbba5246 | Iustin Pop | -> [Ndx] -- ^ Nodes which should not be used |
633 | dbba5246 | Iustin Pop | -> m [(Maybe Node.List, [Node.Node])] -- ^ Solution list |
634 | dbba5246 | Iustin Pop | tryReloc nl il xid 1 ex_idx = |
635 | dbba5246 | Iustin Pop | let all_nodes = getOnline nl |
636 | dbba5246 | Iustin Pop | inst = Container.find xid il |
637 | dbba5246 | Iustin Pop | ex_idx' = (Instance.pnode inst):ex_idx |
638 | dbba5246 | Iustin Pop | valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes |
639 | dbba5246 | Iustin Pop | valid_idxes = map Node.idx valid_nodes |
640 | dbba5246 | Iustin Pop | sols1 = map (\x -> let (mnl, _, _, _) = |
641 | dbba5246 | Iustin Pop | applyMove nl inst (ReplaceSecondary x) |
642 | dbba5246 | Iustin Pop | in (mnl, [Container.find x nl]) |
643 | dbba5246 | Iustin Pop | ) valid_idxes |
644 | dbba5246 | Iustin Pop | in return sols1 |
645 | dbba5246 | Iustin Pop | |
646 | dbba5246 | Iustin Pop | tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \ |
647 | dbba5246 | Iustin Pop | \destinations required (" ++ (show reqn) ++ |
648 | dbba5246 | Iustin Pop | "), only one supported" |
649 | e4f08c46 | Iustin Pop | |
650 | 9188aeef | Iustin Pop | -- * Formatting functions |
651 | e4f08c46 | Iustin Pop | |
652 | e4f08c46 | Iustin Pop | -- | Given the original and final nodes, computes the relocation description. |
653 | e4f08c46 | Iustin Pop | computeMoves :: String -- ^ The instance name |
654 | e4f08c46 | Iustin Pop | -> String -- ^ Original primary |
655 | e4f08c46 | Iustin Pop | -> String -- ^ Original secondary |
656 | e4f08c46 | Iustin Pop | -> String -- ^ New primary |
657 | e4f08c46 | Iustin Pop | -> String -- ^ New secondary |
658 | e4f08c46 | Iustin Pop | -> (String, [String]) |
659 | e4f08c46 | Iustin Pop | -- ^ Tuple of moves and commands list; moves is containing |
660 | e4f08c46 | Iustin Pop | -- either @/f/@ for failover or @/r:name/@ for replace |
661 | e4f08c46 | Iustin Pop | -- secondary, while the command list holds gnt-instance |
662 | e4f08c46 | Iustin Pop | -- commands (without that prefix), e.g \"@failover instance1@\" |
663 | e4f08c46 | Iustin Pop | computeMoves i a b c d = |
664 | e4f08c46 | Iustin Pop | if c == a then {- Same primary -} |
665 | e4f08c46 | Iustin Pop | if d == b then {- Same sec??! -} |
666 | e4f08c46 | Iustin Pop | ("-", []) |
667 | e4f08c46 | Iustin Pop | else {- Change of secondary -} |
668 | e4f08c46 | Iustin Pop | (printf "r:%s" d, |
669 | e4f08c46 | Iustin Pop | [printf "replace-disks -n %s %s" d i]) |
670 | e4f08c46 | Iustin Pop | else |
671 | e4f08c46 | Iustin Pop | if c == b then {- Failover and ... -} |
672 | e4f08c46 | Iustin Pop | if d == a then {- that's all -} |
673 | e0eb63f0 | Iustin Pop | ("f", [printf "migrate -f %s" i]) |
674 | e4f08c46 | Iustin Pop | else |
675 | e4f08c46 | Iustin Pop | (printf "f r:%s" d, |
676 | e0eb63f0 | Iustin Pop | [printf "migrate -f %s" i, |
677 | e4f08c46 | Iustin Pop | printf "replace-disks -n %s %s" d i]) |
678 | e4f08c46 | Iustin Pop | else |
679 | e4f08c46 | Iustin Pop | if d == a then {- ... and keep primary as secondary -} |
680 | e4f08c46 | Iustin Pop | (printf "r:%s f" c, |
681 | e4f08c46 | Iustin Pop | [printf "replace-disks -n %s %s" c i, |
682 | e0eb63f0 | Iustin Pop | printf "migrate -f %s" i]) |
683 | e4f08c46 | Iustin Pop | else |
684 | e4f08c46 | Iustin Pop | if d == b then {- ... keep same secondary -} |
685 | e4f08c46 | Iustin Pop | (printf "f r:%s f" c, |
686 | e0eb63f0 | Iustin Pop | [printf "migrate -f %s" i, |
687 | e4f08c46 | Iustin Pop | printf "replace-disks -n %s %s" c i, |
688 | e0eb63f0 | Iustin Pop | printf "migrate -f %s" i]) |
689 | e4f08c46 | Iustin Pop | |
690 | e4f08c46 | Iustin Pop | else {- Nothing in common -} |
691 | e4f08c46 | Iustin Pop | (printf "r:%s f r:%s" c d, |
692 | e4f08c46 | Iustin Pop | [printf "replace-disks -n %s %s" c i, |
693 | e0eb63f0 | Iustin Pop | printf "migrate -f %s" i, |
694 | e4f08c46 | Iustin Pop | printf "replace-disks -n %s %s" d i]) |
695 | e4f08c46 | Iustin Pop | |
696 | 9188aeef | Iustin Pop | -- | Converts a placement to string format. |
697 | 9188aeef | Iustin Pop | printSolutionLine :: Node.List -- ^ The node list |
698 | 9188aeef | Iustin Pop | -> Instance.List -- ^ The instance list |
699 | 9188aeef | Iustin Pop | -> Int -- ^ Maximum node name length |
700 | 9188aeef | Iustin Pop | -> Int -- ^ Maximum instance name length |
701 | 9188aeef | Iustin Pop | -> Placement -- ^ The current placement |
702 | 9188aeef | Iustin Pop | -> Int -- ^ The index of the placement in |
703 | 9188aeef | Iustin Pop | -- the solution |
704 | db1bcfe8 | Iustin Pop | -> (String, [String]) |
705 | db1bcfe8 | Iustin Pop | printSolutionLine nl il nmlen imlen plc pos = |
706 | ca8258d9 | Iustin Pop | let |
707 | ca8258d9 | Iustin Pop | pmlen = (2*nmlen + 1) |
708 | ca8258d9 | Iustin Pop | (i, p, s, c) = plc |
709 | ca8258d9 | Iustin Pop | inst = Container.find i il |
710 | dbd6700b | Iustin Pop | inam = Instance.name inst |
711 | 262a08a2 | Iustin Pop | npri = Container.nameOf nl p |
712 | 262a08a2 | Iustin Pop | nsec = Container.nameOf nl s |
713 | 262a08a2 | Iustin Pop | opri = Container.nameOf nl $ Instance.pnode inst |
714 | 262a08a2 | Iustin Pop | osec = Container.nameOf nl $ Instance.snode inst |
715 | ca8258d9 | Iustin Pop | (moves, cmds) = computeMoves inam opri osec npri nsec |
716 | ca8258d9 | Iustin Pop | ostr = (printf "%s:%s" opri osec)::String |
717 | ca8258d9 | Iustin Pop | nstr = (printf "%s:%s" npri nsec)::String |
718 | ca8258d9 | Iustin Pop | in |
719 | ab271fc1 | Iustin Pop | (printf " %3d. %-*s %-*s => %-*s %.8f a=%s" |
720 | ab271fc1 | Iustin Pop | pos imlen inam pmlen ostr |
721 | ca8258d9 | Iustin Pop | pmlen nstr c moves, |
722 | ca8258d9 | Iustin Pop | cmds) |
723 | ca8258d9 | Iustin Pop | |
724 | 9188aeef | Iustin Pop | -- | Given a list of commands, prefix them with @gnt-instance@ and |
725 | 9188aeef | Iustin Pop | -- also beautify the display a little. |
726 | 142538ff | Iustin Pop | formatCmds :: [[String]] -> String |
727 | 142538ff | Iustin Pop | formatCmds cmd_strs = |
728 | e0eb63f0 | Iustin Pop | unlines $ |
729 | 142538ff | Iustin Pop | concat $ map (\(a, b) -> |
730 | e0eb63f0 | Iustin Pop | (printf "echo step %d" (a::Int)): |
731 | e0eb63f0 | Iustin Pop | (printf "check"): |
732 | e0eb63f0 | Iustin Pop | (map ("gnt-instance " ++) b)) $ |
733 | 142538ff | Iustin Pop | zip [1..] cmd_strs |
734 | 142538ff | Iustin Pop | |
735 | 9188aeef | Iustin Pop | -- | Converts a solution to string format. |
736 | 262a08a2 | Iustin Pop | printSolution :: Node.List |
737 | 262a08a2 | Iustin Pop | -> Instance.List |
738 | e4f08c46 | Iustin Pop | -> [Placement] |
739 | e4f08c46 | Iustin Pop | -> ([String], [[String]]) |
740 | db1bcfe8 | Iustin Pop | printSolution nl il sol = |
741 | 671b85b9 | Iustin Pop | let |
742 | 262a08a2 | Iustin Pop | nmlen = Container.maxNameLen nl |
743 | 262a08a2 | Iustin Pop | imlen = Container.maxNameLen il |
744 | 671b85b9 | Iustin Pop | in |
745 | db1bcfe8 | Iustin Pop | unzip $ map (uncurry $ printSolutionLine nl il nmlen imlen) $ |
746 | ab271fc1 | Iustin Pop | zip sol [1..] |
747 | e4f08c46 | Iustin Pop | |
748 | e4f08c46 | Iustin Pop | -- | Print the node list. |
749 | 262a08a2 | Iustin Pop | printNodes :: Node.List -> String |
750 | dbd6700b | Iustin Pop | printNodes nl = |
751 | e4f08c46 | Iustin Pop | let snl = sortBy (compare `on` Node.idx) (Container.elems nl) |
752 | dbd6700b | Iustin Pop | m_name = maximum . map (length . Node.name) $ snl |
753 | af53a5c4 | Iustin Pop | helper = Node.list m_name |
754 | a1c6212e | Iustin Pop | header = printf |
755 | a1c6212e | Iustin Pop | "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s" |
756 | a1c6212e | Iustin Pop | " F" m_name "Name" |
757 | a1c6212e | Iustin Pop | "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem" |
758 | ced859f3 | Iustin Pop | "t_dsk" "f_dsk" |
759 | ced859f3 | Iustin Pop | "pri" "sec" "p_fmem" "p_fdsk" |
760 | dbd6700b | Iustin Pop | in unlines $ (header:map helper snl) |
761 | e4f08c46 | Iustin Pop | |
762 | 9188aeef | Iustin Pop | -- | Shows statistics for a given node list. |
763 | 262a08a2 | Iustin Pop | printStats :: Node.List -> String |
764 | e4f08c46 | Iustin Pop | printStats nl = |
765 | 19777638 | Iustin Pop | let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl |
766 | 19777638 | Iustin Pop | in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f" |
767 | 19777638 | Iustin Pop | mem_cv res_cv dsk_cv n1_score off_score |