Synnefo » snf-ganeti

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 $