Synnefo » snf-ganeti

import Control.Monad (forever, when, zipWithM)

handleCall qlock cfg (SubmitManyJobs lops) =

  do

    open <- isQueueOpen

    if not open

      then return . Bad . GenericError $ "Queue drained"

      else do

        result_jobids <- allocateJobIds (Config.getMasterCandidates cfg)

                           qlock (length lops)

        case result_jobids of

          Bad s -> return . Bad . GenericError $ s

          Ok jids -> do

            jobs <- zipWithM queuedJobFromOpCodes jids lops

            qDir <- queueDir

            write_results <- mapM (writeJobToDisk qDir) jobs

            let annotated_results = zip write_results jids

                succeeded = map snd $ filter (isOk . fst) annotated_results

            when (any isBad write_results) . logWarning

              $ "Writing some jobs failed " ++ show annotated_results

            socketpath <- defaultLuxiSocket

            client <- getClient socketpath

            pickupResults <- mapM (flip callMethod client . PickupJob)

                               succeeded

            closeClient client

            when (any isBad pickupResults)

              . logWarning . (++)  "Failed to notify maserd: " . show

              $ zip succeeded pickupResults

            return . Ok . JSArray

              . map (\(res, jid) ->

                      if isOk res

                        then showJSON (True, fromJobId jid)

                        else showJSON (False, genericResult id (const "") res))

              $ annotated_results