Synnefo » snf-ganeti

{-# LANGUAGE TemplateHaskell #-}

{-| Implementation of the Ganeti error types.

This module implements our error hierarchy. Currently we implement one

identical to the Python one; later we might one to have separate ones

for frontend (clients), master and backend code.

-}

{-

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.Errors

  ( ErrorCode(..)

  , GanetiException(..)

  , ErrorResult

  , errToResult

  , errorExitCode

  , excName

  , formatError

  , ResultG

  , maybeToError

  ) where

import Text.JSON hiding (Result, Ok)

import System.Exit

import Ganeti.THH

import Ganeti.BasicTypes

import qualified Ganeti.Constants as C

-- | Error code types for 'OpPrereqError'.

$(declareSADT "ErrorCode"

  [ ("ECodeResolver",  'C.errorsEcodeResolver)

  , ("ECodeNoRes",     'C.errorsEcodeNores)

  , ("ECodeTempNoRes", 'C.errorsEcodeTempNores)

  , ("ECodeInval",     'C.errorsEcodeInval)

  , ("ECodeState",     'C.errorsEcodeState)

  , ("ECodeNoEnt",     'C.errorsEcodeNoent)

  , ("ECodeExists",    'C.errorsEcodeExists)

  , ("ECodeNotUnique", 'C.errorsEcodeNotunique)

  , ("ECodeFault",     'C.errorsEcodeFault)

  , ("ECodeEnviron",   'C.errorsEcodeEnviron)

  ])

$(makeJSONInstance ''ErrorCode)

$(genException "GanetiException"

  [ ("GenericError", [excErrMsg])

  , ("LockError", [excErrMsg])

  , ("PidFileLockError", [excErrMsg])

  , ("HypervisorError", [excErrMsg])

  , ("ProgrammerError", [excErrMsg])

  , ("BlockDeviceError", [excErrMsg])

  , ("ConfigurationError", [excErrMsg])

  , ("ConfigVersionMismatch", [ ("expVer", [t| Int |])

                              , ("actVer", [t| Int |])])

  , ("ReservationError", [excErrMsg])

  , ("RemoteError", [excErrMsg])

  , ("SignatureError", [excErrMsg])

  , ("ParameterError", [excErrMsg])

  , ("ResultValidationError", [excErrMsg])

  , ("OpPrereqError", [excErrMsg, ("errCode", [t| ErrorCode |])])

  , ("OpExecError", [excErrMsg])

  , ("OpResultError", [excErrMsg])

  , ("OpCodeUnknown", [excErrMsg])

  , ("JobLost", [excErrMsg])

  , ("JobFileCorrupted", [excErrMsg])

  , ("ResolverError", [ ("errHostname", [t| String |])

                      , ("errResolverCode", [t| Int |])

                      , ("errResolverMsg", [t| String |])])

  , ("HooksFailure", [excErrMsg])

  , ("HooksAbort", [("errs", [t| [(String, String, String)] |])])

  , ("UnitParseError", [excErrMsg])

  , ("ParseError", [excErrMsg])

  , ("TypeEnforcementError", [excErrMsg])

  , ("X509CertError", [ ("certFileName", [t| String |])

                      , excErrMsg ])

  , ("TagError", [excErrMsg])

  , ("CommandError", [excErrMsg])

  , ("StorageError", [excErrMsg])

  , ("InotifyError", [excErrMsg])

  , ("JobQueueError", [excErrMsg])

  , ("JobQueueDrainError", [excErrMsg])

  , ("JobQueueFull", [])

  , ("ConfdMagicError", [excErrMsg])

  , ("ConfdClientError", [excErrMsg])

  , ("UdpDataSizeError", [excErrMsg])

  , ("NoCtypesError", [excErrMsg])

  , ("IPAddressError", [excErrMsg])

  , ("LuxiError", [excErrMsg])

  , ("QueryFilterParseError", [excErrMsg]) -- not consistent with Python

  , ("RapiTestResult", [excErrMsg])

  , ("FileStoragePathError", [excErrMsg])

  ])

instance Error GanetiException where

  strMsg = GenericError

instance JSON GanetiException where

  showJSON = saveGanetiException

  readJSON = loadGanetiException

-- | Error monad using 'GanetiException' type alias.

type ErrorResult = GenericResult GanetiException

$(genStrOfOp ''GanetiException "excName")

-- | Returns the exit code of a program that should be used if we got

-- back an exception from masterd.

errorExitCode :: GanetiException -> ExitCode

errorExitCode (ConfigurationError {}) = ExitFailure 2

errorExitCode _ = ExitFailure 1

-- | Formats an exception.

formatError :: GanetiException -> String

formatError (ConfigurationError msg) =

  "Corrup configuration file: " ++ msg ++ "\nAborting."

formatError (HooksAbort errs) =

  unlines $

  "Failure: hooks execution failed:":

  map (\(node, script, out) ->

         "  node: " ++ node ++ ", script: " ++ script ++

                    if null out

                      then " (no output)"

                      else ", output: " ++ out

      ) errs

formatError (HooksFailure msg) =

  "Failure: hooks general failure: " ++ msg

formatError (ResolverError host _ _) =

  -- FIXME: in Python, this uses the system hostname to format the

  -- error differently if we are failing to resolve our own hostname

  "Failure: can't resolve hostname " ++ host

formatError (OpPrereqError msg code) =

  "Failure: prerequisites not met for this" ++

  " operation:\nerror type: " ++ show code ++ ", error details:\n" ++ msg

formatError (OpExecError msg) =

  "Failure: command execution error:\n" ++ msg

formatError (TagError msg) =

  "Failure: invalid tag(s) given:\n" ++ msg

formatError (JobQueueDrainError _)=

  "Failure: the job queue is marked for drain and doesn't accept new requests"

formatError JobQueueFull =

  "Failure: the job queue is full and doesn't accept new" ++

  " job submissions until old jobs are archived"

formatError (TypeEnforcementError msg) =

  "Parameter Error: " ++ msg

formatError (ParameterError msg) =

  "Failure: unknown/wrong parameter name '" ++ msg ++ "'"

formatError (JobLost msg) =

  "Error checking job status: " ++ msg

formatError (QueryFilterParseError msg) =

  -- FIXME: in Python, this has a more complex error message

  "Error while parsing query filter: " ++ msg

formatError (GenericError msg) =

  "Unhandled Ganeti error: " ++ msg

formatError err =

  "Unhandled exception: " ++ show err

-- | A type for IO actions with errors properly handled as

-- 'GanetiException's.

-- TODO: Move to Errors.hs

type ResultG = ResultT GanetiException IO

-- | Convert from an 'ErrorResult' to a standard 'Result'.

errToResult :: ErrorResult a -> Result a

errToResult (Ok a)  = Ok a

errToResult (Bad e) = Bad $ formatError e

-- | Convert from a 'Maybe' to a an 'ErrorResult'.

maybeToError :: String -> Maybe a -> ErrorResult a

maybeToError _ (Just a) = Ok a

maybeToError m  Nothing = Bad $ GenericError m