On Mon, Jan 28, 2013 at 11:55 +0100, Iustin Pop <[email protected]> wrote:
> On Thu, Jan 24, 2013 at 02:06:46AM +0000, Dato Simó wrote:
> > Parse auto-repair tags to set each instance in one of ArHealthy, ArFailed,
> > or ArPendingRepair. The implementation tries to be well behaved when old
> > tags have been left behind, which future patches will still try _not_ to do.
> Hi,
> > +-- | Parse a tag into an 'AutoRepairData' record.
> > +--
> > +-- @Nothing@ is returned if the tag is not an auto-repair tag, or if it's
> > +-- malformed.
> > +parseInitTag :: String -> Maybe AutoRepairData
> > +parseInitTag tag =
> > + let parsePending = do
> > + subtag <- chompPrefix C.autoRepairTagPending tag
> > + let [rtype, uuid, ts, jobs] = sepSplit ':' subtag
> This, and
> > + makeArData rtype uuid ts jobs
> > +
> > + parseResult = do
> > + subtag <- chompPrefix C.autoRepairTagResult tag
> > + let [rtype, uuid, ts, result, jobs] = sepSplit ':' subtag
> this seem very unsafe to me. While testing similar code in the Maybe
> monad on a test example with bad data, I get:
> runhaskell l.hs
> l.hs: l.hs:4:17-31: Irrefutable pattern failed for pattern [a, b, c]
> Does this actually behave correctly with invalid tags?
No, you're right. This is way too brittle for an "erroneous input" condition.
How about a monadic wrapper for sepSplit? (If you think I better put it in
Utils.hs, just let me know.)
--- src/Ganeti/HTools/Program/Harep.hs
+++ src/Ganeti/HTools/Program/Harep.hs
@@ -85,12 +85,12 @@ parseInitTag :: String -> Maybe AutoRepairData
parseInitTag tag =
let parsePending = do
subtag <- chompPrefix C.autoRepairTagPending tag
- let [rtype, uuid, ts, jobs] = sepSplit ':' subtag
+ [rtype, uuid, ts, jobs] <- splitN 4 subtag
makeArData rtype uuid ts jobs
parseResult = do
subtag <- chompPrefix C.autoRepairTagResult tag
- let [rtype, uuid, ts, result, jobs] = sepSplit ':' subtag
+ [rtype, uuid, ts, result, jobs] <- splitN 5 subtag
arData <- makeArData rtype uuid ts jobs
result' <- autoRepairResultFromRaw result
return arData { arResult = Just result' }
@@ -106,6 +106,12 @@ parseInitTag tag =
, arResult = Nothing
, arTag = tag
}
+
+ splitN n str = do
+ let parts = sepSplit ':' str
+ guard $ length parts == n
+ return parts
+
in
parsePending `mplus` parseResult
> > + arData <- makeArData rtype uuid ts jobs
> > + result' <- autoRepairResultFromRaw result
> > + return arData { arResult = Just result' }
> > +
> > + makeArData rtype uuid ts jobs = do
> > + rtype' <- autoRepairTypeFromRaw rtype
> > + ts' <- tryRead "auto-repair time" ts
> > + jobs' <- mapM makeJobIdS $ sepSplit '+' jobs
> > + return AutoRepairData { arType = rtype'
> > + , arUuid = uuid
> > + , arTime = TOD ts' 0
> > + , arJobs = jobs'
> > + , arResult = Nothing
> > + , arTag = tag
> > + }
> > + in
> > + mplus parsePending parseResult
> Can you use parsePending `mplus` parseResult please?
Done (see previous diff).
> > +-- | Return the 'AutoRepairData' element of an 'AutoRepairStatus' type.
> > +getArData :: AutoRepairStatus -> Maybe AutoRepairData
> > +getArData status =
> > + case status of
> > + ArHealthy (Just d) -> Just d
> > + ArFailedRepair d -> Just d
> > + ArPendingRepair d -> Just d
> > + ArNeedsRepair d -> Just d
> > + _ -> Nothing
> (fyi, you could also align the 'd's there)
Done:
getArData :: AutoRepairStatus -> Maybe AutoRepairData
getArData status =
case status of
ArHealthy (Just d) -> Just d
ArFailedRepair d -> Just d
ArPendingRepair d -> Just d
ArNeedsRepair d -> Just d
_ -> Nothing
> > +-- | Return a new list of tags to remove that includes @arTag@ if present.
> > +delCurTag :: InstanceData -> [String]
> > +delCurTag instData =
> > + let arData = getArData $ arState instData
> > + rmTags = tagsToRemove instData
> > + in
> > + case arData of
> > + Just d -> arTag d : rmTags
> > + Nothing -> rmTags
> > +
> > +-- | Set the initial auto-repair state of an instance from its auto-repair
> > tags.
> > +--
> > +-- The rules when there are multiple tags is:
> > +--
> > +-- * the earliest failure result always wins
> > +--
> > +-- * two or more pending repairs results in a fatal error
> > +--
> > +-- * a pending result from id X and a success result from id Y result in
> > error
> > +-- if Y is newer than X
> > +--
> > +-- * if there are no pending repairs, the newest success result wins,
> > +-- otherwise the pending result is used.
> > +setInitialState :: Instance.Instance -> InstanceData
> > +setInitialState inst =
> > + let arData = mapMaybe parseInitTag $ Instance.allTags inst
> > + -- Group all the AutoRepairData records by id (i.e. by repair task),
> > and
> > + -- present them from oldest to newest.
> > + arData' = sortBy (comparing arUuid) arData
> > + arGroups = groupBy ((==) `on` arUuid) arData'
> > + arGroups' = sortBy (comparing $ minimum . map arTime) arGroups
> > + in
> > + foldl arStatusCmp (InstanceData inst (ArHealthy Nothing) []) arGroups'
> > +-- | Update the initial status of an instance with new repair task tags.
> > +--
> > +-- This function gets called once per repair group in an instance's tag,
> > and it
> > +-- determines whether to set the status of the instance according to this
> > new
> > +-- group, or to keep the existing state. See the documentation for
> > +-- 'setInitialState' for the rules to be followed when determining this.
> > +arStatusCmp :: InstanceData -> [AutoRepairData] -> InstanceData
> > +arStatusCmp instData arData =
> > + let curSt = arState instData
> > + arData' = sortBy (comparing keyfn) arData
> > + keyfn d = (arResult d, arTime d)
> > + newData = last arData'
> > + newSt = case arResult newData of
> > + Just ArSuccess -> ArHealthy $ Just newData
> > + Just ArEnoperm -> ArHealthy $ Just newData
> > + Just ArFailure -> ArFailedRepair newData
> > + Nothing -> ArPendingRepair newData
> > + in
> > + case curSt of
> > + ArFailedRepair _ -> instData -- Always keep the earliest failure.
> > + ArHealthy _ -> instData { arState = newSt
> > + , tagsToRemove = delCurTag instData
> > + }
> > + ArPendingRepair d -> error (
> > + "An unfinished repair was found in instance " ++
> > + Instance.name (arInstance instData) ++ ": found tag " ++
> > + show (arTag newData) ++ ", but older pending tag " ++
> > + show (arTag d) ++ "exists.")
> Please, never ever use error. Put this into a proper error monad if you
> need to signal failure, but don't use exceptions to signal errors.
Ack, sorry about that. I've converted the code to use Result, see below. I'm a
bit on sure on how I handled back the result in main, so if there's another way
to better do it, please let me know.
Interdiff:
--- src/Ganeti/HTools/Program/Harep.hs
+++ src/Ganeti/HTools/Program/Harep.hs
@@ -160,7 +160,7 @@ delCurTag instData =
--
-- * if there are no pending repairs, the newest success result wins,
-- otherwise the pending result is used.
-setInitialState :: Instance.Instance -> InstanceData
+setInitialState :: Instance.Instance -> Result InstanceData
setInitialState inst =
let arData = mapMaybe parseInitTag $ Instance.allTags inst
-- Group all the AutoRepairData records by id (i.e. by repair task), and
@@ -169,7 +169,7 @@ setInitialState inst =
arGroups = groupBy ((==) `on` arUuid) arData'
arGroups' = sortBy (comparing $ minimum . map arTime) arGroups
in
- foldl arStatusCmp (InstanceData inst (ArHealthy Nothing) []) arGroups'
+ foldM arStatusCmp (InstanceData inst (ArHealthy Nothing) []) arGroups'
-- | Update the initial status of an instance with new repair task tags.
--
@@ -177,7 +177,7 @@ setInitialState inst =
-- determines whether to set the status of the instance according to this new
-- group, or to keep the existing state. See the documentation for
-- 'setInitialState' for the rules to be followed when determining this.
-arStatusCmp :: InstanceData -> [AutoRepairData] -> InstanceData
+arStatusCmp :: InstanceData -> [AutoRepairData] -> Result InstanceData
arStatusCmp instData arData =
let curSt = arState instData
arData' = sortBy (comparing keyfn) arData
@@ -190,18 +190,18 @@ arStatusCmp instData arData =
Nothing -> ArPendingRepair newData
in
case curSt of
- ArFailedRepair _ -> instData -- Always keep the earliest failure.
- ArHealthy _ -> instData { arState = newSt
- , tagsToRemove = delCurTag instData
- }
- ArPendingRepair d -> error (
+ ArFailedRepair _ -> Ok instData -- Always keep the earliest failure.
+ ArHealthy _ -> Ok instData { arState = newSt
+ , tagsToRemove = delCurTag instData
+ }
+ ArPendingRepair d -> Bad (
"An unfinished repair was found in instance " ++
Instance.name (arInstance instData) ++ ": found tag " ++
show (arTag newData) ++ ", but older pending tag " ++
show (arTag d) ++ "exists.")
ArNeedsRepair _ -> instData -- Never happens, but silence GHC.
-- | query jobs of a pending repair, returning the new instance data.
processPending :: L.Client -> InstanceData -> IO InstanceData
@@ -450,9 +450,13 @@ main opts args = do
(ClusterData _ nl il _ _) <- loadExternalData opts'
- let iniData = map setInitialState $ Container.elems il
+ let iniDataRes = mapM setInitialState $ Container.elems il
+ iniDataChk = case iniDataRes of
+ Ok d -> return d
+ Bad msg -> exitErr msg
-- First step: check all pending repairs, see if they are completed.
+ iniData <- iniDataChk
iniData' <- bracket (L.getClient master) L.closeClient $
forM iniData . processPending
> > + ArNeedsRepair _ -> instData -- Never happens, but silence GHC.
> If this never happens, should this be an error value?
Sure, that works too. Given that this would be a programming error, as opposed
to an "errononeous input" condition, I initially thought about ‘undefined’:
@@ -194,7 +194,8 @@ arStatusCmp instData arData =
show (arTag newData) ++ ", but older pending tag " ++
show (arTag d) ++ "exists.")
- ArNeedsRepair _ -> instData -- Never happens, but silence GHC.
+ ArNeedsRepair _ -> undefined -- Never happens, because ArNeedsRepair is
+ -- not an initial state; still, silences GHC.
However, now that arStatusCmp is using Result, I may as well do:
- ArNeedsRepair _ -> instData -- Never happens, but silence GHC.
+ ArNeedsRepair _ -> Bad (
+ "programming error: ArNeedsRepair found as an initial state")
Thanks for the review!
--
Dato Simó | [email protected]
Corp Fleet Management / Ganeti SRE (Dublin)
--
You received this message because you are subscribed to the Google Groups
"ganeti-devel" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to [email protected].
For more options, visit https://groups.google.com/groups/opt_out.
