code.grnet.gr Git - ganeti-local/blob - src/Ganeti/Query/Job.hs

   1 {-| Implementation of the Ganeti Query2 job queries.
   2
   3  -}
   4
   5 {-
   6
   7 Copyright (C) 2012 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 module Ganeti.Query.Job
  27   ( RuntimeData
  28   , fieldsMap
  29   , loadRuntimeData
  30   , wantArchived
  31   ) where
  32
  33 import qualified Data.Map as Map
  34 import qualified Text.JSON as J
  35
  36 import Ganeti.BasicTypes
  37 import qualified Ganeti.Constants as C
  38 import Ganeti.JQueue
  39 import Ganeti.Path
  40 import Ganeti.Query.Common
  41 import Ganeti.Query.Language
  42 import Ganeti.Query.Types
  43 import Ganeti.Types
  44
  45 -- | The runtime data for a job.
  46 type RuntimeData = Result (QueuedJob, Bool)
  47
  48 -- | Job priority explanation.
  49 jobPrioDoc :: String
  50 jobPrioDoc = "Current job priority (" ++ show C.opPrioLowest ++ " to " ++
  51              show C.opPrioHighest ++ ")"
  52
  53 -- | Timestamp doc.
  54 tsDoc :: String -> String
  55 tsDoc = (++ " (tuple containing seconds and microseconds)")
  56
  57 -- | Wrapper for unavailable job.
  58 maybeJob :: (J.JSON a) =>
  59             (QueuedJob -> a) -> RuntimeData -> JobId -> ResultEntry
  60 maybeJob _ (Bad _) _      = rsUnavail
  61 maybeJob f (Ok (v, _))  _ = rsNormal $ f v
  62
  63 -- | Wrapper for optional fields that should become unavailable.
  64 maybeJobOpt :: (J.JSON a) =>
  65             (QueuedJob -> Maybe a) -> RuntimeData -> JobId -> ResultEntry
  66 maybeJobOpt _ (Bad _) _      = rsUnavail
  67 maybeJobOpt f (Ok (v, _))  _ = case f v of
  68                                  Nothing -> rsUnavail
  69                                  Just w -> rsNormal w
  70
  71 -- | Simple helper for a job getter.
  72 jobGetter :: (J.JSON a) => (QueuedJob -> a) -> FieldGetter JobId RuntimeData
  73 jobGetter = FieldRuntime . maybeJob
  74
  75 -- | Simple helper for a per-opcode getter.
  76 opsGetter :: (J.JSON a) => (QueuedOpCode -> a) -> FieldGetter JobId RuntimeData
  77 opsGetter f = FieldRuntime $ maybeJob (map f . qjOps)
  78
  79 -- | Simple helper for a per-opcode optional field getter.
  80 opsOptGetter :: (J.JSON a) =>
  81                 (QueuedOpCode -> Maybe a) -> FieldGetter JobId RuntimeData
  82 opsOptGetter f =
  83   FieldRuntime $ maybeJob (map (\qo -> case f qo of
  84                                          Nothing -> J.JSNull
  85                                          Just a -> J.showJSON a) . qjOps)
  86
  87 -- | Archived field name.
  88 archivedField :: String
  89 archivedField = "archived"
  90
  91 -- | Check whether we should look at archived jobs as well.
  92 wantArchived :: [FilterField] -> Bool
  93 wantArchived = (archivedField `elem`)
  94
  95 -- | List of all node fields. FIXME: QFF_JOB_ID on the id field.
  96 jobFields :: FieldList JobId RuntimeData
  97 jobFields =
  98   [ (FieldDefinition "id" "ID" QFTNumber "Job ID", FieldSimple rsNormal,
  99      QffNormal)
 100   , (FieldDefinition "status" "Status" QFTText "Job status",
 101      jobGetter calcJobStatus, QffNormal)
 102   , (FieldDefinition "priority" "Priority" QFTNumber jobPrioDoc,
 103      jobGetter calcJobPriority, QffNormal)
 104   , (FieldDefinition archivedField "Archived" QFTBool
 105        "Whether job is archived",
 106      FieldRuntime (\jinfo _ -> case jinfo of
 107                                  Ok (_, archive) -> rsNormal archive
 108                                  _ -> rsUnavail), QffNormal)
 109   , (FieldDefinition "ops" "OpCodes" QFTOther "List of all opcodes",
 110      opsGetter qoInput, QffNormal)
 111   , (FieldDefinition "opresult" "OpCode_result" QFTOther
 112        "List of opcodes results", opsGetter qoResult, QffNormal)
 113   , (FieldDefinition "opstatus" "OpCode_status" QFTOther
 114        "List of opcodes status", opsGetter qoStatus, QffNormal)
 115   , (FieldDefinition "oplog" "OpCode_log" QFTOther
 116        "List of opcode output logs", opsGetter qoLog, QffNormal)
 117   , (FieldDefinition "opstart" "OpCode_start" QFTOther
 118        "List of opcode start timestamps (before acquiring locks)",
 119      opsOptGetter qoStartTimestamp, QffNormal)
 120   , (FieldDefinition "opexec" "OpCode_exec" QFTOther
 121        "List of opcode execution start timestamps (after acquiring locks)",
 122      opsOptGetter qoExecTimestamp, QffNormal)
 123   , (FieldDefinition "opend" "OpCode_end" QFTOther
 124        "List of opcode execution end timestamps",
 125      opsOptGetter qoEndTimestamp, QffNormal)
 126   , (FieldDefinition "oppriority" "OpCode_prio" QFTOther
 127        "List of opcode priorities", opsGetter qoPriority, QffNormal)
 128   , (FieldDefinition "summary" "Summary" QFTOther
 129        "List of per-opcode summaries",
 130      opsGetter (extractOpSummary . qoInput), QffNormal)
 131   , (FieldDefinition "received_ts" "Received" QFTOther
 132        (tsDoc "Timestamp of when job was received"),
 133      FieldRuntime (maybeJobOpt qjReceivedTimestamp), QffTimestamp)
 134   , (FieldDefinition "start_ts" "Start" QFTOther
 135        (tsDoc "Timestamp of job start"),
 136      FieldRuntime (maybeJobOpt qjStartTimestamp), QffTimestamp)
 137   , (FieldDefinition "end_ts" "End" QFTOther
 138        (tsDoc "Timestamp of job end"),
 139      FieldRuntime (maybeJobOpt qjEndTimestamp), QffTimestamp)
 140   ]
 141
 142 -- | The node fields map.
 143 fieldsMap :: FieldMap JobId RuntimeData
 144 fieldsMap =
 145   Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) jobFields
 146
 147 -- | Load the given jobs from disk.
 148 loadRuntimeData :: [JobId] -> Bool -> IO [RuntimeData]
 149 loadRuntimeData ids archived = do
 150   qdir <- queueDir
 151   mapM (loadJobFromDisk qdir archived) ids