Revision df583eaf src/Ganeti/Query/Instance.hs

b/src/Ganeti/Query/Instance.hs
24 24
-}
25 25

  
26 26
module Ganeti.Query.Instance
27
  (fieldsMap) where
27
  ( Runtime
28
  , fieldsMap
29
  , collectLiveData
30
  ) where
28 31

  
32
import Control.Applicative
33
import Data.List
34
import Data.Maybe
35
import Data.Monoid
29 36
import qualified Data.Map as Map
37
import qualified Text.JSON as J
30 38

  
39
import Ganeti.BasicTypes
40
import Ganeti.Common
41
import Ganeti.Config
31 42
import Ganeti.Objects
32 43
import Ganeti.Query.Common
33 44
import Ganeti.Query.Language
34 45
import Ganeti.Query.Types
46
import Ganeti.Rpc
47
import Ganeti.Storage.Utils
48
import Ganeti.Types
35 49

  
36
instanceFields :: FieldList Instance NoDataRuntime
50
-- | The LiveInfo structure packs additional information beside the
51
-- 'InstanceInfo'. We also need to know whether the instance information was
52
-- found on the primary node, and encode this as a Bool.
53
type LiveInfo = (InstanceInfo, Bool)
54

  
55
-- | Runtime possibly containing the 'LiveInfo'. See the genericQuery function
56
-- in the Query.hs file for an explanation of the terms used.
57
type Runtime = Either RpcError (Maybe LiveInfo)
58

  
59
-- | The instance fields map.
60
fieldsMap :: FieldMap Instance Runtime
61
fieldsMap = Map.fromList [(fdefName f, v) | v@(f, _, _) <- instanceFields]
62

  
63
-- | The instance fields
64
instanceFields :: FieldList Instance Runtime
37 65
instanceFields =
66
  -- Simple fields
38 67
  [ (FieldDefinition "disk_template" "Disk_template" QFTText
39
     "Disk template",
68
     "Instance disk template",
40 69
     FieldSimple (rsNormal . instDiskTemplate), QffNormal)
41 70
  , (FieldDefinition "name" "Instance" QFTText
42 71
     "Instance name",
......
46 75
     FieldSimple (rsNormal . instHypervisor), QffNormal)
47 76
  , (FieldDefinition "network_port" "Network_port" QFTOther
48 77
     "Instance network port if available (e.g. for VNC console)",
49
     FieldSimple (rsMaybeNoData . instNetworkPort), QffNormal)
78
     FieldSimple (rsMaybeUnavail . instNetworkPort), QffNormal)
50 79
  , (FieldDefinition "os" "OS" QFTText
51 80
     "Operating system",
52 81
     FieldSimple (rsNormal . instOs), QffNormal)
53 82
  ] ++
83

  
84
  -- Live fields using special getters
85
  [ (FieldDefinition "status" "Status" QFTText
86
     statusDocText,
87
     FieldConfigRuntime statusExtract, QffNormal)
88
  , (FieldDefinition "oper_state" "Running" QFTBool
89
     "Actual state of instance",
90
     FieldRuntime operStatusExtract, QffNormal)
91
  ] ++
92

  
93
  -- Simple live fields
94
  map instanceLiveFieldBuilder instanceLiveFieldsDefs ++
95

  
96
  -- Generated fields
54 97
  serialFields "Instance" ++
55
  uuidFields "Instance"
98
  uuidFields "Instance" ++
99
  tagsFields
100

  
101
-- * Live fields functionality
102

  
103
-- | List of node live fields.
104
instanceLiveFieldsDefs :: [(FieldName, FieldTitle, FieldType, String, FieldDoc)]
105
instanceLiveFieldsDefs =
106
  [ ("oper_ram", "Memory", QFTUnit, "oper_ram",
107
     "Actual memory usage as seen by hypervisor")
108
  , ("oper_vcpus", "VCPUs", QFTNumber, "oper_vcpus",
109
     "Actual number of VCPUs as seen by hypervisor")
110
  ]
111

  
112
-- | Map each name to a function that extracts that value from the RPC result.
113
instanceLiveFieldExtract :: FieldName -> InstanceInfo -> Instance -> J.JSValue
114
instanceLiveFieldExtract "oper_ram"   info _ = J.showJSON $ instInfoMemory info
115
instanceLiveFieldExtract "oper_vcpus" info _ = J.showJSON $ instInfoVcpus info
116
instanceLiveFieldExtract n _ _ = J.showJSON $
117
  "The field " ++ n ++ " is not an expected or extractable live field!"
