Synnefo » snf-ganeti

import qualified Data.IntSet as IntSet

import Data.List

import Data.Ord (comparing)

import Text.Printf (printf)

import Control.Monad

-- | Allocation\/relocation solution.

data AllocSolution = AllocSolution

  }

-- | Node evacuation/group change iallocator result type. This result

-- | The empty solution we start with when computing allocations.

emptyAllocSolution :: AllocSolution

emptyAllocSolution = AllocSolution { asFailures = [], asAllocs = 0

-- | The empty evac solution.

emptyEvacSolution :: EvacSolution

concatAllocs as (OpGood ns@(_, _, _, nscore)) =

    let -- Choose the old or new solution, based on the cluster score

        cntok = asAllocs as

        nsols = case osols of

                      if oscore < nscore

                      then osols

        nsuc = cntok + 1

    -- Note: we force evaluation of nsols here in order to keep the

    -- memory profile low - we know that we will need nsols for sure

    -- in the next cycle, so we force evaluation of nsols, since the

    -- foldl' in the caller will only evaluate the tuple, but not the

    -- elements of the tuple

-- | Given a solution, generates a reasonable description for it.

describeSolution :: AllocSolution -> String

describeSolution as =

  let fcnt = asFailures as

      freasons =

        intercalate ", " . map (\(a, b) -> printf "%s: %d" (show a) b) .

        filter ((> 0) . snd) . collapseFailures $ fcnt

-- | Annotates a solution with the appropriate string.

annotateSolution :: AllocSolution -> AllocSolution

          fn accu (gdx, rasol) =

              case rasol of

                Bad _ -> accu

                       | unallocable gdx -> accu

                       | otherwise -> (gdx, sol):accu

sortMGResults gl sols =

    let extractScore (_, _, _, x) = x

        solScore (gdx, sol) = (Group.allocPolicy (Container.find gdx gl),

    in sortBy (comparing solScore) sols

-- | Finds the best group for an instance on a multi-group cluster.

          newlimit = fmap (flip (-) 1) limit

      in case tryAlloc nl il newi2 allocnodes of

           Bad s -> Bad s

               let newsol = Ok (collapseFailures errs, nl, il, ixes, cstats) in

               case sols3 of

                     if limit == Just 0

                     then newsol

                     else iterateAlloc xnl (Container.add newidx xi il)

                          newlimit newinst allocnodes (xi:ixes)

                          (totalResources xnl:cstats)

-- | The core of the tiered allocation mode.

tieredAlloc :: Node.List

formatAllocate :: Instance.List -> Cluster.AllocSolution -> Result IAllocResult

formatAllocate il as = do

  let info = describeSolution as

        do

          let il' = Container.add (Instance.idx inst) inst il

          return (info, showJSON $ map Node.name nodes, nl, il')

-- | Convert a node-evacuation/change group result.

formatNodeEvac :: Group.List

       Cluster.tryAlloc nl il inst' of

         Types.Bad _ -> False

         Types.Ok as ->

                   let il' = Container.add (Instance.idx xi) xi il

                       tbl = Cluster.Table xnl il' cv []

                   in not (canBalance tbl True True False)

-- | Checks that on a 2-5 node cluster, we can allocate a random

-- instance spec via tiered allocation (whatever the original instance

       Cluster.tryAlloc nl il inst' of

         Types.Bad _ -> False

         Types.Ok as ->

                   let sdx = Instance.sNode xi

                       il' = Container.add (Instance.idx xi) xi il

                   in case IAlloc.processRelocate defGroupList xnl il'

                          (Instance.idx xi) 1 [sdx] of

                        Types.Ok _ -> True

                        _ -> False

-- | Check that allocating multiple instances on a cluster, then

-- adding an empty node, results in a valid rebalance.