Commit 040afc35 authored by Iustin Pop's avatar Iustin Pop
Browse files

Rework the loader model

This big patch changes the loader model from “string data as common
format” to actual object structures as common format.

The text loading function move from Cluster.hs to a new Text.hs module,
some common functions are moved to a new Loader.hs module, and the
return values from both Rapi.hs and Text.hs are uniformized.
parent 585d4420
......@@ -85,10 +85,6 @@ data IMove = Failover -- ^ Failover the instance (f)
data Table = Table NodeList InstanceList Score [Placement]
deriving (Show)
-- | Constant node index for a non-moveable instance
noSecondary :: Int
noSecondary = -1
-- General functions
-- | Cap the removal list if needed.
......@@ -480,7 +476,7 @@ checkMove nodes_idx ini_tbl victims =
best_tbl =
foldl'
(\ step_tbl elem ->
if Instance.snode elem == noSecondary then step_tbl
if Instance.snode elem == Node.noSecondary then step_tbl
else compareTables step_tbl $
checkInstanceMove nodes_idx ini_tbl elem)
ini_tbl victims
......@@ -694,23 +690,6 @@ printStats nl =
-- Loading functions
{- | Convert newline and delimiter-separated text.
This function converts a text in tabular format as generated by
@gnt-instance list@ and @gnt-node list@ to a list of objects using a
supplied conversion function.
-}
loadTabular :: (Monad m) => String -> ([String] -> m (String, a))
-> (a -> Int -> a) -> m ([(String, Int)], [(Int, a)])
loadTabular text_data convert_fn set_fn = do
let lines_data = lines text_data
rows = map (sepSplit '|') lines_data
kerows <- mapM convert_fn rows
let idxrows = map (\ (idx, (k, v)) -> ((k, idx), (idx, set_fn v idx)))
(zip [0..] kerows)
return $ unzip idxrows
-- | For each instance, add its index to its primary and secondary nodes
fixNodes :: [(Int, Node.Node)]
-> [(Int, Instance.Instance)]
......@@ -726,7 +705,7 @@ fixNodes nl il =
ac1 = deleteBy assocEqual (pdx, pold) accu
ac2 = (pdx, pnew):ac1
in
if sdx /= noSecondary then
if sdx /= Node.noSecondary then
let
sold = fromJust $ lookup sdx accu
snew = Node.setSec sold idx
......@@ -756,66 +735,15 @@ stripSuffix suffix lst =
let sflen = length suffix in
map (\ (key, name) -> (key, take ((length name) - sflen) name)) lst
-- | Safe 'read' function returning data encapsulated in a Result
tryRead :: (Monad m, Read a) => String -> String -> m a
tryRead name s =
let sols = readsPrec 0 s
in case sols of
(v, ""):[] -> return v
(_, e):[] -> fail $ name ++ ": leftover characters when parsing '"
++ s ++ "': '" ++ e ++ "'"
_ -> fail $ name ++ ": cannot parse string '" ++ s ++ "'"
-- | Lookups a node into an assoc list
lookupNode :: (Monad m) => String -> String -> [(String, Int)] -> m Int
lookupNode node inst ktn =
case lookup node ktn of
Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
Just idx -> return idx
-- | Load a node from a field list
loadNode :: (Monad m) => [String] -> m (String, Node.Node)
loadNode (name:tm:nm:fm:td:fd:fo:[]) = do
new_node <-
if any (== "?") [tm,nm,fm,td,fd] || fo == "Y" then
return $ Node.create 0 0 0 0 0 True
else do
vtm <- tryRead name tm
vnm <- tryRead name nm
vfm <- tryRead name fm
vtd <- tryRead name td
vfd <- tryRead name fd
return $ Node.create vtm vnm vfm vtd vfd False
return (name, new_node)
loadNode s = fail $ "Invalid/incomplete node data: '" ++ (show s) ++ "'"
-- | Load an instance from a field list
loadInst :: (Monad m) =>
[(String, Int)] -> [String] -> m (String, Instance.Instance)
loadInst ktn (name:mem:dsk:status:pnode:snode:[]) = do
pidx <- lookupNode pnode name ktn
sidx <- (if null snode then return noSecondary
else lookupNode snode name ktn)
vmem <- tryRead name mem
vdsk <- tryRead name dsk
when (sidx == pidx) $ fail $ "Instance " ++ name ++
" has same primary and secondary node - " ++ pnode
let newinst = Instance.create vmem vdsk status pidx sidx
return (name, newinst)
loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ (show s) ++ "'"
{-| Initializer function that loads the data from a node and list file
and massages it into the correct format. -}
loadData :: String -- ^ Node data in text format
-> String -- ^ Instance data in text format
-> Result (Container.Container Node.Node,
Container.Container Instance.Instance,
String, NameList, NameList)
loadData ndata idata = do
{- node file: name t_mem n_mem f_mem t_disk f_disk -}
(ktn, nl) <- loadTabular ndata loadNode Node.setIdx
{- instance file: name mem disk status pnode snode -}
(kti, il) <- loadTabular idata (loadInst ktn) Instance.setIdx
loadData :: ([(String, Int)], Node.AssocList,
[(String, Int)], Instance.AssocList) -- ^ Data from either
-- Text.loadData
-- or Rapi.loadData
-> Result (NodeList, InstanceList, String, NameList, NameList)
loadData (ktn, nl, kti, il) = do
let
nl2 = fixNodes nl il
il3 = Container.fromAssocList il
......
......@@ -17,6 +17,9 @@ data Instance = Instance { mem :: Int -- ^ memory of the instance
-- book-keeping
} deriving (Show)
-- | A simple name for the int, instance association list
type AssocList = [(Int, Instance)]
create :: Int -> Int -> String -> Int -> Int -> Instance
create mem_init dsk_init run_init pn sn =
Instance {
......
{-| Loading data from external sources
This module holds the common code for loading the cluster state from external sources.
-}
module Ganeti.HTools.Loader
where
type NameAssoc = [(String, Int)]
-- | Lookups a node into an assoc list
lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Int
lookupNode ktn inst node =
case lookup node ktn of
Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
Just idx -> return idx
assignIndices :: (a -> Int -> a)
-> [(String, a)]
-> (NameAssoc, [(Int, a)])
assignIndices set_fn =
unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, set_fn v idx)))
. zip [0..]
......@@ -26,6 +26,9 @@ module Ganeti.HTools.Node
, setSec
-- * Formatting
, list
-- * Misc stuff
, AssocList
, noSecondary
) where
import Data.List
......@@ -58,6 +61,13 @@ data Node = Node { t_mem :: Double -- ^ total memory (MiB)
-- score computations
} deriving (Show)
-- | A simple name for the int, node association list
type AssocList = [(Int, Node)]
-- | Constant node index for a non-moveable instance
noSecondary :: Int
noSecondary = -1
{- | Create a new node.
The index and the peers maps are empty, and will be need to be update
......
......@@ -4,20 +4,21 @@
module Ganeti.HTools.Rapi
(
getNodes
, getInstances
loadData
) where
import Network.Curl
import Network.Curl.Types ()
import Network.Curl.Code
import Data.Either ()
import Data.Maybe
import Data.List
import Control.Monad
import Text.JSON (JSObject, JSValue)
import Text.Printf (printf)
import Ganeti.HTools.Utils
import Ganeti.HTools.Loader
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
-- | Read an URL via curl and return the body if successful
getUrl :: (Monad m) => String -> IO (m String)
......@@ -35,57 +36,62 @@ formatHost master =
if elem ':' master then master
else "https://" ++ master ++ ":5080"
getInstances :: String -> IO (Result String)
getInstances master = do
let url2 = printf "%s/2/instances?bulk=1" (formatHost master)
body <- getUrl url2
return $ (do x <- body
arr <- loadJSArray x
ilist <- mapM parseInstance arr
return $ unlines ilist)
getInstances :: NameAssoc
-> String
-> Result [(String, Instance.Instance)]
getInstances ktn body = do
arr <- loadJSArray body
ilist <- mapM (parseInstance ktn) arr
return ilist
getNodes :: String -> IO (Result String)
getNodes master = do
let url2 = printf "%s/2/nodes?bulk=1" (formatHost master)
body <- getUrl url2
return $ (do x <- body
arr <- loadJSArray x
nlist <- mapM parseNode arr
return $ unlines nlist)
getNodes :: String -> Result [(String, Node.Node)]
getNodes body = do
arr <- loadJSArray body
nlist <- mapM parseNode arr
return nlist
parseInstance :: JSObject JSValue -> Result String
parseInstance a =
let name = getStringElement "name" a
disk = getIntElement "disk_usage" a
mem = getObjectElement "beparams" a >>= getIntElement "memory"
pnode = getStringElement "pnode" a
snode = (liftM head $ getListElement "snodes" a) >>= readEitherString
running = getStringElement "status" a
in
name |+ (show `liftM` mem) |+
(show `liftM` disk) |+
running |+ pnode |+ snode
parseInstance :: [(String, Int)]
-> JSObject JSValue
-> Result (String, Instance.Instance)
parseInstance ktn a = do
name <- fromObj "name" a
disk <- fromObj "disk_usage" a
mem <- fromObj "beparams" a >>= fromObj "memory"
pnode <- fromObj "pnode" a >>= lookupNode ktn name
snodes <- getListElement "snodes" a
snode <- (if null snodes then return Node.noSecondary
else readEitherString (head snodes) >>= lookupNode ktn name)
running <- fromObj "status" a
let inst = Instance.create mem disk running pnode snode
return (name, inst)
boolToYN :: (Monad m) => Bool -> m String
boolToYN True = return "Y"
boolToYN _ = return "N"
parseNode :: JSObject JSValue -> Result (String, Node.Node)
parseNode a = do
name <- fromObj "name" a
offline <- fromObj "offline" a
node <- (case offline of
True -> return $ Node.create 0 0 0 0 0 True
_ -> do
drained <- fromObj "drained" a
mtotal <- fromObj "mtotal" a
mnode <- fromObj "mnode" a
mfree <- fromObj "mfree" a
dtotal <- fromObj "dtotal" a
dfree <- fromObj "dfree" a
return $ Node.create mtotal mnode mfree
dtotal dfree (offline || drained))
return (name, node)
parseNode :: JSObject JSValue -> Result String
parseNode a =
let name = getStringElement "name" a
offline = getBoolElement "offline" a
drained = getBoolElement "drained" a
mtotal = getIntElement "mtotal" a
mnode = getIntElement "mnode" a
mfree = getIntElement "mfree" a
dtotal = getIntElement "dtotal" a
dfree = getIntElement "dfree" a
in name |+
(case offline of
Ok True -> Ok "0|0|0|0|0|Y"
_ ->
(show `liftM` mtotal) |+ (show `liftM` mnode) |+
(show `liftM` mfree) |+ (show `liftM` dtotal) |+
(show `liftM` dfree) |+
((liftM2 (||) offline drained) >>= boolToYN)
)
loadData :: String -- ^ Cluster/URL to use as source
-> IO (Result (NameAssoc, Node.AssocList,
NameAssoc, Instance.AssocList))
loadData master = do -- IO monad
let url = formatHost master
node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
return $ do -- Result monad
node_data <- node_body >>= getNodes
let (node_names, node_idx) = assignIndices Node.setIdx node_data
inst_data <- inst_body >>= getInstances node_names
let (inst_names, inst_idx) = assignIndices Instance.setIdx inst_data
return (node_names, node_idx, inst_names, inst_idx)
{-| Parsing data from text-files
This module holds the code for loading the cluster state from text
files, as produced by gnt-node/gnt-instance list.
-}
module Ganeti.HTools.Text
where
import Control.Monad
import Ganeti.HTools.Utils
import Ganeti.HTools.Loader
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
-- | Safe 'read' function returning data encapsulated in a Result
tryRead :: (Monad m, Read a) => String -> String -> m a
tryRead name s =
let sols = readsPrec 0 s
in case sols of
(v, ""):[] -> return v
(_, e):[] -> fail $ name ++ ": leftover characters when parsing '"
++ s ++ "': '" ++ e ++ "'"
_ -> fail $ name ++ ": cannot parse string '" ++ s ++ "'"
-- | Load a node from a field list
loadNode :: (Monad m) => [String] -> m (String, Node.Node)
loadNode (name:tm:nm:fm:td:fd:fo:[]) = do
new_node <-
if any (== "?") [tm,nm,fm,td,fd] || fo == "Y" then
return $ Node.create 0 0 0 0 0 True
else do
vtm <- tryRead name tm
vnm <- tryRead name nm
vfm <- tryRead name fm
vtd <- tryRead name td
vfd <- tryRead name fd
return $ Node.create vtm vnm vfm vtd vfd False
return (name, new_node)
loadNode s = fail $ "Invalid/incomplete node data: '" ++ (show s) ++ "'"
-- | Load an instance from a field list
loadInst :: (Monad m) =>
[(String, Int)] -> [String] -> m (String, Instance.Instance)
loadInst ktn (name:mem:dsk:status:pnode:snode:[]) = do
pidx <- lookupNode ktn name pnode
sidx <- (if null snode then return Node.noSecondary
else lookupNode ktn name snode)
vmem <- tryRead name mem
vdsk <- tryRead name dsk
when (sidx == pidx) $ fail $ "Instance " ++ name ++
" has same primary and secondary node - " ++ pnode
let newinst = Instance.create vmem vdsk status pidx sidx
return (name, newinst)
loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ (show s) ++ "'"
{- | Convert newline and delimiter-separated text.
This function converts a text in tabular format as generated by
@gnt-instance list@ and @gnt-node list@ to a list of objects using a
supplied conversion function.
-}
loadTabular :: (Monad m) => String -> ([String] -> m (String, a))
-> (a -> Int -> a) -> m ([(String, Int)], [(Int, a)])
loadTabular text_data convert_fn set_fn = do
let lines_data = lines text_data
rows = map (sepSplit '|') lines_data
kerows <- mapM convert_fn rows
return $ assignIndices set_fn kerows
loadData :: String -- ^ Node data in string format
-> String -- ^ Instance data in string format
-> IO (Result (NameAssoc, Node.AssocList,
NameAssoc, Instance.AssocList))
loadData nfile ifile = do -- IO monad
ndata <- readFile nfile
idata <- readFile ifile
return $ do
{- node file: name t_mem n_mem f_mem t_disk f_disk -}
(ktn, nl) <- loadTabular ndata loadNode Node.setIdx
{- instance file: name mem disk status pnode snode -}
(kti, il) <- loadTabular idata (loadInst ktn) Instance.setIdx
return (ktn, nl, kti, il)
......@@ -19,7 +19,9 @@ import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.CLI as CLI
import Ganeti.HTools.Rapi
import qualified Ganeti.HTools.Rapi as Rapi
import qualified Ganeti.HTools.Text as Text
import Ganeti.HTools.Utils
-- | Command line options structure.
......@@ -179,14 +181,13 @@ main = do
else env_inst
oneline = optOneline opts
verbose = optVerbose opts
(node_data, inst_data) =
case optMaster opts of
"" -> (readFile nodef,
readFile instf)
host -> (getNodes host >>= readData,
getInstances host >>= readData)
ldresult <- liftM2 Cluster.loadData node_data inst_data
input_data <-
case optMaster opts of
"" -> Text.loadData nodef instf
host -> Rapi.loadData host
let ldresult = input_data >> Cluster.loadData
(loaded_nl, il, csf, ktn, kti) <-
(case ldresult of
Ok x -> return x
......
......@@ -18,7 +18,8 @@ import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.CLI as CLI
import Ganeti.HTools.Rapi
import qualified Ganeti.HTools.Rapi as Rapi
import qualified Ganeti.HTools.Text as Text
import Ganeti.HTools.Utils
-- | Command line options structure.
......@@ -144,14 +145,13 @@ main = do
instf = if optInstSet opts then optInstf opts
else env_inst
min_depth = optMinDepth opts
(node_data, inst_data) =
case optMaster opts of
"" -> (readFile nodef,
readFile instf)
host -> (getNodes host >>= readData,
getInstances host >>= readData)
ldresult <- liftM2 Cluster.loadData node_data inst_data
input_data <-
case optMaster opts of
"" -> Text.loadData nodef instf
host -> Rapi.loadData host
let ldresult = input_data >>= Cluster.loadData
(loaded_nl, il, csf, ktn, kti) <-
(case ldresult of
Ok x -> return x
......
......@@ -21,7 +21,7 @@ import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.CLI as CLI
import Ganeti.HTools.Rapi
import qualified Ganeti.HTools.Rapi as Rapi
import Ganeti.HTools.Utils
-- | Command line options structure.
......@@ -158,10 +158,8 @@ main = do
do
printf "%-*s " nlen name
hFlush stdout
node_data <- getNodes name
inst_data <- getInstances name
let ldresult = join $
liftM2 Cluster.loadData node_data inst_data
input_data <- Rapi.loadData name
let ldresult = input_data >>= Cluster.loadData
(case ldresult of
Bad err -> printf "\nError: failed to load data. \
\Details:\n%s\n" err
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment