Synnefo » snf-ganeti

    , extendJobReasonTrail

                   , qjReceivedTimestamp = Nothing

-- | Build a timestamp in the format expected by the reason trail (nanoseconds)

-- starting from a JQueue Timestamp.

reasonTrailTimestamp :: Timestamp -> Integer

reasonTrailTimestamp (sec, micro) =

  let sec' = toInteger sec

      micro' = toInteger micro

  in sec' * 1000000000 + micro' * 1000

-- | Append an element to the reason trail of an input opcode.

extendInputOpCodeReasonTrail :: JobId -> Timestamp -> Int -> InputOpCode

                             -> InputOpCode

extendInputOpCodeReasonTrail _ _ _ op@(InvalidOpCode _) = op

extendInputOpCodeReasonTrail jid ts i (ValidOpCode vOp) =

  let metaP = metaParams vOp

      op = metaOpCode vOp

      trail = opReason metaP

      reasonSrc = opReasonSrcID op

      reasonText = "job=" ++ show (fromJobId jid) ++ ";index=" ++ show i

      reason = (reasonSrc, reasonText, reasonTrailTimestamp ts)

      trail' = trail ++ [reason]

  in ValidOpCode $ vOp { metaParams = metaP { opReason = trail' } }

-- | Append an element to the reason trail of a queued opcode.

extendOpCodeReasonTrail :: JobId -> Timestamp -> Int -> QueuedOpCode

                        -> QueuedOpCode

extendOpCodeReasonTrail jid ts i op =

  let inOp = qoInput op

  in op { qoInput = extendInputOpCodeReasonTrail jid ts i inOp }

-- | Append an element to the reason trail of all the OpCodes of a queued job.

extendJobReasonTrail :: QueuedJob -> QueuedJob

extendJobReasonTrail job =

  let jobId = qjId job

      mTimestamp = qjReceivedTimestamp job

      -- This function is going to be called on QueuedJobs that already contain

      -- a timestamp. But for safety reasons we cannot assume mTimestamp will

      -- be (Just timestamp), so we use the value 0 in the extremely unlikely

      -- case this is not true.

      timestamp = fromMaybe (0, 0) mTimestamp

    in job

        { qjOps =

            zipWith (extendOpCodeReasonTrail jobId timestamp) [0..] $

              qjOps job

        }

jobArchivable ts = liftA2 (&&) jobFinalized

              return . Bad $ msg

        Ok (job, _) ->

              case renameResult of