diff --git a/htest/Test/Ganeti/BasicTypes.hs b/htest/Test/Ganeti/BasicTypes.hs index eacdfbabccf54c57e948da4945a63e60e741e432..d3ae51fbce2abc4f3d23345d06b9b6472c735de8 100644 --- a/htest/Test/Ganeti/BasicTypes.hs +++ b/htest/Test/Ganeti/BasicTypes.hs @@ -73,8 +73,8 @@ prop_applicative_identity v = -- | Tests the applicative composition law (pure (.) <*> u <*> v <*> w -- = u <*> (v <*> w)). -prop_applicative_composition :: (Result (Fun Int Int)) - -> (Result (Fun Int Int)) +prop_applicative_composition :: Result (Fun Int Int) + -> Result (Fun Int Int) -> Result Int -> Property prop_applicative_composition u v w = @@ -85,8 +85,7 @@ prop_applicative_composition u v w = -- | Tests the applicative homomorphism law (pure f <*> pure x = pure (f x)). prop_applicative_homomorphism :: Fun Int Int -> Int -> Property prop_applicative_homomorphism (Fun _ f) x = - ((pure f <*> pure x)::Result Int) ==? - (pure (f x)) + ((pure f <*> pure x)::Result Int) ==? pure (f x) -- | Tests the applicative interchange law (u <*> pure y = pure ($ y) <*> u). prop_applicative_interchange :: Result (Fun Int Int) diff --git a/htest/Test/Ganeti/Daemon.hs b/htest/Test/Ganeti/Daemon.hs index fb6cc757e86d1785ba59c15f095d67d9a94bfd76..b2c6688874fc647e25cc029e86960df0364746ad 100644 --- a/htest/Test/Ganeti/Daemon.hs +++ b/htest/Test/Ganeti/Daemon.hs @@ -38,6 +38,8 @@ import Test.Ganeti.Common import Ganeti.Common import Ganeti.Daemon as Daemon +{-# ANN module "HLint: ignore Use camelCase" #-} + -- | Test a few string arguments. prop_string_arg :: String -> Property prop_string_arg argument = @@ -65,7 +67,7 @@ case_bool_arg = -- | Tests a few invalid arguments. case_wrong_arg :: Assertion -case_wrong_arg = do +case_wrong_arg = mapM_ (passFailOpt defaultOptions assertFailure (return ())) [ (oSyslogUsage, "foo", "yes") , (oPort 0, "x", "10") diff --git a/htest/Test/Ganeti/HTools/CLI.hs b/htest/Test/Ganeti/HTools/CLI.hs index b7493d4936845cb4321926a7df53d5648974ded6..468ca56f68950c0510a32adf05c35869f2e814f0 100644 --- a/htest/Test/Ganeti/HTools/CLI.hs +++ b/htest/Test/Ganeti/HTools/CLI.hs @@ -43,6 +43,8 @@ import Ganeti.HTools.CLI as CLI import qualified Ganeti.HTools.Program as Program import qualified Ganeti.HTools.Types as Types +{-# ANN module "HLint: ignore Use camelCase" #-} + -- | Test correct parsing. prop_parseISpec :: String -> Int -> Int -> Int -> Property prop_parseISpec descr dsk mem cpu = @@ -52,7 +54,7 @@ prop_parseISpec descr dsk mem cpu = -- | Test parsing failure due to wrong section count. prop_parseISpecFail :: String -> Property prop_parseISpecFail descr = - forAll (choose (0,100) `suchThat` ((/=) 3)) $ \nelems -> + forAll (choose (0,100) `suchThat` (/= 3)) $ \nelems -> forAll (replicateM nelems arbitrary) $ \values -> let str = intercalate "," $ map show (values::[Int]) in case parseISpecString descr str of @@ -101,7 +103,7 @@ case_bool_arg = -- | Tests a few invalid arguments. case_wrong_arg :: Assertion -case_wrong_arg = do +case_wrong_arg = mapM_ (passFailOpt defaultOptions assertFailure (return ())) [ (oSpindleUse, "-1", "1") , (oSpindleUse, "a", "1") diff --git a/htest/Test/Ganeti/HTools/Cluster.hs b/htest/Test/Ganeti/HTools/Cluster.hs index a779a521644a0a07ce358f41cb6926d844c4bfc8..60b771dae465e44b4283a108c63d30a01f450830 100644 --- a/htest/Test/Ganeti/HTools/Cluster.hs +++ b/htest/Test/Ganeti/HTools/Cluster.hs @@ -47,6 +47,8 @@ import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Types as Types +{-# ANN module "HLint: ignore Use camelCase" #-} + -- * Helpers -- | Make a small cluster, both nodes and instances. @@ -148,7 +150,7 @@ prop_Alloc_sane inst = prop_CanTieredAlloc :: Instance.Instance -> Property prop_CanTieredAlloc inst = forAll (choose (2, 5)) $ \count -> - forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node -> + forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> let nl = makeSmallCluster node count il = Container.empty rqnodes = Instance.requiredNodes $ Instance.diskTemplate inst @@ -196,7 +198,7 @@ genClusterAlloc count node inst = prop_AllocRelocate :: Property prop_AllocRelocate = forAll (choose (4, 8)) $ \count -> - forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node -> + forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> case genClusterAlloc count node inst of Types.Bad msg -> failTest msg @@ -230,7 +232,7 @@ check_EvacMode grp inst result = (gdx == Group.idx grp) v -> failmsg ("invalid solution: " ++ show v) False where failmsg :: String -> Bool -> Property - failmsg = \msg -> printTestCase ("Failed to evacuate: " ++ msg) + failmsg msg = printTestCase ("Failed to evacuate: " ++ msg) idx = Instance.idx inst -- | Checks that on a 4-8 node cluster, once we allocate an instance, @@ -238,7 +240,7 @@ check_EvacMode grp inst result = prop_AllocEvacuate :: Property prop_AllocEvacuate = forAll (choose (4, 8)) $ \count -> - forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node -> + forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> case genClusterAlloc count node inst of Types.Bad msg -> failTest msg @@ -255,7 +257,7 @@ prop_AllocEvacuate = prop_AllocChangeGroup :: Property prop_AllocChangeGroup = forAll (choose (4, 8)) $ \count -> - forAll (genOnlineNode `suchThat` (isNodeBig 4)) $ \node -> + forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> case genClusterAlloc count node inst of Types.Bad msg -> failTest msg @@ -327,7 +329,7 @@ prop_SplitCluster node inst = canAllocOn :: Node.List -> Int -> Instance.Instance -> Bool canAllocOn nl reqnodes inst = case Cluster.genAllocNodes defGroupList nl reqnodes True >>= - Cluster.tryAlloc nl (Container.empty) inst of + Cluster.tryAlloc nl Container.empty inst of Types.Bad _ -> False Types.Ok as -> case Cluster.asSolution as of @@ -344,7 +346,7 @@ prop_AllocPolicy node = -- rqn is the required nodes (1 or 2) forAll (choose (1, 2)) $ \rqn -> forAll (choose (5, 20)) $ \count -> - forAll (arbitrary `suchThat` (canAllocOn (makeSmallCluster node count) rqn)) + forAll (arbitrary `suchThat` canAllocOn (makeSmallCluster node count) rqn) $ \inst -> forAll (arbitrary `suchThat` (isFailure . Instance.instMatchesPolicy inst)) $ \ipol -> diff --git a/htest/Test/Ganeti/HTools/Node.hs b/htest/Test/Ganeti/HTools/Node.hs index ddf6a994499f2ffa591a5fb680e8b264a7ce1076..1230fad413f8f0711bedb82ebb1d55cdacefa34f 100644 --- a/htest/Test/Ganeti/HTools/Node.hs +++ b/htest/Test/Ganeti/HTools/Node.hs @@ -85,7 +85,7 @@ genNode min_multiplier max_multiplier = do -- | Helper function to generate a sane node. genOnlineNode :: Gen Node.Node -genOnlineNode = do +genOnlineNode = arbitrary `suchThat` (\n -> not (Node.offline n) && not (Node.failN1 n) && Node.availDisk n > 0 && diff --git a/htest/Test/Ganeti/HTools/Text.hs b/htest/Test/Ganeti/HTools/Text.hs index 844810b90e7744a03d820844e069ae8763cc8104..c1c23c51786072e136c4d4704fe98cff4fce4036 100644 --- a/htest/Test/Ganeti/HTools/Text.hs +++ b/htest/Test/Ganeti/HTools/Text.hs @@ -53,7 +53,7 @@ import qualified Ganeti.HTools.Utils as Utils -- * Instance text loader tests prop_Load_Instance :: String -> Int -> Int -> Int -> Types.InstanceStatus - -> NonEmptyList Char -> [Char] + -> NonEmptyList Char -> String -> NonNegative Int -> NonNegative Int -> Bool -> Types.DiskTemplate -> Int -> Property prop_Load_Instance name mem dsk vcpus status diff --git a/htest/Test/Ganeti/HTools/Utils.hs b/htest/Test/Ganeti/HTools/Utils.hs index c22c999e6d9ce91bf8e88560b35f28e18b7ba2b6..abb3e32fdc32e1819623cfa16741f956781ce5d3 100644 --- a/htest/Test/Ganeti/HTools/Utils.hs +++ b/htest/Test/Ganeti/HTools/Utils.hs @@ -40,21 +40,21 @@ import qualified Ganeti.HTools.Types as Types import qualified Ganeti.HTools.Utils as Utils -- | Helper to generate a small string that doesn't contain commas. -genNonCommaString :: Gen [Char] +genNonCommaString :: Gen String genNonCommaString = do size <- choose (0, 20) -- arbitrary max size - vectorOf size (arbitrary `suchThat` ((/=) ',')) + vectorOf size (arbitrary `suchThat` (/=) ',') -- | If the list is not just an empty element, and if the elements do -- not contain commas, then join+split should be idempotent. prop_commaJoinSplit :: Property prop_commaJoinSplit = forAll (choose (0, 20)) $ \llen -> - forAll (vectorOf llen genNonCommaString `suchThat` ((/=) [""])) $ \lst -> + forAll (vectorOf llen genNonCommaString `suchThat` (/=) [""]) $ \lst -> Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst -- | Split and join should always be idempotent. -prop_commaSplitJoin :: [Char] -> Property +prop_commaSplitJoin :: String -> Property prop_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) ==? s diff --git a/htest/Test/Ganeti/Luxi.hs b/htest/Test/Ganeti/Luxi.hs index dea4d5f103e2749370b36ea32a6c547597aba96b..09b829a6aac3b926be0ee3cb4e3e7a345279fa04 100644 --- a/htest/Test/Ganeti/Luxi.hs +++ b/htest/Test/Ganeti/Luxi.hs @@ -58,21 +58,21 @@ instance Arbitrary Luxi.LuxiOp where case lreq of Luxi.ReqQuery -> Luxi.Query <$> arbitrary <*> getFields <*> genFilter Luxi.ReqQueryFields -> Luxi.QueryFields <$> arbitrary <*> getFields - Luxi.ReqQueryNodes -> Luxi.QueryNodes <$> (listOf getFQDN) <*> + Luxi.ReqQueryNodes -> Luxi.QueryNodes <$> listOf getFQDN <*> getFields <*> arbitrary Luxi.ReqQueryGroups -> Luxi.QueryGroups <$> arbitrary <*> arbitrary <*> arbitrary - Luxi.ReqQueryInstances -> Luxi.QueryInstances <$> (listOf getFQDN) <*> + Luxi.ReqQueryInstances -> Luxi.QueryInstances <$> listOf getFQDN <*> getFields <*> arbitrary Luxi.ReqQueryJobs -> Luxi.QueryJobs <$> arbitrary <*> getFields Luxi.ReqQueryExports -> Luxi.QueryExports <$> - (listOf getFQDN) <*> arbitrary + listOf getFQDN <*> arbitrary Luxi.ReqQueryConfigValues -> Luxi.QueryConfigValues <$> getFields Luxi.ReqQueryClusterInfo -> pure Luxi.QueryClusterInfo Luxi.ReqQueryTags -> Luxi.QueryTags <$> arbitrary <*> getFQDN - Luxi.ReqSubmitJob -> Luxi.SubmitJob <$> (resize maxOpCodes arbitrary) + Luxi.ReqSubmitJob -> Luxi.SubmitJob <$> resize maxOpCodes arbitrary Luxi.ReqSubmitManyJobs -> Luxi.SubmitManyJobs <$> - (resize maxOpCodes arbitrary) + resize maxOpCodes arbitrary Luxi.ReqWaitForJobChange -> Luxi.WaitForJobChange <$> arbitrary <*> getFields <*> pure J.JSNull <*> pure J.JSNull <*> arbitrary @@ -116,7 +116,7 @@ luxiClientPong c = prop_ClientServer :: [[DNSChar]] -> Property prop_ClientServer dnschars = monadicIO $ do let msgs = map (map dnsGetChar) dnschars - fpath <- run $ getTempFileName + fpath <- run getTempFileName -- we need to create the server first, otherwise (if we do it in the -- forked thread) the client could try to connect to it before it's -- ready @@ -131,7 +131,7 @@ prop_ClientServer dnschars = monadicIO $ do bracket (Luxi.getClient fpath) Luxi.closeClient - (\c -> luxiClientPong c msgs) + (`luxiClientPong` msgs) stop $ replies ==? msgs testSuite "Luxi" diff --git a/htest/Test/Ganeti/Objects.hs b/htest/Test/Ganeti/Objects.hs index 6b2c345e43688ae8dd156575b25d887957361918..9835d57ca62418b3633cb3cecaea1a8a88606ea1 100644 --- a/htest/Test/Ganeti/Objects.hs +++ b/htest/Test/Ganeti/Objects.hs @@ -47,6 +47,8 @@ import qualified Ganeti.Constants as C import Ganeti.Objects as Objects import Ganeti.JSON +{-# ANN module "HLint: ignore Use camelCase" #-} + -- * Arbitrary instances $(genArbitrary ''Hypervisor) @@ -79,7 +81,7 @@ instance Arbitrary DiskLogicalId where -- properties, we only generate disks with no children (FIXME), as -- generating recursive datastructures is a bit more work. instance Arbitrary Disk where - arbitrary = Disk <$> arbitrary <*> (pure []) <*> arbitrary + arbitrary = Disk <$> arbitrary <*> pure [] <*> arbitrary <*> arbitrary <*> arbitrary -- FIXME: we should generate proper values, >=0, etc., but this is @@ -102,9 +104,9 @@ instance Arbitrary Instance where <$> getFQDN <*> getFQDN <*> getFQDN -- OS name, but... <*> arbitrary -- FIXME: add non-empty hvparams when they're a proper type - <*> (pure $ Container Map.empty) <*> arbitrary + <*> pure (Container Map.empty) <*> arbitrary -- ... and for OSParams - <*> (pure $ Container Map.empty) <*> arbitrary <*> arbitrary + <*> pure (Container Map.empty) <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -- ts <*> arbitrary <*> arbitrary @@ -127,7 +129,7 @@ $(genArbitrary ''PartialIPolicy) -- validation rules. instance Arbitrary NodeGroup where arbitrary = NodeGroup <$> getFQDN <*> pure [] <*> arbitrary <*> arbitrary - <*> arbitrary <*> (pure $ Container Map.empty) + <*> arbitrary <*> pure (Container Map.empty) -- ts <*> arbitrary <*> arbitrary -- uuid @@ -181,7 +183,7 @@ genEmptyCluster ncount = do nodeName = nodeName n ++ show idx }) nodes [(1::Int)..] contnodes = Container . Map.fromList $ map (\n -> (nodeName n, n)) nodes' - continsts = Container $ Map.empty + continsts = Container Map.empty grp <- arbitrary let contgroups = Container $ Map.singleton guuid grp serial <- arbitrary diff --git a/htest/Test/Ganeti/OpCodes.hs b/htest/Test/Ganeti/OpCodes.hs index 93abaf18367e4274716742af42e0a626e9b2cf1f..43a0e0ec7f3f920bed88ab1b1f5bdaeec8fe9fc4 100644 --- a/htest/Test/Ganeti/OpCodes.hs +++ b/htest/Test/Ganeti/OpCodes.hs @@ -44,6 +44,8 @@ import Test.Ganeti.TestCommon import qualified Ganeti.Constants as C import qualified Ganeti.OpCodes as OpCodes +{-# ANN module "HLint: ignore Use camelCase" #-} + -- * Arbitrary instances $(genArbitrary ''OpCodes.ReplaceDisksMode) @@ -125,7 +127,7 @@ case_py_compat = do \encoded = [op.__getstate__() for op in decoded]\n\ \print serializer.Dump(encoded)" serialized >>= checkPythonResult - let deserialised = (J.decode py_stdout::J.Result [OpCodes.OpCode]) + let deserialised = J.decode py_stdout::J.Result [OpCodes.OpCode] decoded <- case deserialised of J.Ok ops -> return ops J.Error msg -> diff --git a/htest/Test/Ganeti/Query/Language.hs b/htest/Test/Ganeti/Query/Language.hs index ce5e95c02d82b8cc56be1f7ab84e3775b04519c5..5c4cd5cfb792418a2accfdee6cc8dc9c4e063a4c 100644 --- a/htest/Test/Ganeti/Query/Language.hs +++ b/htest/Test/Ganeti/Query/Language.hs @@ -65,7 +65,7 @@ genFilter' 0 = where value = oneof [ QuotedString <$> getName , NumericValue <$> arbitrary ] -genFilter' n = do +genFilter' n = oneof [ AndFilter <$> vectorOf n'' (genFilter' n') , OrFilter <$> vectorOf n'' (genFilter' n') , NotFilter <$> genFilter' n' @@ -92,7 +92,7 @@ $(genArbitrary ''FieldDefinition) -- recursive ones, and not 'JSNull', which we can't use in a -- 'RSNormal' 'ResultEntry'. genJSValue :: Gen JSValue -genJSValue = do +genJSValue = oneof [ JSBool <$> arbitrary , JSRational <$> pure False <*> arbitrary , JSString <$> (toJSString <$> arbitrary) diff --git a/htest/Test/Ganeti/Query/Query.hs b/htest/Test/Ganeti/Query/Query.hs index 1e20cc3d5643b4d9cafa5e8214ad0d64f0f7def8..8ff304b17f285a46fd8832d6a8db1110b02cc9ab 100644 --- a/htest/Test/Ganeti/Query/Query.hs +++ b/htest/Test/Ganeti/Query/Query.hs @@ -47,6 +47,8 @@ import Ganeti.Query.Language import Ganeti.Query.Node import Ganeti.Query.Query +{-# ANN module "HLint: ignore Use camelCase" #-} + -- * Helpers -- | Checks if a list of field definitions contains unknown fields. @@ -77,7 +79,7 @@ prop_queryNode_noUnknown = prop_queryNode_Unknown :: Property prop_queryNode_Unknown = forAll (choose (0, maxNodes) >>= genEmptyCluster) $ \cluster -> - forAll (arbitrary `suchThat` (`notElem` (Map.keys nodeFieldsMap))) + forAll (arbitrary `suchThat` (`notElem` Map.keys nodeFieldsMap)) $ \field -> monadicIO $ do QueryResult fdefs fdata <- run (query cluster (Query QRNode [field] EmptyFilter)) >>= resultProp diff --git a/htest/Test/Ganeti/TestCommon.hs b/htest/Test/Ganeti/TestCommon.hs index 4861a46749c58c0fc15cd166af5b4661852fd755..27796fcf991eda74c1b89d45e1e9436645a6aaeb 100644 --- a/htest/Test/Ganeti/TestCommon.hs +++ b/htest/Test/Ganeti/TestCommon.hs @@ -149,7 +149,7 @@ newtype TagChar = TagChar { tagGetChar :: Char } -- | All valid tag chars. This doesn't need to match _exactly_ -- Ganeti's own tag regex, just enough for it to be close. -tagChar :: [Char] +tagChar :: String tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-" instance Arbitrary TagChar where diff --git a/htest/Test/Ganeti/TestHelper.hs b/htest/Test/Ganeti/TestHelper.hs index 17a1f9b465b8ffc48a662574cdee9edab730e4e9..9fe9dbf3e74c3492b2e42382c9027033e832c249 100644 --- a/htest/Test/Ganeti/TestHelper.hs +++ b/htest/Test/Ganeti/TestHelper.hs @@ -95,7 +95,7 @@ mkConsArbitrary :: (Name, [a]) -> Exp mkConsArbitrary (name, types) = let infix_arb a = InfixE (Just a) (VarE '(<*>)) (Just (VarE 'arbitrary)) constr = AppE (VarE 'pure) (ConE name) - in foldl (\a _ -> infix_arb a) (constr) types + in foldl (\a _ -> infix_arb a) constr types -- | Extracts the name and the types from a constructor. conInfo :: Con -> (Name, [Type]) @@ -108,7 +108,7 @@ conInfo (ForallC _ _ subcon) = conInfo subcon mkRegularArbitrary :: Name -> [Con] -> Q [Dec] mkRegularArbitrary name cons = do expr <- case cons of - [] -> fail $ "Can't make Arbitrary instance for an empty data type" + [] -> fail "Can't make Arbitrary instance for an empty data type" [x] -> return $ mkConsArbitrary (conInfo x) xs -> appE (varE 'oneof) $ listE (map (return . mkConsArbitrary . conInfo) xs) diff --git a/htools/Ganeti/Common.hs b/htools/Ganeti/Common.hs index 8b10230c08e1d0ab3ed14b6e1184d5d95610c50f..43caf278b2f6467f630ec4f458d2cf9372ed1a19 100644 --- a/htools/Ganeti/Common.hs +++ b/htools/Ganeti/Common.hs @@ -99,10 +99,10 @@ reqWithConversion :: (String -> Result a) -> (a -> b -> Result b) -> String -> ArgDescr (b -> Result b) -reqWithConversion conversion_fn updater_fn metavar = +reqWithConversion conversion_fn updater_fn = ReqArg (\string_opt opts -> do parsed_value <- conversion_fn string_opt - updater_fn parsed_value opts) metavar + updater_fn parsed_value opts) -- | Command line parser, using a generic 'Options' structure. parseOpts :: (StandardOptions a) => diff --git a/htools/Ganeti/Confd.hs b/htools/Ganeti/Confd.hs index 37ad521133f29596c847d44b6a185c08aa288866..6746f869073b914062ad8e6b6f6e3852b46de7c4 100644 --- a/htools/Ganeti/Confd.hs +++ b/htools/Ganeti/Confd.hs @@ -146,7 +146,7 @@ $(declareIADT "ConfdErrorType" ]) $(makeJSONInstance ''ConfdErrorType) -$(buildObject "ConfdRequest" "confdRq" $ +$(buildObject "ConfdRequest" "confdRq" [ simpleField "protocol" [t| Int |] , simpleField "type" [t| ConfdRequestType |] , defaultField [| EmptyQuery |] $ simpleField "query" [t| ConfdQuery |] diff --git a/htools/Ganeti/Confd/Server.hs b/htools/Ganeti/Confd/Server.hs index f0999b374d14e5453d26ea3984de1eed0a4ee456..6bedee94a7af92d59d90d914268691b630a33a2b 100644 --- a/htools/Ganeti/Confd/Server.hs +++ b/htools/Ganeti/Confd/Server.hs @@ -286,7 +286,7 @@ updateConfig path r = do -- | Wrapper over 'updateConfig' that handles IO errors. safeUpdateConfig :: FilePath -> FStat -> CRef -> IO (FStat, ConfigReload) -safeUpdateConfig path oldfstat cref = do +safeUpdateConfig path oldfstat cref = catch (do nt <- needsReload oldfstat path case nt of @@ -410,7 +410,7 @@ onReloadInner inotiaction path cref -- This tries to setup the watch descriptor; in case of any IO errors, -- it will return False. addNotifier :: INotify -> FilePath -> CRef -> MVar ServerState -> IO Bool -addNotifier inotify path cref mstate = do +addNotifier inotify path cref mstate = catch (addWatch inotify [CloseWrite] path (onInotify inotify path cref mstate) >> return True) (\e -> const (return False) (e::IOError)) @@ -430,9 +430,9 @@ onInotify inotify path cref mstate Ignored = do path cref mstate return state' { reloadModel = mode } -onInotify inotify path cref mstate _ = do +onInotify inotify path cref mstate _ = modifyMVar_ mstate $ \state -> - if (reloadModel state == ReloadNotify) + if reloadModel state == ReloadNotify then do ctime <- getCurrentTime (newfstat, _) <- safeUpdateConfig path (reloadFStat state) cref @@ -481,7 +481,7 @@ listener :: S.Socket -> HashKey listener s hmac resp = do (msg, _, peer) <- S.recvFrom s 4096 if confdMagicFourcc `isPrefixOf` msg - then (forkIO $ resp s hmac (drop 4 msg) peer) >> return () + then forkIO (resp s hmac (drop 4 msg) peer) >> return () else logDebug "Invalid magic code!" >> return () return () diff --git a/htools/Ganeti/Confd/Utils.hs b/htools/Ganeti/Confd/Utils.hs index b121f0ae82f85776c57a2e673aef451bab31c299..180e327255821edf8a5bfb4857056dd7912bd735 100644 --- a/htools/Ganeti/Confd/Utils.hs +++ b/htools/Ganeti/Confd/Utils.hs @@ -63,7 +63,7 @@ parseMessage :: HashKey -> String -> Integer parseMessage hmac msg curtime = do (salt, origmsg, request) <- parseRequest hmac msg ts <- tryRead "Parsing timestamp" salt::Result Integer - if (abs (ts - curtime) > (fromIntegral C.confdMaxClockSkew)) + if abs (ts - curtime) > fromIntegral C.confdMaxClockSkew then fail "Too old/too new timestamp or clock skew" else return (origmsg, request) diff --git a/htools/Ganeti/Config.hs b/htools/Ganeti/Config.hs index 54b9f465dfb03bce71d963c52866b46fc088232f..49a3f03fac00f0fde84377fadbee944ade4446ec 100644 --- a/htools/Ganeti/Config.hs +++ b/htools/Ganeti/Config.hs @@ -111,7 +111,7 @@ getNodeInstances cfg nname = -- | Computes the role of a node. getNodeRole :: ConfigData -> Node -> NodeRole getNodeRole cfg node - | nodeName node == (clusterMasterNode $ configCluster cfg) = NRMaster + | nodeName node == clusterMasterNode (configCluster cfg) = NRMaster | nodeMasterCandidate node = NRCandidate | nodeDrained node = NRDrained | nodeOffline node = NROffline @@ -133,7 +133,7 @@ getInstancesIpByLink linkipmap link = getItem :: String -> String -> M.Map String a -> Result a getItem kind name allitems = do let lresult = lookupName (M.keys allitems) name - err = \details -> Bad $ kind ++ " name " ++ name ++ " " ++ details + err msg = Bad $ kind ++ " name " ++ name ++ " " ++ msg fullname <- case lrMatchPriority lresult of PartialMatch -> Ok $ lrContent lresult ExactMatch -> Ok $ lrContent lresult @@ -160,7 +160,7 @@ getGroup cfg name = -- if not found by uuid, we need to look it up by name, slow Ok grp -> Ok grp Bad _ -> let by_name = M.mapKeys - (\k -> groupName ((M.!) groups k )) groups + (groupName . (M.!) groups) groups in getItem "NodeGroup" name by_name -- | Computes a node group's node params. @@ -232,7 +232,7 @@ buildLinkIpInstnameMap cfg = link = nicpLink fparams in case nicIp nic of Nothing -> accum - Just ip -> let oldipmap = M.findWithDefault (M.empty) + Just ip -> let oldipmap = M.findWithDefault M.empty link accum newipmap = M.insert ip iname oldipmap in M.insert link newipmap accum diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs index 2296ef010497da01e0179df76b883fba62dc30b4..f54a8cca6fecaff757f766cb6c1598a174ddab4a 100644 --- a/htools/Ganeti/Daemon.hs +++ b/htools/Ganeti/Daemon.hs @@ -105,8 +105,8 @@ defaultOptions = DaemonOptions instance StandardOptions DaemonOptions where helpRequested = optShowHelp verRequested = optShowVer - requestHelp = \opts -> opts { optShowHelp = True } - requestVer = \opts -> opts { optShowVer = True } + requestHelp o = o { optShowHelp = True } + requestVer o = o { optShowVer = True } -- | Abrreviation for the option type. type OptType = GenericOptType DaemonOptions @@ -176,14 +176,14 @@ formatIOError msg err = msg ++ ": " ++ show err -- | Wrapper over '_writePidFile' that transforms IO exceptions into a -- 'Bad' value. writePidFile :: FilePath -> IO (Result Fd) -writePidFile path = do +writePidFile path = catch (fmap Ok $ _writePidFile path) (return . Bad . formatIOError "Failure during writing of the pid file") -- | Helper function to ensure a socket doesn't exist. Should only be -- called once we have locked the pid file successfully. cleanupSocket :: FilePath -> IO () -cleanupSocket socketPath = do +cleanupSocket socketPath = catchJust (guard . isDoesNotExistError) (removeLink socketPath) (const $ return ()) @@ -217,11 +217,11 @@ defaultBindAddr :: Int -- ^ The port we want -> Socket.Family -- ^ The cluster IP family -> Result (Socket.Family, Socket.SockAddr) defaultBindAddr port Socket.AF_INET = - Ok $ (Socket.AF_INET, - Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY) + Ok (Socket.AF_INET, + Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY) defaultBindAddr port Socket.AF_INET6 = - Ok $ (Socket.AF_INET6, - Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0) + Ok (Socket.AF_INET6, + Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0) defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam -- | Default hints for the resolver @@ -236,7 +236,7 @@ resolveAddr port str = do resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port)) return $ case resolved of [] -> Bad "Invalid results from lookup?" - best:_ -> Ok $ (Socket.addrFamily best, Socket.addrAddress best) + best:_ -> Ok (Socket.addrFamily best, Socket.addrAddress best) -- | Based on the options, compute the socket address to use for the -- daemon. @@ -246,11 +246,10 @@ parseAddress :: DaemonOptions -- ^ Command line options parseAddress opts defport = do let port = maybe defport fromIntegral $ optPort opts def_family <- Ssconf.getPrimaryIPFamily Nothing - ainfo <- case optBindAddress opts of - Nothing -> return (def_family >>= defaultBindAddr port) - Just saddr -> catch (resolveAddr port saddr) - (annotateIOError $ "Invalid address " ++ saddr) - return ainfo + case optBindAddress opts of + Nothing -> return (def_family >>= defaultBindAddr port) + Just saddr -> catch (resolveAddr port saddr) + (annotateIOError $ "Invalid address " ++ saddr) -- | Run an I/O action as a daemon. -- diff --git a/htools/Ganeti/HTools/CLI.hs b/htools/Ganeti/HTools/CLI.hs index ec2a299d7d17d03d85740f576513c3b7f57a9ef8..056149035f9dd04eda295961166964bd41b24b2b 100644 --- a/htools/Ganeti/HTools/CLI.hs +++ b/htools/Ganeti/HTools/CLI.hs @@ -199,8 +199,8 @@ type OptType = GenericOptType Options instance StandardOptions Options where helpRequested = optShowHelp verRequested = optShowVer - requestHelp = \opts -> opts { optShowHelp = True } - requestVer = \opts -> opts { optShowVer = True } + requestHelp o = o { optShowHelp = True } + requestVer o = o { optShowVer = True } -- * Helper functions @@ -539,7 +539,7 @@ setNodeStatus opts fixed_nl = do m_cpu = optMcpu opts m_dsk = optMdsk opts - unless (null offline_wrong) $ do + unless (null offline_wrong) . exitErr $ printf "wrong node name(s) set as offline: %s\n" (commaJoin (map lrContent offline_wrong)) let setMCpuFn = case m_cpu of diff --git a/htools/Ganeti/HTools/Instance.hs b/htools/Ganeti/HTools/Instance.hs index 76465cee4e8152e7b6c2ab84dfd60e145e338b91..9d135566ea015d9cdaa42002b30a656a62363fd3 100644 --- a/htools/Ganeti/HTools/Instance.hs +++ b/htools/Ganeti/HTools/Instance.hs @@ -276,7 +276,7 @@ instMatchesPolicy :: Instance -> T.IPolicy -> T.OpResult () instMatchesPolicy inst ipol = do instAboveISpec inst (T.iPolicyMinSpec ipol) instBelowISpec inst (T.iPolicyMaxSpec ipol) - if (diskTemplate inst `elem` T.iPolicyDiskTemplates ipol) + if diskTemplate inst `elem` T.iPolicyDiskTemplates ipol then T.OpGood () else T.OpFail T.FailDisk diff --git a/htools/Ganeti/HTools/Luxi.hs b/htools/Ganeti/HTools/Luxi.hs index ae46e4e140d2e63c5e501e090e61f21be04076dd..f7a435ae938354b81ae225dbc6300ec318bf2eb1 100644 --- a/htools/Ganeti/HTools/Luxi.hs +++ b/htools/Ganeti/HTools/Luxi.hs @@ -212,7 +212,7 @@ getClusterData (JSObject obj) = do cpol <- tryFromObj errmsg obj' "ipolicy" return (ctags, cpol) -getClusterData _ = Bad $ "Cannot parse cluster info, not a JSON record" +getClusterData _ = Bad "Cannot parse cluster info, not a JSON record" -- | Parses the cluster groups. getGroups :: JSValue -> Result [(String, Group.Group)] diff --git a/htools/Ganeti/HTools/Program/Hcheck.hs b/htools/Ganeti/HTools/Program/Hcheck.hs index 6b0da7d00d8027a5015033a2dfa2f58df2725b54..ac47da2d81eeff439204feb803a99d61c9901712 100644 --- a/htools/Ganeti/HTools/Program/Hcheck.hs +++ b/htools/Ganeti/HTools/Program/Hcheck.hs @@ -158,8 +158,8 @@ printBool False b = show b -- readable mode). printGroupsMappings :: Group.List -> IO () printGroupsMappings gl = do - let extract_vals = \g -> (printf "GROUP_UUID_%d" $ Group.idx g :: String, - Group.uuid g) + let extract_vals g = (printf "GROUP_UUID_%d" $ Group.idx g :: String, + Group.uuid g) printpairs = map extract_vals (Container.elems gl) printKeysHTC printpairs diff --git a/htools/Ganeti/HTools/Program/Hinfo.hs b/htools/Ganeti/HTools/Program/Hinfo.hs index 548443bee768cb1108fea8a03687a6dce4d1a1bf..163c7f81266e05ad61fba68753afd3ac9dcce11f 100644 --- a/htools/Ganeti/HTools/Program/Hinfo.hs +++ b/htools/Ganeti/HTools/Program/Hinfo.hs @@ -104,9 +104,9 @@ showGroupInfo verbose gl nl il = do splitInstancesInfo :: Int -> Node.List -> Instance.List -> IO () splitInstancesInfo verbose nl il = do let split_insts = Cluster.findSplitInstances nl il - if (null split_insts) + if null split_insts then - when (verbose > 1) $ do + when (verbose > 1) $ putStrLn "No split instances found"::IO () else do putStrLn "Found instances belonging to multiple node groups:" @@ -115,12 +115,12 @@ splitInstancesInfo verbose nl il = do -- | Print common (interesting) information. commonInfo :: Int -> Group.List -> Node.List -> Instance.List -> IO () commonInfo verbose gl nl il = do - when (Container.null il && verbose > 1) $ do - printf "Cluster is empty.\n"::IO () + when (Container.null il && verbose > 1) $ + printf "Cluster is empty.\n"::IO () - let nl_size = (Container.size nl) - il_size = (Container.size il) - gl_size = (Container.size gl) + let nl_size = Container.size nl + il_size = Container.size il + gl_size = Container.size gl printf "Loaded %d %s, %d %s, %d %s\n" nl_size (plural nl_size "node" "nodes") il_size (plural il_size "instance" "instances") @@ -145,7 +145,7 @@ main opts args = do putStrLn $ "Loaded cluster tags: " ++ intercalate "," ctags - when (verbose > 2) $ do + when (verbose > 2) . putStrLn $ "Loaded cluster ipolicy: " ++ show ipol nlf <- setNodeStatus opts fixed_nl diff --git a/htools/Ganeti/HTools/Program/Hspace.hs b/htools/Ganeti/HTools/Program/Hspace.hs index 2c20ab1432d7950ac08395d2f81e8a0be45b0127..3cfc2f8df2c4e78f1c9c1b5add3f37346a279ac1 100644 --- a/htools/Ganeti/HTools/Program/Hspace.hs +++ b/htools/Ganeti/HTools/Program/Hspace.hs @@ -372,9 +372,9 @@ runAllocation cdata stop_allocation actual_result spec dt mode opts = do -- | Create an instance from a given spec. instFromSpec :: RSpec -> DiskTemplate -> Int -> Instance.Instance -instFromSpec spx disk_template su = +instFromSpec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx) - (rspecCpu spx) Running [] True (-1) (-1) disk_template su + (rspecCpu spx) Running [] True (-1) (-1) -- | Main function. main :: Options -> [String] -> IO () diff --git a/htools/Ganeti/HTools/Rapi.hs b/htools/Ganeti/HTools/Rapi.hs index 3b8f6a57f6cddcfd860dae9b43421a8f8c663b68..6f1a9fb9ffdb7ff61a42e18dbfc1f7a185449bf9 100644 --- a/htools/Ganeti/HTools/Rapi.hs +++ b/htools/Ganeti/HTools/Rapi.hs @@ -212,7 +212,7 @@ readDataFile path = do -- | Loads data via either 'readDataFile' or 'readDataHttp'. readData :: String -- ^ URL to use as source -> IO (Result String, Result String, Result String, Result String) -readData url = do +readData url = if filePrefix `isPrefixOf` url then readDataFile (drop (length filePrefix) url) else readDataHttp url diff --git a/htools/Ganeti/HTools/Text.hs b/htools/Ganeti/HTools/Text.hs index d0f5e24a77e4a7c844ea58a080f242a227fb68b3..39a568caab6b3810c4e615fa9f5d2bea9c09ccb5 100644 --- a/htools/Ganeti/HTools/Text.hs +++ b/htools/Ganeti/HTools/Text.hs @@ -146,7 +146,7 @@ serializeIPolicy owner ipol = serializeAllIPolicies :: IPolicy -> Group.List -> String serializeAllIPolicies cpol gl = let groups = Container.elems gl - allpolicies = [("", cpol)] ++ + allpolicies = ("", cpol) : map (\g -> (Group.name g, Group.iPolicy g)) groups strings = map (uncurry serializeIPolicy) allpolicies in unlines strings @@ -259,8 +259,8 @@ loadIPolicy [owner, stdspec, minspec, maxspec, dtemplates, xdts <- mapM diskTemplateFromRaw $ commaSplit dtemplates xvcpu_ratio <- tryRead (owner ++ "/vcpu_ratio") vcpu_ratio xspindle_ratio <- tryRead (owner ++ "/spindle_ratio") spindle_ratio - return $ (owner, IPolicy xstdspec xminspec xmaxspec xdts - xvcpu_ratio xspindle_ratio) + return (owner, + IPolicy xstdspec xminspec xmaxspec xdts xvcpu_ratio xspindle_ratio) loadIPolicy s = fail $ "Invalid ipolicy data: '" ++ show s ++ "'" loadOnePolicy :: (IPolicy, Group.List) -> String diff --git a/htools/Ganeti/Luxi.hs b/htools/Ganeti/Luxi.hs index c9713e9b1d472c6a64cacaffe6120778f1d4249b..16fb27d04476d393bd05dabd647f424f4c9babe2 100644 --- a/htools/Ganeti/Luxi.hs +++ b/htools/Ganeti/Luxi.hs @@ -342,7 +342,7 @@ decodeCall (LuxiCall call args) = ReqQueryGroups -> do (names, fields, locking) <- fromJVal args return $ QueryGroups names fields locking - ReqQueryClusterInfo -> do + ReqQueryClusterInfo -> return QueryClusterInfo ReqQuery -> do (what, fields, qfilter) <- fromJVal args diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs index 9aa14986e00b667b4e7ce8f14a81e450a14e9d8f..2a3207da963a5e3a096969e8456722d064218e72 100644 --- a/htools/Ganeti/Objects.hs +++ b/htools/Ganeti/Objects.hs @@ -276,35 +276,35 @@ decodeDLId obj lid = do mB' <- readJSON mB k' <- readJSON k return $ LIDDrbd8 nA' nB' p' mA' mB' k' - _ -> fail $ "Can't read logical_id for DRBD8 type" + _ -> fail "Can't read logical_id for DRBD8 type" LD_LV -> case lid of JSArray [vg, lv] -> do vg' <- readJSON vg lv' <- readJSON lv return $ LIDPlain vg' lv' - _ -> fail $ "Can't read logical_id for plain type" + _ -> fail "Can't read logical_id for plain type" LD_FILE -> case lid of JSArray [driver, path] -> do driver' <- readJSON driver path' <- readJSON path return $ LIDFile driver' path' - _ -> fail $ "Can't read logical_id for file type" + _ -> fail "Can't read logical_id for file type" LD_BLOCKDEV -> case lid of JSArray [driver, path] -> do driver' <- readJSON driver path' <- readJSON path return $ LIDBlockDev driver' path' - _ -> fail $ "Can't read logical_id for blockdev type" + _ -> fail "Can't read logical_id for blockdev type" LD_RADOS -> case lid of JSArray [driver, path] -> do driver' <- readJSON driver path' <- readJSON path return $ LIDRados driver' path' - _ -> fail $ "Can't read logical_id for rdb type" + _ -> fail "Can't read logical_id for rdb type" -- | Disk data structure. -- @@ -363,7 +363,7 @@ $(declareSADT "AdminState" ]) $(makeJSONInstance ''AdminState) -$(buildParam "Be" "bep" $ +$(buildParam "Be" "bep" [ simpleField "minmem" [t| Int |] , simpleField "maxmem" [t| Int |] , simpleField "vcpus" [t| Int |] @@ -404,7 +404,7 @@ instance TagsObject Instance where -- * IPolicy definitions -$(buildParam "ISpec" "ispec" $ +$(buildParam "ISpec" "ispec" [ simpleField C.ispecMemSize [t| Int |] , simpleField C.ispecDiskSize [t| Int |] , simpleField C.ispecDiskCount [t| Int |] @@ -414,7 +414,7 @@ $(buildParam "ISpec" "ispec" $ -- | Custom partial ipolicy. This is not built via buildParam since it -- has a special 2-level inheritance mode. -$(buildObject "PartialIPolicy" "ipolicy" $ +$(buildObject "PartialIPolicy" "ipolicy" [ renameField "MinSpecP" $ simpleField "min" [t| PartialISpecParams |] , renameField "MaxSpecP" $ simpleField "max" [t| PartialISpecParams |] , renameField "StdSpecP" $ simpleField "std" [t| PartialISpecParams |] @@ -428,7 +428,7 @@ $(buildObject "PartialIPolicy" "ipolicy" $ -- | Custom filled ipolicy. This is not built via buildParam since it -- has a special 2-level inheritance mode. -$(buildObject "FilledIPolicy" "ipolicy" $ +$(buildObject "FilledIPolicy" "ipolicy" [ renameField "MinSpec" $ simpleField "min" [t| FilledISpecParams |] , renameField "MaxSpec" $ simpleField "max" [t| FilledISpecParams |] , renameField "StdSpec" $ simpleField "std" [t| FilledISpecParams |] @@ -461,7 +461,7 @@ fillIPolicy (FilledIPolicy { ipolicyMinSpec = fmin } -- * Node definitions -$(buildParam "ND" "ndp" $ +$(buildParam "ND" "ndp" [ simpleField "oob_program" [t| String |] , simpleField "spindle_count" [t| Int |] ]) diff --git a/htools/Ganeti/Query/Language.hs b/htools/Ganeti/Query/Language.hs index a702af6a7a095f8e6df9522f66e2d86980e3b10d..80fc52def9e6a3d10e5cee25aa43c2b58c2a3849 100644 --- a/htools/Ganeti/Query/Language.hs +++ b/htools/Ganeti/Query/Language.hs @@ -136,9 +136,9 @@ data Filter a showFilter :: (JSON a) => Filter a -> JSValue showFilter (EmptyFilter) = JSNull showFilter (AndFilter exprs) = - JSArray $ (showJSON C.qlangOpAnd):(map showJSON exprs) + JSArray $ showJSON C.qlangOpAnd : map showJSON exprs showFilter (OrFilter exprs) = - JSArray $ (showJSON C.qlangOpOr):(map showJSON exprs) + JSArray $ showJSON C.qlangOpOr : map showJSON exprs showFilter (NotFilter flt) = JSArray [showJSON C.qlangOpNot, showJSON flt] showFilter (TrueFilter field) = @@ -223,9 +223,9 @@ instance (JSON a) => JSON (Filter a) where -- Traversable implementation for 'Filter'. traverseFlt :: (Applicative f) => (a -> f b) -> Filter a -> f (Filter b) traverseFlt _ EmptyFilter = pure EmptyFilter -traverseFlt f (AndFilter flts) = AndFilter <$> (traverse (traverseFlt f) flts) -traverseFlt f (OrFilter flts) = OrFilter <$> (traverse (traverseFlt f) flts) -traverseFlt f (NotFilter flt) = NotFilter <$> (traverseFlt f flt) +traverseFlt f (AndFilter flts) = AndFilter <$> traverse (traverseFlt f) flts +traverseFlt f (OrFilter flts) = OrFilter <$> traverse (traverseFlt f) flts +traverseFlt f (NotFilter flt) = NotFilter <$> traverseFlt f flt traverseFlt f (TrueFilter a) = TrueFilter <$> f a traverseFlt f (EQFilter a fval) = EQFilter <$> f a <*> pure fval traverseFlt f (LTFilter a fval) = LTFilter <$> f a <*> pure fval diff --git a/htools/Ganeti/Query/Node.hs b/htools/Ganeti/Query/Node.hs index 8fbcee423d0ca64f30a9168d8f97174d22e05ebf..965e0ebde131e917b8e7371470049211f29e2f44 100644 --- a/htools/Ganeti/Query/Node.hs +++ b/htools/Ganeti/Query/Node.hs @@ -76,8 +76,8 @@ nodeLiveFieldBuilder (fname, ftitle, ftype, _, fdoc) = nodeRoleDoc :: String nodeRoleDoc = "Node role; " ++ - (intercalate ", " $ - map (\role -> + intercalate ", " + (map (\role -> "\"" ++ nodeRoleToRaw role ++ "\" for " ++ roleDescription role) (reverse [minBound..maxBound])) diff --git a/htools/Ganeti/Query/Server.hs b/htools/Ganeti/Query/Server.hs index b100f5284ce4b36f834d756dc048a704a131b631..80be42c0bb355f26c6ecf74e5bab368ac440880b 100644 --- a/htools/Ganeti/Query/Server.hs +++ b/htools/Ganeti/Query/Server.hs @@ -69,16 +69,16 @@ handleCall cdata QueryClusterInfo = hypervisors = clusterEnabledHypervisors cluster bits = show (bitSize (0::Int)) ++ "bits" arch_tuple = [bits, arch] - obj = [ ("software_version", showJSON $ C.releaseVersion) - , ("protocol_version", showJSON $ C.protocolVersion) - , ("config_version", showJSON $ C.configVersion) + obj = [ ("software_version", showJSON C.releaseVersion) + , ("protocol_version", showJSON C.protocolVersion) + , ("config_version", showJSON C.configVersion) , ("os_api_version", showJSON $ maximum C.osApiVersions) - , ("export_version", showJSON $ C.exportVersion) - , ("architecture", showJSON $ arch_tuple) + , ("export_version", showJSON C.exportVersion) + , ("architecture", showJSON arch_tuple) , ("name", showJSON $ clusterClusterName cluster) , ("master", showJSON $ clusterMasterNode cluster) , ("default_hypervisor", showJSON $ head hypervisors) - , ("enabled_hypervisors", showJSON $ hypervisors) + , ("enabled_hypervisors", showJSON hypervisors) , ("hvparams", showJSON $ clusterHvparams cluster) , ("os_hvp", showJSON $ clusterOsHvp cluster) , ("beparams", showJSON $ clusterBeparams cluster) @@ -93,7 +93,7 @@ handleCall cdata QueryClusterInfo = , ("master_netmask", showJSON $ clusterMasterNetmask cluster) , ("use_external_mip_script", showJSON $ clusterUseExternalMipScript cluster) - , ("volume_group_name", showJSON $clusterVolumeGroupName cluster) + , ("volume_group_name", showJSON $ clusterVolumeGroupName cluster) , ("drbd_usermode_helper", maybe JSNull showJSON (clusterDrbdUsermodeHelper cluster)) , ("file_storage_dir", showJSON $ clusterFileStorageDir cluster) diff --git a/htools/Ganeti/Rpc.hs b/htools/Ganeti/Rpc.hs index fdd9c6644a6a3070455d8f1582cdf2696affa703..77a0686dad0f72aff45fe3083d03fc158a7508d1 100644 --- a/htools/Ganeti/Rpc.hs +++ b/htools/Ganeti/Rpc.hs @@ -172,20 +172,19 @@ prepareUrl :: (RpcCall a) => Node -> a -> String prepareUrl node call = let node_ip = nodePrimaryIp node port = snd C.daemonsPortsGanetiNoded - path_prefix = "https://" ++ (node_ip) ++ ":" ++ (show port) in - path_prefix ++ "/" ++ rpcCallName call + path_prefix = "https://" ++ node_ip ++ ":" ++ show port + in path_prefix ++ "/" ++ rpcCallName call -- | Create HTTP request for a given node provided it is online, -- otherwise create empty response. prepareHttpRequest :: (RpcCall a) => Node -> a -> Either RpcError HttpClientRequest prepareHttpRequest node call - | rpcCallAcceptOffline call || - (not $ nodeOffline node) = - Right $ HttpClientRequest { requestTimeout = rpcCallTimeout call - , requestUrl = prepareUrl node call - , requestPostData = rpcCallData node call - } + | rpcCallAcceptOffline call || not (nodeOffline node) = + Right HttpClientRequest { requestTimeout = rpcCallTimeout call + , requestUrl = prepareUrl node call + , requestPostData = rpcCallData node call + } | otherwise = Left $ OfflineNodeError node -- | Parse the response or propagate the error. @@ -212,10 +211,10 @@ executeRpcCall nodes call = -- | AllInstancesInfo -- Returns information about all instances on the given nodes -$(buildObject "RpcCallAllInstancesInfo" "rpcCallAllInstInfo" $ +$(buildObject "RpcCallAllInstancesInfo" "rpcCallAllInstInfo" [ simpleField "hypervisors" [t| [Hypervisor] |] ]) -$(buildObject "InstanceInfo" "instInfo" $ +$(buildObject "InstanceInfo" "instInfo" [ simpleField "name" [t| String |] , simpleField "memory" [t| Int|] , simpleField "state" [t| AdminState |] @@ -223,7 +222,7 @@ $(buildObject "InstanceInfo" "instInfo" $ , simpleField "time" [t| Int |] ]) -$(buildObject "RpcResultAllInstancesInfo" "rpcResAllInstInfo" $ +$(buildObject "RpcResultAllInstancesInfo" "rpcResAllInstInfo" [ simpleField "instances" [t| [InstanceInfo] |] ]) instance RpcCall RpcCallAllInstancesInfo where @@ -237,10 +236,10 @@ instance Rpc RpcCallAllInstancesInfo RpcResultAllInstancesInfo -- | InstanceList -- Returns the list of running instances on the given nodes. -$(buildObject "RpcCallInstanceList" "rpcCallInstList" $ +$(buildObject "RpcCallInstanceList" "rpcCallInstList" [ simpleField "hypervisors" [t| [Hypervisor] |] ]) -$(buildObject "RpcResultInstanceList" "rpcResInstList" $ +$(buildObject "RpcResultInstanceList" "rpcResInstList" [ simpleField "node" [t| Node |] , simpleField "instances" [t| [String] |] ]) @@ -256,19 +255,19 @@ instance Rpc RpcCallInstanceList RpcResultInstanceList -- | NodeInfo -- Return node information. -$(buildObject "RpcCallNodeInfo" "rpcCallNodeInfo" $ +$(buildObject "RpcCallNodeInfo" "rpcCallNodeInfo" [ simpleField "hypervisors" [t| [Hypervisor] |] , simpleField "volume_groups" [t| [String] |] ]) -$(buildObject "VgInfo" "vgInfo" $ +$(buildObject "VgInfo" "vgInfo" [ simpleField "name" [t| String |] , simpleField "free" [t| Int |] , simpleField "size" [t| Int |] ]) -- | We only provide common fields as described in hv_base.py. -$(buildObject "HvInfo" "hvInfo" $ +$(buildObject "HvInfo" "hvInfo" [ simpleField "memory_total" [t| Int |] , simpleField "memory_free" [t| Int |] , simpleField "memory_dom0" [t| Int |] @@ -277,7 +276,7 @@ $(buildObject "HvInfo" "hvInfo" $ , simpleField "cpu_sockets" [t| Int |] ]) -$(buildObject "RpcResultNodeInfo" "rpcResNodeInfo" $ +$(buildObject "RpcResultNodeInfo" "rpcResNodeInfo" [ simpleField "boot_id" [t| String |] , simpleField "vg_info" [t| [VgInfo] |] , simpleField "hv_info" [t| [HvInfo] |] diff --git a/htools/lint-hints.hs b/htools/lint-hints.hs index ebb1fc1fce88d88bbaeb5d25e2dc16928813b53d..a85a477d93b67c5341b6340da1014fc962f70d43 100644 --- a/htools/lint-hints.hs +++ b/htools/lint-hints.hs @@ -1,10 +1,12 @@ -{- Custom hint lints for Ganeti. +{-| Custom hint lints for Ganeti. -Since passing --hint to hlint will override, not extend the built-in hints, we need to import the existing hints so that we get full coverage. +Since passing --hint to hlint will override, not extend the built-in +hints, we need to import the existing hints so that we get full +coverage. -} -import "hint" HLint.Default +import "hint" HLint.HLint import "hint" HLint.Dollar -- The following two hints warn to simplify e.g. "map (\v -> (v,