Synnefo » snf-ganeti

nodeRole :: ConfigData -> String -> Result ConfdNodeRole

nodeRole cfg name =

  let cmaster = clusterMasterNode . configCluster $ cfg

  in case mnode of

       Nothing -> Bad "Node not found"

       Just node | cmaster == name -> Ok NodeRoleMaster

  -- versions of the library

  return (ReplyStatusOk, J.showJSON $

          M.foldlWithKey (\accu _ n -> nodePrimaryIp n:accu) []

buildResponse cdata (ConfdRequest { confdRqType = ReqMcPipList }) =

  -- note: we use foldlWithKey because that's present accross more

          M.foldlWithKey (\accu _ n -> if nodeMasterCandidate n

                                         then nodePrimaryIp n:accu

                                         else accu) []

buildResponse (cfg, linkipmap)

              req@(ConfdRequest { confdRqType = ReqInstIpsList }) = do

                 _ -> fail $ "Invalid query type " ++ show (confdRqQuery req)

  node <- getNode cfg node_name

  let minors = concatMap (getInstMinorsForNode (nodeName node)) .

      encoded = [J.JSArray [J.showJSON a, J.showJSON b, J.showJSON c,

                             J.showJSON d, J.showJSON e, J.showJSON f] |

                 (a, b, c, d, e, f) <- minors]

-- | Get instances of a given node.

getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])

getNodeInstances cfg nname =

        pri_inst = filter ((== nname) . instPrimaryNode) all_inst

        sec_inst = filter ((nname `S.member`) . instSecondaryNodes) all_inst

    in (pri_inst, sec_inst)

-- | Returns the default cluster link.

getDefaultNicLink :: ConfigData -> String

getDefaultNicLink =

-- | Returns instances of a given link.

getInstancesIpByLink :: LinkIpMap -> String -> [String]

-- | Looks up a node.

getNode :: ConfigData -> String -> Result Node

-- | Looks up an instance.

getInstance :: ConfigData -> String -> Result Instance

-- | Looks up an instance's primary node.

getInstPrimaryNode :: ConfigData -> String -> Result Node

buildLinkIpInstnameMap :: ConfigData -> LinkIpMap

buildLinkIpInstnameMap cfg =

  let cluster = configCluster cfg

      nics = concatMap (\i -> [(instName i, nic) | nic <- instNics i])

             instances

  in foldl' (\accum (iname, nic) ->

  , asObjectList

  , tryFromObj

  , toArray

  )

  where

import Control.Monad (liftM)

import Data.Maybe (fromMaybe)

import Text.Printf (printf)

import qualified Text.JSON as J

toArray :: (Monad m) => J.JSValue -> m [J.JSValue]

toArray (J.JSArray arr) = return arr

toArray o = fail $ "Invalid input, expected array but got " ++ show o

                  , Container

                  ) where

import Control.Monad (liftM, liftM2)

import Data.Char

import Data.List

import qualified Data.Set as Set

import Language.Haskell.TH

-- * Exported types

-- | Serialised field data type.

data Field = Field { fieldName        :: String

                   , fieldType        :: Q Type

       -> Q Exp   -- ^ The entire object in JSON object format

       -> Q Exp   -- ^ Resulting expression

loadFn (Field { fieldIsContainer = True }) expr _ =

loadFn (Field { fieldRead = Just readfn }) expr o = [| $expr >>= $readfn $o |]

loadFn _ expr _ = expr

appFn f x | f == VarE 'id = x

          | otherwise = AppE f x

-- * Template code for simple raw type-equivalent ADTs

-- | Generates a data type declaration.

saveObjectField :: Name -> Field -> Q Exp

saveObjectField fvar field

  | fisOptional = [| case $(varE fvar) of

                      Nothing -> []

                      Just v -> [( $nameE, JSON.showJSON v)]