Synnefo » snf-ganeti

  , justOk

-- | Simple filter returning only OK values of GenericResult

justOk :: [GenericResult a b] -> [b]

justOk [] = []

justOk (x:xs) = case x of

  Ok  v -> v:justOk xs

  Bad _ -> justOk xs

    , getInstAllNodes

import Data.List (foldl', nub)

-- | Retrieves all nodes hosting a DRBD disk

getDrbdDiskNodes :: ConfigData -> Disk -> [Node]

getDrbdDiskNodes cfg disk =

  let retrieved = case diskLogicalId disk of

                    LIDDrbd8 nodeA nodeB _ _ _ _ ->

                      justOk [getNode cfg nodeA, getNode cfg nodeB]

                    _                            -> []

  in retrieved ++ concatMap (getDrbdDiskNodes cfg) (diskChildren disk)

-- | Retrieves all the nodes of the instance.

--

-- As instances not using DRBD can be sent as a parameter as well,

-- the primary node has to be appended to the results.

getInstAllNodes :: ConfigData -> String -> ErrorResult [Node]

getInstAllNodes cfg name = do

  inst <- getInstance cfg name

  let diskNodes = concatMap (getDrbdDiskNodes cfg) $ instDisks inst

  pNode <- getInstPrimaryNode cfg name

  return . nub $ pNode:diskNodes

  , maybeToError

-- | Convert from a 'Maybe' to a an 'ErrorResult'.

maybeToError :: String -> Maybe a -> ErrorResult a

maybeToError _ (Just a) = Ok a

maybeToError m  Nothing = Bad $ GenericError m

  , rsErrorNoData

import Ganeti.BasicTypes

import Ganeti.Errors

-- | Helper to declare a result from a 'ErrorResult' (an error happened

-- while retrieving the data from a config, or there was no data).

-- This function should be used if an error signals there was no data.

rsErrorNoData :: (JSON a) => ErrorResult a -> ResultEntry

rsErrorNoData res = case res of

  Ok  x -> rsNormal x

  Bad _ -> rsNoData

import Ganeti.Errors

  [ (FieldDefinition "admin_state" "InstanceState" QFTText

     "Desired state of instance",

     FieldSimple (rsNormal . adminStateToRaw . instAdminState), QffNormal)

  , (FieldDefinition "admin_up" "Autostart" QFTBool

     "Desired state of instance",

     FieldSimple (rsNormal . (== AdminUp) . instAdminState), QffNormal)

  , (FieldDefinition "disk_template" "Disk_template" QFTText

  , (FieldDefinition "disks_active" "DisksActive" QFTBool

     "Desired state of instance disks",

     FieldSimple (rsNormal . instDisksActive), QffNormal)

  , (FieldDefinition "pnode" "Primary_node" QFTText

     "Primary node",

     FieldConfig getPrimaryNodeName, QffHostname)

  , (FieldDefinition "pnode.group" "PrimaryNodeGroup" QFTText

     "Primary node's group",

     FieldConfig getPrimaryNodeGroup, QffNormal)

  , (FieldDefinition "snodes" "Secondary_Nodes" QFTOther

     "Secondary nodes; usually this will just be one node",

     FieldConfig (getSecondaryNodeAttribute nodeName), QffNormal)

  , (FieldDefinition "snodes.group" "SecondaryNodesGroups" QFTOther

     "Node groups of secondary nodes",

     FieldConfig (getSecondaryNodeGroupAttribute groupName), QffNormal)

  , (FieldDefinition "snodes.group.uuid" "SecondaryNodesGroupsUUID" QFTOther

     "Node group UUIDs of secondary nodes",

     FieldConfig (getSecondaryNodeGroupAttribute groupUuid), QffNormal)

-- * Helper functions for node property retrieval

-- | Helper function for primary node retrieval

getPrimaryNode :: ConfigData -> Instance -> ErrorResult Node

getPrimaryNode cfg = getInstPrimaryNode cfg . instName

-- | Get primary node hostname

getPrimaryNodeName :: ConfigData -> Instance -> ResultEntry

getPrimaryNodeName cfg inst =

  rsErrorNoData $ (J.showJSON . nodeName) <$> getPrimaryNode cfg inst

-- | Get primary node hostname

getPrimaryNodeGroup :: ConfigData -> Instance -> ResultEntry

getPrimaryNodeGroup cfg inst =

  rsErrorNoData $ (J.showJSON . groupName) <$>

    (getPrimaryNode cfg inst >>=

    maybeToError "Configuration missing" . getGroupOfNode cfg)

-- | Get secondary nodes - the configuration objects themselves

getSecondaryNodes :: ConfigData -> Instance -> ErrorResult [Node]

getSecondaryNodes cfg inst = do

  pNode <- getPrimaryNode cfg inst

  allNodes <- getInstAllNodes cfg $ instName inst

  return $ delete pNode allNodes

-- | Get attributes of the secondary nodes

getSecondaryNodeAttribute :: (J.JSON a)

                          => (Node -> a)

                          -> ConfigData

                          -> Instance

                          -> ResultEntry

getSecondaryNodeAttribute getter cfg inst =

  rsErrorNoData $ map (J.showJSON . getter) <$> getSecondaryNodes cfg inst

-- | Get secondary node groups

getSecondaryNodeGroups :: ConfigData -> Instance -> ErrorResult [NodeGroup]

getSecondaryNodeGroups cfg inst = do

  sNodes <- getSecondaryNodes cfg inst

  return . catMaybes $ map (getGroupOfNode cfg) sNodes

-- | Get attributes of secondary node groups

getSecondaryNodeGroupAttribute :: (J.JSON a)

                               => (NodeGroup -> a)

                               -> ConfigData

                               -> Instance

                               -> ResultEntry

getSecondaryNodeGroupAttribute getter cfg inst =

  rsErrorNoData $ map (J.showJSON . getter) <$> getSecondaryNodeGroups cfg inst

                         -> FieldData Instance Runtime

-- * Functionality related to status and operational status extraction

  in  "Instance status; " ++

      si Running ++

      " if instance is set to be running and actually is, " ++

      si StatusDown ++

      " if instance is stopped and is not running, " ++

      si WrongNode ++

      " if instance running, but not on its designated primary node, " ++

      si ErrorUp ++

      " if instance should be stopped, but is actually running, " ++

      si ErrorDown ++

      " if instance should run, but doesn't, " ++

      si NodeDown ++

      " if instance's primary node is down, " ++

      si NodeOffline ++

      " if instance's primary node is marked offline, " ++

      si StatusOffline ++

      " if instance is offline and does not use dynamic resources"

  let pNodeResult = getNode cfg $ instPrimaryNode inst

  in case pNodeResult of

     Ok pNode -> nodeOffline pNode

     Bad    _ -> error "Programmer error - result assumed to be OK is Bad!"

-- to communicate with its primary node, on which node it is, and its

-- configuration.

determineInstanceStatus :: ConfigData      -- ^ The configuration data

                        -> Runtime         -- ^ All the data from the live call

                        -> Instance        -- ^ Static instance configuration

                        -> InstanceStatus  -- ^ Result

determineInstanceStatus cfg res inst

  | isPrimaryOffline cfg inst = NodeOffline

  | otherwise = case res of

                  Left _                -> NodeDown

                  Right (Just liveData) -> liveInstanceStatus liveData inst

                  Right Nothing         -> deadInstanceStatus inst

-- | Extracts the instance status, retrieving it using the functions above and

-- transforming it into a 'ResultEntry'.

-- | Extracts the operational status of the instance.

  rsMaybeNoData $ J.showJSON <$>

    case res of

      Left  _ -> Nothing

      Right x -> Just $ isJust x

-- * Helper functions extracting information as necessary for the generic query

          instance_nodes = nub . justOk $