<commit_before>{-| Implementation of cluster-wide logic.

This module holds all pure cluster-logic; I\/O related functionality
goes into the "Main" module for the individual binaries.

-}

{-

Copyright (C) 2009 Google Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

module Ganeti.HTools.Cluster
    (
     -- * Types
      Placement
    , AllocSolution
    , Table(..)
    , Score
    , IMove(..)
    , CStats(..)
    -- * Generic functions
    , totalResources
    -- * First phase functions
    , computeBadItems
    -- * Second phase functions
    , printSolution
    , printSolutionLine
    , formatCmds
    , printNodes
    -- * Balacing functions
    , applyMove
    , checkMove
    , compCV
    , printStats
    -- * IAllocator functions
    , allocateOnSingle
    , allocateOnPair
    , tryAlloc
    , tryReloc
    ) where

import Data.List
import Text.Printf (printf)
import Data.Function
import Control.Monad

import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
import Ganeti.HTools.Types
import Ganeti.HTools.Utils

-- * Types

-- | A separate name for the cluster score type.
type Score = Double

-- | The description of an instance placement.
type Placement = (Idx, Ndx, Ndx, Score)

-- | Allocation\/relocation solution.
type AllocSolution = [(OpResult Node.List, Instance.Instance, [Node.Node])]

-- | An instance move definition
data IMove = Failover                -- ^ Failover the instance (f)
           | ReplacePrimary Ndx      -- ^ Replace primary (f, r:np, f)
           | ReplaceSecondary Ndx    -- ^ Replace secondary (r:ns)
           | ReplaceAndFailover Ndx  -- ^ Replace secondary, failover (r:np, f)
           | FailoverAndReplace Ndx  -- ^ Failover, replace secondary (f, r:ns)
             deriving (Show)

-- | The complete state for the balancing solution
data Table = Table Node.List Instance.List Score [Placement]
             deriving (Show)

data CStats = CStats { cs_fmem :: Int -- ^ Cluster free mem
                     , cs_fdsk :: Int -- ^ Cluster free disk
                     , cs_amem :: Int -- ^ Cluster allocatable mem
                     , cs_adsk :: Int -- ^ Cluster allocatable disk
                     , cs_acpu :: Int -- ^ Cluster allocatable cpus
                     , cs_mmem :: Int -- ^ Max node allocatable mem
                     , cs_mdsk :: Int -- ^ Max node allocatable disk
                     , cs_mcpu :: Int -- ^ Max node allocatable cpu
                     }

-- * Utility functions

-- | Verifies the N+1 status and return the affected nodes.
verifyN1 :: [Node.Node] -> [Node.Node]
verifyN1 = filter Node.failN1

{-| 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 $ getOnline nl
      bad_instances = map (\idx -> Container.find idx il) .
                      sort . nub $
                      concatMap (\ n -> Node.slist n ++ Node.plist n) bad_nodes
  in
    (bad_nodes, bad_instances)

emptyCStats :: CStats
emptyCStats = CStats { cs_fmem = 0
                     , cs_fdsk = 0
                     , cs_amem = 0
                     , cs_adsk = 0
                     , cs_acpu = 0
                     , cs_mmem = 0
                     , cs_mdsk = 0
                     , cs_mcpu = 0
                     }

updateCStats :: CStats -> Node.Node -> CStats
updateCStats cs node =
    let CStats { cs_fmem = x_fmem, cs_fdsk = x_fdsk,
                 cs_amem = x_amem, cs_acpu = x_acpu, cs_adsk = x_adsk,
                 cs_mmem = x_mmem, cs_mdsk = x_mdsk, cs_mcpu = x_mcpu }
            = cs
        inc_amem = Node.f_mem node - Node.r_mem node
        inc_amem' = if inc_amem > 0 then inc_amem else 0
        inc_adsk = Node.availDisk node
    in CStats { cs_fmem = x_fmem + Node.f_mem node
              , cs_fdsk = x_fdsk + Node.f_dsk node
              , cs_amem = x_amem + inc_amem'
              , cs_adsk = x_adsk + inc_adsk
              , cs_acpu = x_acpu
              , cs_mmem = max x_mmem inc_amem'
              , cs_mdsk = max x_mdsk inc_adsk
              , cs_mcpu = x_mcpu
              }

-- | Compute the total free disk and memory in the cluster.
totalResources :: Node.List -> CStats
totalResources = foldl' updateCStats emptyCStats . Container.elems

-- | Compute the mem and disk covariance.
compDetailedCV :: Node.List -> (Double, 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)::Double
        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)::Double
        cpu_l = map Node.p_cpu nodes
        cpu_cv = varianceCoeff cpu_l
    in (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv)

-- | Compute the /total/ variance.
compCV :: Node.List -> Double
compCV nl =
    let (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv) =
            compDetailedCV nl
    in mem_cv + dsk_cv + n1_score + res_cv + off_score + cpu_cv

-- | Compute online nodes from a Node.List
getOnline :: Node.List -> [Node.Node]
getOnline = filter (not . Node.offline) . Container.elems

-- * 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.
applyMove :: Node.List -> Instance.Instance
          -> IMove -> (OpResult Node.List, Instance.Instance, Ndx, Ndx)
-- Failover (f)
applyMove nl inst Failover =
    let old_pdx = Instance.pnode inst
        old_sdx = Instance.snode inst
        old_p = Container.find old_pdx nl<commit_msg>Fix score calculation to work with empty clusters<commit_after>{-| Implementation of cluster-wide logic.

This module holds all pure cluster-logic; I\/O related functionality
goes into the "Main" module for the individual binaries.

-}

{-

Copyright (C) 2009 Google Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

module Ganeti.HTools.Cluster
    (
     -- * Types
      Placement
    , AllocSolution
    , Table(..)
    , Score
    , IMove(..)
    , CStats(..)
    -- * Generic functions
    , totalResources
    -- * First phase functions
    , computeBadItems
    -- * Second phase functions
    , printSolution
    , printSolutionLine
    , formatCmds
    , printNodes
    -- * Balacing functions
    , applyMove
    , checkMove
    , compCV
    , printStats
    -- * IAllocator functions
    , allocateOnSingle
    , allocateOnPair
    , tryAlloc
    , tryReloc
    ) where

import Data.List
import Text.Printf (printf)
import Data.Function
import Control.Monad

import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
import Ganeti.HTools.Types
import Ganeti.HTools.Utils

-- * Types

-- | A separate name for the cluster score type.
type Score = Double

-- | The description of an instance placement.
type Placement = (Idx, Ndx, Ndx, Score)

-- | Allocation\/relocation solution.
type AllocSolution = [(OpResult Node.List, Instance.Instance, [Node.Node])]

-- | An instance move definition
data IMove = Failover                -- ^ Failover the instance (f)
           | ReplacePrimary Ndx      -- ^ Replace primary (f, r:np, f)
           | ReplaceSecondary Ndx    -- ^ Replace secondary (r:ns)
           | ReplaceAndFailover Ndx  -- ^ Replace secondary, failover (r:np, f)
           | FailoverAndReplace Ndx  -- ^ Failover, replace secondary (f, r:ns)
             deriving (Show)

-- | The complete state for the balancing solution
data Table = Table Node.List Instance.List Score [Placement]
             deriving (Show)

data CStats = CStats { cs_fmem :: Int -- ^ Cluster free mem
                     , cs_fdsk :: Int -- ^ Cluster free disk
                     , cs_amem :: Int -- ^ Cluster allocatable mem
                     , cs_adsk :: Int -- ^ Cluster allocatable disk
                     , cs_acpu :: Int -- ^ Cluster allocatable cpus
                     , cs_mmem :: Int -- ^ Max node allocatable mem
                     , cs_mdsk :: Int -- ^ Max node allocatable disk
                     , cs_mcpu :: Int -- ^ Max node allocatable cpu
                     }

-- * Utility functions

-- | Verifies the N+1 status and return the affected nodes.
verifyN1 :: [Node.Node] -> [Node.Node]
verifyN1 = filter Node.failN1

{-| 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 $ getOnline nl
      bad_instances = map (\idx -> Container.find idx il) .
                      sort . nub $
                      concatMap (\ n -> Node.slist n ++ Node.plist n) bad_nodes
  in
    (bad_nodes, bad_instances)

emptyCStats :: CStats
emptyCStats = CStats { cs_fmem = 0
                     , cs_fdsk = 0
                     , cs_amem = 0
                     , cs_adsk = 0
                     , cs_acpu = 0
                     , cs_mmem = 0
                     , cs_mdsk = 0
                     , cs_mcpu = 0
                     }

updateCStats :: CStats -> Node.Node -> CStats
updateCStats cs node =
    let CStats { cs_fmem = x_fmem, cs_fdsk = x_fdsk,
                 cs_amem = x_amem, cs_acpu = x_acpu, cs_adsk = x_adsk,
                 cs_mmem = x_mmem, cs_mdsk = x_mdsk, cs_mcpu = x_mcpu }
            = cs
        inc_amem = Node.f_mem node - Node.r_mem node
        inc_amem' = if inc_amem > 0 then inc_amem else 0
        inc_adsk = Node.availDisk node
    in CStats { cs_fmem = x_fmem + Node.f_mem node
              , cs_fdsk = x_fdsk + Node.f_dsk node
              , cs_amem = x_amem + inc_amem'
              , cs_adsk = x_adsk + inc_adsk
              , cs_acpu = x_acpu
              , cs_mmem = max x_mmem inc_amem'
              , cs_mdsk = max x_mdsk inc_adsk
              , cs_mcpu = x_mcpu
              }

-- | Compute the total free disk and memory in the cluster.
totalResources :: Node.List -> CStats
totalResources = foldl' updateCStats emptyCStats . Container.elems

-- | Compute the mem and disk covariance.
compDetailedCV :: Node.List -> (Double, 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)::Double
        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 = if offline_inst == 0
                    then 0::Double
                    else fromIntegral offline_inst /
                         fromIntegral (offline_inst + online_inst)::Double
        cpu_l = map Node.p_cpu nodes
        cpu_cv = varianceCoeff cpu_l
    in (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv)

-- | Compute the /total/ variance.
compCV :: Node.List -> Double
compCV nl =
    let (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv) =
            compDetailedCV nl
    in mem_cv + dsk_cv + n1_score + res_cv + off_score + cpu_cv

-- | Compute online nodes from a Node.List
getOnline :: Node.List -> [Node.Node]
getOnline = filter (not . Node.offline) . Container.elems

-- * 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.
applyMove :: Node.List -> Instance.Instance
          -> IMove -> (OpResult Node.List, Instance.Instance, Ndx, Ndx)
-- Failover (f)
applyMove nl inst Failover =
    let old_pdx = Instance.pnode inst
        old_sdx = Instance.snode inst
        old_p = Container.find old_pdx nl
{'fraction_non_alphanumeric': 0.08363784003248072, 'fraction_numerical': 0.005413452429286778, 'mean_word_length': 2.0840984974958263, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 43, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6239709', 'n_tokens_mistral': 4538, 'n_tokens_neox': 4415, 'n_words': 1480}