Synnefo » snf-ganeti

{-| Implementation of the Ganeti Query2 job queries.

 -}

{-

Copyright (C) 2012 Google Inc.

This program is free software; you can redistribute it and/or modify

it under the terms of the GNU General Public License as published by

the Free Software Foundation; either version 2 of the License, or

(at your option) any later version.

This program is distributed in the hope that it will be useful, but

WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

General Public License for more details.

You should have received a copy of the GNU General Public License

along with this program; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA

02110-1301, USA.

-}

module Ganeti.Query.Job

  ( RuntimeData

  , fieldsMap

  , loadRuntimeData

  , wantArchived

  ) where

import qualified Data.Map as Map

import qualified Text.JSON as J

import Ganeti.BasicTypes

import qualified Ganeti.Constants as C

import Ganeti.JQueue

import Ganeti.Path

import Ganeti.Query.Common

import Ganeti.Query.Language

import Ganeti.Query.Types

import Ganeti.Types

-- | The runtime data for a job.

type RuntimeData = Result (QueuedJob, Bool)

-- | Job priority explanation.

jobPrioDoc :: String

jobPrioDoc = "Current job priority (" ++ show C.opPrioLowest ++ " to " ++

             show C.opPrioHighest ++ ")"

-- | Timestamp doc.

tsDoc :: String -> String

tsDoc = (++ " (tuple containing seconds and microseconds)")

-- | Wrapper for unavailable job.

maybeJob :: (J.JSON a) =>

            (QueuedJob -> a) -> RuntimeData -> JobId -> ResultEntry

maybeJob _ (Bad _) _      = rsUnavail

maybeJob f (Ok (v, _))  _ = rsNormal $ f v

-- | Wrapper for optional fields that should become unavailable.

maybeJobOpt :: (J.JSON a) =>

            (QueuedJob -> Maybe a) -> RuntimeData -> JobId -> ResultEntry

maybeJobOpt _ (Bad _) _      = rsUnavail

maybeJobOpt f (Ok (v, _))  _ = case f v of

                                 Nothing -> rsUnavail

                                 Just w -> rsNormal w

-- | Simple helper for a job getter.

jobGetter :: (J.JSON a) => (QueuedJob -> a) -> FieldGetter JobId RuntimeData

jobGetter = FieldRuntime . maybeJob

-- | Simple helper for a per-opcode getter.

opsGetter :: (J.JSON a) => (QueuedOpCode -> a) -> FieldGetter JobId RuntimeData

opsGetter f = FieldRuntime $ maybeJob (map f . qjOps)

-- | Simple helper for a per-opcode optional field getter.

opsOptGetter :: (J.JSON a) =>

                (QueuedOpCode -> Maybe a) -> FieldGetter JobId RuntimeData

opsOptGetter f =

  FieldRuntime $ maybeJob (map (\qo -> case f qo of

                                         Nothing -> J.JSNull

                                         Just a -> J.showJSON a) . qjOps)

-- | Archived field name.

archivedField :: String

archivedField = "archived"

-- | Check whether we should look at archived jobs as well.

wantArchived :: [FilterField] -> Bool

wantArchived = (archivedField `elem`)

-- | List of all node fields. FIXME: QFF_JOB_ID on the id field.

jobFields :: FieldList JobId RuntimeData

jobFields =

  [ (FieldDefinition "id" "ID" QFTNumber "Job ID", FieldSimple rsNormal,

     QffNormal)

  , (FieldDefinition "status" "Status" QFTText "Job status",

     jobGetter calcJobStatus, QffNormal)

  , (FieldDefinition "priority" "Priority" QFTNumber jobPrioDoc,

     jobGetter calcJobPriority, QffNormal)

  , (FieldDefinition archivedField "Archived" QFTBool

       "Whether job is archived",

     FieldRuntime (\jinfo _ -> case jinfo of

                                 Ok (_, archive) -> rsNormal archive

                                 _ -> rsUnavail), QffNormal)

  , (FieldDefinition "ops" "OpCodes" QFTOther "List of all opcodes",

     opsGetter qoInput, QffNormal)

  , (FieldDefinition "opresult" "OpCode_result" QFTOther

       "List of opcodes results", opsGetter qoResult, QffNormal)

  , (FieldDefinition "opstatus" "OpCode_status" QFTOther

       "List of opcodes status", opsGetter qoStatus, QffNormal)

  , (FieldDefinition "oplog" "OpCode_log" QFTOther

       "List of opcode output logs", opsGetter qoLog, QffNormal)

  , (FieldDefinition "opstart" "OpCode_start" QFTOther

       "List of opcode start timestamps (before acquiring locks)",

     opsOptGetter qoStartTimestamp, QffNormal)

  , (FieldDefinition "opexec" "OpCode_exec" QFTOther

       "List of opcode execution start timestamps (after acquiring locks)",

     opsOptGetter qoExecTimestamp, QffNormal)

  , (FieldDefinition "opend" "OpCode_end" QFTOther

       "List of opcode execution end timestamps",

     opsOptGetter qoEndTimestamp, QffNormal)

  , (FieldDefinition "oppriority" "OpCode_prio" QFTOther

       "List of opcode priorities", opsGetter qoPriority, QffNormal)

  , (FieldDefinition "summary" "Summary" QFTOther

       "List of per-opcode summaries",

     opsGetter (extractOpSummary . qoInput), QffNormal)

  , (FieldDefinition "received_ts" "Received" QFTOther

       (tsDoc "Timestamp of when job was received"),

     FieldRuntime (maybeJobOpt qjReceivedTimestamp), QffTimestamp)

  , (FieldDefinition "start_ts" "Start" QFTOther

       (tsDoc "Timestamp of job start"),

     FieldRuntime (maybeJobOpt qjStartTimestamp), QffTimestamp)

  , (FieldDefinition "end_ts" "End" QFTOther

       (tsDoc "Timestamp of job end"),

     FieldRuntime (maybeJobOpt qjEndTimestamp), QffTimestamp)

  ]

-- | The node fields map.

fieldsMap :: FieldMap JobId RuntimeData

fieldsMap =

  Map.fromList $ map (\v@(f, _, _) -> (fdefName f, v)) jobFields

-- | Load the given jobs from disk.

loadRuntimeData :: [JobId] -> Bool -> IO [RuntimeData]

loadRuntimeData ids archived = do

  qdir <- queueDir

  mapM (loadJobFromDisk qdir archived) ids