code.grnet.gr Git - ganeti-local/blob - Ganeti/HTools/Loader.hs

   1 {-| Loading data from external sources
   2
   3 This module holds the common code for loading the cluster state from external sources.
   4
   5 -}
   6
   7 module Ganeti.HTools.Loader
   8     where
   9
  10 import Data.List
  11 import Data.Maybe (isNothing, fromJust)
  12
  13 import qualified Ganeti.HTools.Container as Container
  14 import qualified Ganeti.HTools.Instance as Instance
  15 import qualified Ganeti.HTools.Node as Node
  16
  17 import Ganeti.HTools.Types
  18
  19
  20 -- | Swap a list of @(a, b)@ into @(b, a)@
  21 swapPairs :: [(a, b)] -> [(b, a)]
  22 swapPairs = map (\ (a, b) -> (b, a))
  23
  24 -- | Lookups a node into an assoc list
  25 lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Int
  26 lookupNode ktn inst node =
  27     case lookup node ktn of
  28       Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
  29       Just idx -> return idx
  30
  31 assignIndices :: (a -> Int -> a)
  32               -> [(String, a)]
  33               -> (NameAssoc, [(Int, a)])
  34 assignIndices set_fn =
  35     unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, set_fn v idx)))
  36           . zip [0..]
  37
  38 -- | For each instance, add its index to its primary and secondary nodes
  39 fixNodes :: [(Int, Node.Node)]
  40          -> [(Int, Instance.Instance)]
  41          -> [(Int, Node.Node)]
  42 fixNodes nl il =
  43     foldl' (\accu (idx, inst) ->
  44                 let
  45                     assocEqual = (\ (i, _) (j, _) -> i == j)
  46                     pdx = Instance.pnode inst
  47                     sdx = Instance.snode inst
  48                     pold = fromJust $ lookup pdx accu
  49                     pnew = Node.setPri pold idx
  50                     ac1 = deleteBy assocEqual (pdx, pold) accu
  51                     ac2 = (pdx, pnew):ac1
  52                 in
  53                   if sdx /= Node.noSecondary then
  54                       let
  55                           sold = fromJust $ lookup sdx accu
  56                           snew = Node.setSec sold idx
  57                           ac3 = deleteBy assocEqual (sdx, sold) ac2
  58                           ac4 = (sdx, snew):ac3
  59                       in ac4
  60                   else
  61                       ac2
  62            ) nl il
  63
  64 -- | Compute the longest common suffix of a NameList list that
  65 -- | starts with a dot
  66 longestDomain :: NameList -> String
  67 longestDomain [] = ""
  68 longestDomain ((_,x):xs) =
  69     let
  70         onlyStrings = snd $ unzip xs
  71     in
  72       foldr (\ suffix accu -> if all (isSuffixOf suffix) onlyStrings
  73                               then suffix
  74                               else accu)
  75       "" $ filter (isPrefixOf ".") (tails x)
  76
  77 -- | Remove tails from the (Int, String) lists
  78 stripSuffix :: String -> NameList -> NameList
  79 stripSuffix suffix lst =
  80     let sflen = length suffix in
  81     map (\ (key, name) -> (key, take ((length name) - sflen) name)) lst
  82
  83 {-| Initializer function that loads the data from a node and list file
  84     and massages it into the correct format. -}
  85 mergeData :: ([(String, Int)], Node.AssocList,
  86               [(String, Int)], Instance.AssocList) -- ^ Data from either
  87                                                    -- Text.loadData
  88                                                    -- or Rapi.loadData
  89           -> Result (NodeList, InstanceList, String, NameList, NameList)
  90 mergeData (ktn, nl, kti, il) = do
  91   let
  92       nl2 = fixNodes nl il
  93       il3 = Container.fromAssocList il
  94       nl3 = Container.fromAssocList
  95             (map (\ (k, v) -> (k, Node.buildPeers v il3 (length nl2))) nl2)
  96       xtn = swapPairs ktn
  97       xti = swapPairs kti
  98       common_suffix = longestDomain (xti ++ xtn)
  99       stn = stripSuffix common_suffix xtn
 100       sti = stripSuffix common_suffix xti
 101   return (nl3, il3, common_suffix, stn, sti)