diff --git a/src/Ganeti/OpCodes.hs b/src/Ganeti/OpCodes.hs index 6f284454427ed65be2eb7509fb43b0eec2b4627b..3b30350998bde15a36c9ffc483b7a35f59349961 100644 --- a/src/Ganeti/OpCodes.hs +++ b/src/Ganeti/OpCodes.hs @@ -626,6 +626,7 @@ $(buildObject "CommonOpParams" "op" , pOpPriority , pDependencies , pComment + , pReason ]) -- | Default common parameter values. @@ -636,6 +637,7 @@ defOpParams = , opPriority = OpPrioNormal , opDepends = Nothing , opComment = Nothing + , opReason = [] } -- | The top-level opcode type. diff --git a/src/Ganeti/OpParams.hs b/src/Ganeti/OpParams.hs index 51d47b2520ffb03142997859977d7be643a01be2..e445aa974eae46bfa78c57e79d44fa9572784d21 100644 --- a/src/Ganeti/OpParams.hs +++ b/src/Ganeti/OpParams.hs @@ -236,6 +236,7 @@ module Ganeti.OpParams , pOpPriority , pDependencies , pComment + , pReason , pEnabledDiskTemplates , dOldQuery , dOldQueryNoLocking @@ -1444,6 +1445,10 @@ pDependencies = pComment :: Field pComment = optionalNullSerField $ stringField "comment" +-- | Reason trail field. +pReason :: Field +pReason = simpleField C.opcodeReason [t| ReasonTrail |] + -- * Entire opcode parameter list -- | Old-style query opcode, with locking. diff --git a/test/hs/Test/Ganeti/OpCodes.hs b/test/hs/Test/Ganeti/OpCodes.hs index 1183741426576ec5dcd6d6f67199271f17d2ea72..6044322fe3e751603ea09b5e27593ef475fe27cc 100644 --- a/test/hs/Test/Ganeti/OpCodes.hs +++ b/test/hs/Test/Ganeti/OpCodes.hs @@ -342,9 +342,20 @@ instance Arbitrary OpCodes.OpCode where genNameNE _ -> fail $ "Undefined arbitrary for opcode " ++ op_id +-- | Generates one element of a reason trail +genReasonElem :: Gen ReasonElem +genReasonElem = (,,) <$> genFQDN <*> genFQDN <*> arbitrary + +-- | Generates a reason trail +genReasonTrail :: Gen ReasonTrail +genReasonTrail = do + size <- choose (0, 10) + vectorOf size genReasonElem + instance Arbitrary OpCodes.CommonOpParams where arbitrary = OpCodes.CommonOpParams <$> arbitrary <*> arbitrary <*> - arbitrary <*> resize 5 arbitrary <*> genMaybe genName + arbitrary <*> resize 5 arbitrary <*> genMaybe genName <*> + genReasonTrail -- * Helper functions