Synnefo » snf-ganeti

  , InstanceStatus(..)

  , NonEmpty(..)

  , Hypervisor(..)

  ) where

import Data.List (sort)

import Test.QuickCheck as QuickCheck hiding (Result)

import Test.HUnit

import Test.Ganeti.TestHelper

import Test.Ganeti.TestCommon

import Ganeti.BasicTypes

import qualified Ganeti.Constants as C

import Ganeti.Types as Types

{-# ANN module "HLint: ignore Use camelCase" #-}

$(genArbitrary ''FinalizedJobStatus)

-- * Properties

prop_AllocPolicy_serialisation :: AllocPolicy -> Property

                            [minBound..maxBound]

  assertEqual "for FinalizedJobStatus equivalence" all_py_codes all_hs_codes

testSuite "Types"

  [ 'prop_AllocPolicy_serialisation

  , 'prop_DiskTemplate_serialisation

  , 'case_NICMode_pyequiv

  , 'prop_FinalizedJobStatus_serialisation

  , 'case_FinalizedJobStatus_pyequiv

  ]

  , LuxiReq(..)

  , Client

  , JobId

  , RecvResult(..)

  , strOfOp

  , getClient

import Control.Exception (catch)

import Data.IORef

import qualified Data.ByteString as B

import qualified Data.ByteString.UTF8 as UTF8

import Data.Word (Word8)

import Ganeti.Jobs (JobStatus)

import Ganeti.OpParams (pTagsObject)

import Ganeti.OpCodes

import qualified Ganeti.Query.Language as Qlang

import Ganeti.THH

-- * Utility functions

                | RecvOk String     -- ^ Successfull receive

                  deriving (Show, Eq)

-- | Currently supported Luxi operations and JSON serialization.

$(genLuxiOp "LuxiOp"

  [ (luxiReqQuery,

     , simpleField "lock"   [t| Bool     |]

     ])

  , (luxiReqQueryJobs,

     , simpleField "fields" [t| [String] |]

     ])

  , (luxiReqQueryExports,

     [ simpleField "ops" [t| [[OpCode]] |] ]

    )

  , (luxiReqWaitForJobChange,

     , simpleField "fields"   [t| [String]|]

     , simpleField "prev_job" [t| JSValue |]

     , simpleField "prev_log" [t| JSValue |]

     , simpleField "tmout"    [t| Int     |]

     ])

  , (luxiReqArchiveJob,

    )

  , (luxiReqAutoArchiveJobs,

     [ simpleField "age"   [t| Int |]

     , simpleField "tmout" [t| Int |]

     ])

  , (luxiReqCancelJob,

    )

  , (luxiReqChangeJobPriority,

     , simpleField "priority" [t| Int |] ]

    )

  , (luxiReqSetDrainFlag,

decodeCall (LuxiCall call args) =

  case call of

    ReqQueryJobs -> do

              let rargs = map fromJSString jargs

    ReqQueryInstances -> do

              (names, fields, locking) <- fromJVal args

              return $ QueryInstances names fields locking

                    J.readJSON d `ap`

                    J.readJSON e

                  _ -> J.Error "Not enough values"

    ReqArchiveJob -> do

              [jid] <- fromJVal args

    ReqAutoArchiveJobs -> do

              (age, tmout) <- fromJVal args

              return $ AutoArchiveJobs age tmout

              item <- tagObjectFrom kind name

              return $ QueryTags item

    ReqCancelJob -> do

    ReqChangeJobPriority -> do

    ReqSetDrainFlag -> do

              [flag] <- fromJVal args

              return $ SetDrainFlag flag

  let rval = validateResult result

  return rval

-- | Parse job submission result.

parseSubmitJobResult :: JSValue -> ErrorResult JobId

parseSubmitJobResult (JSArray [JSBool True, v]) =

parseSubmitJobResult (JSArray [JSBool False, JSString x]) =

  Bad . LuxiError $ fromJSString x

parseSubmitJobResult v =

  , nICModeToRaw

  , FinalizedJobStatus(..)

  , finalizedJobStatusToRaw

  ) where

import qualified Text.JSON as JSON

import qualified Ganeti.Constants as C

import qualified Ganeti.THH as THH

import Ganeti.JSON

-- * Generic types

  , ("JobStatusFailed",     'C.jobStatusError)

  ])

$(THH.makeJSONInstance ''FinalizedJobStatus)