module Ganeti.MaintD.FailIncident
( failIncident
) where
import Control.Exception.Lifted (bracket)
import Control.Lens.Setter (over)
import Control.Monad (liftM, when)
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString.UTF8 as UTF8
import Data.IORef (IORef)
import System.IO.Error (tryIOError)
import Ganeti.BasicTypes (ResultT, mkResultT, GenericResult(..))
import qualified Ganeti.Constants as C
import Ganeti.JQueue (currentTimestamp)
import Ganeti.Jobs (execJobsWaitOkJid)
import Ganeti.Logging.Lifted
import qualified Ganeti.Luxi as L
import Ganeti.MaintD.MemoryState (MemoryState, getIncidents, updateIncident)
import Ganeti.MaintD.Utils (annotateOpCode)
import Ganeti.Objects.Lens (incidentJobsL)
import Ganeti.Objects.Maintenance (Incident(..), RepairStatus(..))
import Ganeti.OpCodes (OpCode(..))
import qualified Ganeti.Path as Path
import Ganeti.Types (JobId, fromJobId, TagKind(..))
markAsFailed :: IORef MemoryState -> Incident -> ResultT String IO ()
markAsFailed memstate incident = do
let uuid = incidentUuid incident
newtag = C.maintdFailureTagPrefix ++ UTF8.toString uuid
logInfo $ "Marking incident " ++ UTF8.toString uuid ++ " as failed"
now <- liftIO currentTimestamp
luxiSocket <- liftIO Path.defaultQuerySocket
jids <- bracket (mkResultT . liftM (either (Bad . show) Ok)
. tryIOError $ L.getLuxiClient luxiSocket)
(liftIO . L.closeClient)
(mkResultT . execJobsWaitOkJid
[[ annotateOpCode "marking incident handling as failed" now
. OpTagsSet TagKindNode [ newtag ]
. Just $ incidentNode incident ]])
let incident' = over incidentJobsL (++ jids)
$ incident { incidentRepairStatus = RSFailed
, incidentTag = newtag
}
liftIO $ updateIncident memstate incident'
failIncident :: IORef MemoryState -> JobId -> ResultT String IO ()
failIncident memstate jid = do
incidents <- getIncidents memstate
let affected = filter (elem jid . incidentJobs) incidents
when (null affected) . logInfo
$ "Job " ++ show (fromJobId jid) ++ " does not belong to an incident"
mapM_ (markAsFailed memstate) affected