118

  
119
-- | Helper for extracting field from RPC result.
120
instanceLiveRpcCall :: FieldName -> Runtime -> Instance -> ResultEntry
121
instanceLiveRpcCall fname (Right (Just (res, _))) inst =
122
  case instanceLiveFieldExtract fname res inst of
123
    J.JSNull -> rsNoData
124
    x        -> rsNormal x
125
instanceLiveRpcCall _ (Right Nothing) _ = rsUnavail
126
instanceLiveRpcCall _ (Left err) _ =
127
  ResultEntry (rpcErrorToStatus err) Nothing
128

  
129
-- | Builder for node live fields.
130
instanceLiveFieldBuilder :: (FieldName, FieldTitle, FieldType, String, FieldDoc)
131
                     -> FieldData Instance Runtime
132
instanceLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) =
133
  ( FieldDefinition fname ftitle ftype fdoc
134
  , FieldRuntime $ instanceLiveRpcCall fname
135
  , QffNormal)
136

  
137

  
138
-- Functionality related to status and operational status extraction
139

  
140
-- | The documentation text for the instance status field
141
statusDocText :: String
142
statusDocText =
143
  let si = show . instanceStatusToRaw :: InstanceStatus -> String
144
  in "Instance status; " ++
145
     si Running ++
146
     " if instance is set to be running and actually is, " ++
147
     si StatusDown ++
148
     " if instance is stopped and is not running, " ++
149
     si WrongNode ++
150
     " if instance running, but not on its designated primary node, " ++
151
     si ErrorUp ++
152
     " if instance should be stopped, but is actually running, " ++
153
     si ErrorDown ++
154
     " if instance should run, but doesn't, " ++
155
     si NodeDown ++
156
     " if instance's primary node is down, " ++
157
     si NodeOffline ++
158
     " if instance's primary node is marked offline, " ++
159
     si StatusOffline ++
160
     " if instance is offline and does not use dynamic resources"
161

  
162
-- | Checks if the primary node of an instance is offline
163
isPrimaryOffline :: ConfigData -> Instance -> Bool
164
isPrimaryOffline cfg inst =
165
  let pNode = optimisticUnwrapper . getNode cfg $ instPrimaryNode inst
166
  in nodeOffline pNode
167

  
168
-- | Determines the status of a live instance
169
liveInstanceStatus :: LiveInfo -> Instance -> InstanceStatus
170
liveInstanceStatus (_, foundOnPrimary) inst
171
  | not foundOnPrimary    = WrongNode
172
  | adminState == AdminUp = Running
173
  | otherwise             = ErrorUp
174
  where adminState = instAdminState inst
175

  
176
-- | Determines the status of a dead instance.
177
deadInstanceStatus :: Instance -> InstanceStatus
178
deadInstanceStatus inst =
179
  case instAdminState inst of
180
    AdminUp      -> ErrorDown
181
    AdminDown    -> StatusDown
182
    AdminOffline -> StatusOffline
183

  
184
-- | Determines the status of the instance, depending on whether it is possible
185
-- | to communicate with its primary node, on which node it is, and its
186
-- | configuration.
187
determineInstanceStatus :: ConfigData -- ^ The configuration data
188
                        -> Runtime    -- ^ All the data from the live call
189
                        -> Instance   -- ^ The static instance configuration
190
                        -> InstanceStatus -- ^ Result
191
determineInstanceStatus cfg res inst =
192
  if isPrimaryOffline cfg inst
193
    then NodeOffline
194
    else case res of
195
      Left _                -> NodeDown
196
      Right (Just liveData) -> liveInstanceStatus liveData inst
197
      Right Nothing         -> deadInstanceStatus inst
198

  
199
-- | Extracts the status, doing necessary transformations but once
200
statusExtract :: ConfigData -> Runtime -> Instance -> ResultEntry
201
statusExtract cfg res inst =
202
  rsNormal . J.showJSON . instanceStatusToRaw $
203
    determineInstanceStatus cfg res inst
204

  
205
-- | Extracts the operational status
206
operStatusExtract :: Runtime -> Instance -> ResultEntry
207
operStatusExtract res _ =
208
  rsMaybeNoData $ J.showJSON <$> case res of
209
    Left _  -> Nothing
210
    Right x -> Just $ isJust x
