Synnefo » snf-ganeti

-- * Types

-- | A separate name for the cluster score type.

-- | A cluster solution described as the solution delta and the list

-- of placements.

-- * Utility functions

-- | Returns the delta of a solution or -1 for Nothing.

solutionDelta :: Maybe Solution -> Int

solutionDelta sol = case sol of

                      Just (Solution d _) -> d

                      _ -> -1

{-| Computes the pair of bad nodes and instances.

The bad node list is computed via a simple 'verifyN1' check, and the

bad instance list is the list of primary and secondary instances of

those nodes.

-}

computeBadItems :: Node.List -> Instance.List ->

                   ([Node.Node], [Instance.Instance])

computeBadItems nl il =

  let bad_nodes = verifyN1 $ filter (not . Node.offline) $ Container.elems nl

      bad_instances = map (\idx -> Container.find idx il) $

                      sort $ nub $ concat $

                      map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes

  in

    (bad_nodes, bad_instances)

-- | Compute the total free disk and memory in the cluster.

totalResources :: Container.Container Node.Node -> (Int, Int)

totalResources nl =

    foldl'

    (\ (mem, dsk) node -> (mem + (Node.f_mem node),

                           dsk + (Node.f_dsk node)))

    (0, 0) (Container.elems nl)

-- | Compute the mem and disk covariance.

compDetailedCV :: Node.List -> (Double, Double, Double, Double, Double)

compDetailedCV nl =

    let

        all_nodes = Container.elems nl

        (offline, nodes) = partition Node.offline all_nodes

        mem_l = map Node.p_mem nodes

        dsk_l = map Node.p_dsk nodes

        mem_cv = varianceCoeff mem_l

        dsk_cv = varianceCoeff dsk_l

        n1_l = length $ filter Node.failN1 nodes

        n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes)

        res_l = map Node.p_rem nodes

        res_cv = varianceCoeff res_l

        offline_inst = sum . map (\n -> (length . Node.plist $ n) +

                                        (length . Node.slist $ n)) $ offline

        online_inst = sum . map (\n -> (length . Node.plist $ n) +

                                       (length . Node.slist $ n)) $ nodes

        off_score = (fromIntegral offline_inst) /

                    (fromIntegral $ online_inst + offline_inst)

    in (mem_cv, dsk_cv, n1_score, res_cv, off_score)

-- | Compute the /total/ variance.

compCV :: Node.List -> Double

compCV nl =

    let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl

    in mem_cv + dsk_cv + n1_score + res_cv + off_score

-- * hn1 functions

-- | Add an instance and return the new node and instance maps.

{-| Compute a new version of a cluster given a solution.

-- ** First phase functions

{-| Given a list 1,2,3..n build a list of pairs [(1, [2..n]), (2,

{-| Checks if removal of instances results in N+1 pass.

-- | Computes the removals list for a given depth.

-- ** Second phase functions

-- | Single-node relocation cost.

-- | Compute best solution.

--

-- This function compares two solutions, choosing the minimum valid

-- solution.

{-| Auxiliary function for solution computation.

We write this in an explicit recursive fashion in order to control

early-abort in case we have met the min delta. We can't use foldr

instead of explicit recursion since we need the accumulator for the

abort decision.

-}

advanceSolution :: [Maybe Removal] -- ^ The removal to process

                -> Int             -- ^ Minimum delta parameter

                -> Int             -- ^ Maximum delta parameter

                -> Maybe Solution  -- ^ Current best solution

                -> Maybe Solution  -- ^ New best solution

advanceSolution [] _ _ sol = sol

advanceSolution (Nothing:xs) m n sol = advanceSolution xs m n sol

advanceSolution ((Just (Removal nx removed)):xs) min_d max_d prev_sol =

    let new_sol = checkPlacement nx removed [] 0 prev_sol max_d

        new_delta = solutionDelta $! new_sol

    in

      if new_delta >= 0 && new_delta <= min_d then

          new_sol

      else

          advanceSolution xs min_d max_d new_sol

-- | Computes the placement solution.

solutionFromRemovals :: [Maybe Removal] -- ^ The list of (possible) removals

                     -> Int             -- ^ Minimum delta parameter

                     -> Int             -- ^ Maximum delta parameter

                     -> Maybe Solution  -- ^ The best solution found

solutionFromRemovals removals min_delta max_delta =

    advanceSolution removals min_delta max_delta Nothing

{-| Computes the solution at the given depth.

This is a wrapper over both computeRemovals and

solutionFromRemovals. In case we have no solution, we return Nothing.

-}

computeSolution :: Node.List        -- ^ The original node data

                -> [Instance.Instance] -- ^ The list of /bad/ instances

                -> Int             -- ^ The /depth/ of removals

                -> Int             -- ^ Maximum number of removals to process

                -> Int             -- ^ Minimum delta parameter

                -> Int             -- ^ Maximum delta parameter

                -> Maybe Solution  -- ^ The best solution found (or Nothing)

computeSolution nl bad_instances depth max_removals min_delta max_delta =

  let

      removals = computeRemovals nl bad_instances depth

      removals' = capRemovals removals max_removals

  in

    solutionFromRemovals removals' min_delta max_delta

-- * hbal functions

-- | Compute best table. Note that the ordering of the arguments is important.

compareTables :: Table -> Table -> Table

compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =

    if a_cv > b_cv then b else a

-- | Applies an instance move to a given node list and instance.

-- | Tries to allocate an instance on one given node.

-- | Tries to allocate an instance on a given pair of nodes.

-- | Tries to perform an instance move and returns the best table

-- between the original one and the new one.

-- * Formatting functions

-- | Converts a placement to string format.

printSolutionLine :: Node.List     -- ^ The node list

                  -> Instance.List -- ^ The instance list

                  -> Int           -- ^ Maximum node name length

                  -> Int           -- ^ Maximum instance name length

                  -> Placement     -- ^ The current placement

                  -> Int           -- ^ The index of the placement in

                                   -- the solution

-- | Given a list of commands, prefix them with @gnt-instance@ and

-- also beautify the display a little.

-- | Converts a solution to string format.

-- | Shows statistics for a given node list.