211

  
212

  
213
-- Helper functions extracting information as necessary for the generic query
214
-- interfaces
215

  
216
-- | A function removing the GenericResult wrapper from assuredly OK values
217
optimisticUnwrapper :: GenericResult a b -> b
218
optimisticUnwrapper (Ok x) = x
219
optimisticUnwrapper (Bad _) = error "Programmer error: assumptions are wrong!"
220

  
221
-- | Simple filter of OK results only
222
okNodesOnly :: [GenericResult a Node] -> [Node]
223
okNodesOnly = map optimisticUnwrapper . filter isOk
224

  
225
-- | Finds information about the instance in the info delivered by a node
226
findInstanceInfo :: Instance
227
                 -> ERpcError RpcResultAllInstancesInfo
228
                 -> Maybe InstanceInfo
229
findInstanceInfo inst nodeResponse =
230
  case nodeResponse of
231
    Left  _err    -> Nothing
232
    Right allInfo ->
233
      let instances = rpcResAllInstInfoInstances allInfo
234
          maybeMatch = pickPairUnique (instName inst) instances
235
      in snd <$> maybeMatch
236

  
237
-- | Finds the node information ('RPCResultError') or the instance information
238
-- (Maybe 'LiveInfo').
239
extractLiveInfo :: [(Node, ERpcError RpcResultAllInstancesInfo)]
240
                -> Instance
241
                -> Runtime
242
extractLiveInfo nodeResultList inst =
243
  let uuidResultList = [(nodeUuid x, y) | (x, y) <- nodeResultList]
244
      pNodeUuid = instPrimaryNode inst
245
      maybeRPCError = getNodeStatus uuidResultList pNodeUuid
246
  in case maybeRPCError of
247
       Just err -> Left err
248
       Nothing  -> Right $ getInstanceStatus uuidResultList pNodeUuid inst
249

  
250
-- | Tries to find out if the node given by the uuid is bad - unreachable or
251
-- returning errors, does not mather for the purpose of this call.
252
getNodeStatus :: [(String, ERpcError RpcResultAllInstancesInfo)]
253
              -> String
254
              -> Maybe RpcError
255
getNodeStatus uuidList uuid =
256
  case snd <$> pickPairUnique uuid uuidList of
257
    Just (Left err) -> Just err
258
    Just (Right _)  -> Nothing
259
    Nothing         -> Just . RpcResultError $
260
                         "Primary node response not present"
261

  
262
-- | Retrieves the instance information if it is present anywhere in the all
263
-- instances RPC result. Notes if it originates from the primary node.
264
-- All nodes are represented as UUID's for ease of use.
265
getInstanceStatus :: [(String, ERpcError RpcResultAllInstancesInfo)]
266
                  -> String
267
                  -> Instance
268
                  -> Maybe LiveInfo
269
getInstanceStatus uuidList pNodeUuid inst =
270
  let primarySearchResult =
271
        snd <$> pickPairUnique pNodeUuid uuidList >>= findInstanceInfo inst
272
  in case primarySearchResult of
273
       Just instInfo -> Just (instInfo, True)
274
       Nothing       ->
275
         let allSearchResult =
276
               getFirst . mconcat $ map
277
               (First . findInstanceInfo inst . snd) uuidList
278
         in case allSearchResult of
279
              Just liveInfo -> Just (liveInfo, False)
280
              Nothing       -> Nothing
56 281

  
57
fieldsMap :: FieldMap Instance NoDataRuntime
58
fieldsMap =
59
  Map.fromList [(fdefName f, v) | v@(f, _, _) <- instanceFields]
282
-- | Collect live data from RPC query if enabled.
283
collectLiveData :: Bool -> ConfigData -> [Instance] -> IO [(Instance, Runtime)]
284
collectLiveData liveDataEnabled cfg instances
285
  | not liveDataEnabled = return . zip instances . repeat . Left .
286
                            RpcResultError $ "Live data disabled"
287
  | otherwise = do
288
      let hvSpec = getDefaultHypervisorSpec cfg
289
          instance_nodes = nub . okNodesOnly $
290
                             map (getNode cfg . instPrimaryNode) instances
291
          good_nodes = nodesWithValidConfig cfg instance_nodes
292
      rpcres <- executeRpcCall good_nodes $ RpcCallAllInstancesInfo [hvSpec]
293
      return . zip instances . map (extractLiveInfo rpcres) $ instances

Also available in: Unified diff