Fixes #19808: Add a button to create a new Rule category

webapp/sources/rudder/rudder-web/src/main/elm/rules/sources/ApiCalls.elm

@@ -120,7 +120,7 @@ getRulesCompliance model =
   in
     send GetRulesComplianceResult req
 
-saveRuleDetails : Rule -> Bool -> Model ->  Cmd Msg
+saveRuleDetails : Rule -> Bool -> Model -> Cmd Msg
 saveRuleDetails ruleDetails creation model =
   let
     (method, url) = if creation then ("PUT","/rules") else ("POST", ("/rules/"++ruleDetails.id.value))
@@ -153,6 +153,23 @@ saveDisableAction ruleDetails model =
   in
     send SaveDisableAction req
 
+saveCategoryDetails : (Category Rule) -> Bool -> Model -> Cmd Msg
+saveCategoryDetails category creation model =
+  let
+    (method, url) = if creation then ("PUT","/rules/categories") else ("POST", ("/rules/categories/"++category.id))
+    req =
+      request
+        { method  = method
+        , headers = []
+        , url     = getUrl model url
+        , body    = encodeCategoryDetails category |> jsonBody
+        , expect  = expectJson decodeGetCategoryDetails
+        , timeout = Nothing
+        , withCredentials = False
+        }
+  in
+    send SaveCategoryResult req
+
 deleteRule : Rule -> Model -> Cmd Msg
 deleteRule rule model =
   let
@@ -167,4 +184,20 @@ deleteRule rule model =
         , withCredentials = False
         }
   in
-    send DeleteRule req
+    send DeleteRule req
+
+deleteCategory : (Category Rule) -> Model -> Cmd Msg
+deleteCategory category model =
+  let
+    req =
+      request
+        { method  = "DELETE"
+        , headers = []
+        , url     = getUrl model "/rules/categories/" ++ category.id
+        , body    = emptyBody
+        , expect  = expectJson decodeDeleteCategoryResponse
+        , timeout = Nothing
+        , withCredentials = False
+        }
+  in
+    send DeleteCategory req

webapp/sources/rudder/rudder-web/src/main/elm/rules/sources/DataTypes.elm

@@ -18,7 +18,7 @@ type alias Tag =
   , value : String
   }
 
-type ModalState = DeletionValidation Rule | DeactivationValidation Rule
+type ModalState = DeletionValidation Rule | DeactivationValidation Rule | DeletionValidationCat (Category Rule)
 
 type RuleTarget = NodeGroupId String | Composition  RuleTarget RuleTarget | Special String | Node String | And (List RuleTarget) | Or (List RuleTarget)
 
@@ -57,11 +57,12 @@ type alias Technique =
   }
 
 type alias Category a =
- { id : String
- , name : String
-  , subElems : SubCategories a
-  , elems : List a
- }
+  { id          : String
+  , name        : String
+  , description : String
+  , subElems    : SubCategories a
+  , elems       : List a
+  }
 
 type SubCategories a = SubCategories (List (Category a))
 type alias Group =
@@ -145,7 +146,15 @@ type alias ComplianceDetails =
 
 type alias EditRuleDetails = { originRule : Rule, rule : Rule, tab :  TabMenu, editDirectives: Bool, editGroups : Bool, newTag : Tag }
 
-type Mode = Loading | RuleTable | EditRule EditRuleDetails | CreateRule EditRuleDetails
+type alias EditCategoryDetails = { originCategory : Category Rule, category : Category Rule, tab :  TabMenu}
+
+type Mode
+  = Loading
+  | RuleTable
+  | EditRule   EditRuleDetails
+  | CreateRule EditRuleDetails
+  | EditCategory   EditCategoryDetails
+  | CreateCategory EditCategoryDetails
 
 type alias Model =
   { contextPath     : String
@@ -166,23 +175,29 @@ type Msg
   | EditGroups Bool
   | GetRuleDetailsResult     (Result Error Rule)
   | OpenRuleDetails RuleId
-  | CloseRuleDetails
+  | OpenCategoryDetails (Category Rule)
+  | CloseDetails
   | SelectGroup RuleTarget Bool
   | UpdateRule Rule
+  | UpdateCategory (Category Rule)
   | NewRule RuleId
+  | NewCategory String
   | UpdateNewTag Tag
   | CallApi                  (Model -> Cmd Msg)
   | GetPolicyModeResult      (Result Error String)
   | GetRulesComplianceResult (Result Error (List RuleCompliance))
   | SaveRuleDetails          (Result Error Rule)
   | SaveDisableAction        (Result Error Rule)
+  | SaveCategoryResult       (Result Error (Category Rule))
   | GetRulesResult           (Result Error (Category Rule))
   | GetGroupsTreeResult      (Result Error (Category Group))
   | GetTechniquesTreeResult  (Result Error ((Category Technique, List Technique)))
   | DeleteRule               (Result Error (RuleId, String))
+  | DeleteCategory           (Result Error (String, String))
   | DisableRule
   | CloneRule Rule RuleId
   | OpenDeletionPopup Rule
+  | OpenDeletionPopupCat (Category Rule)
   | OpenDeactivationPopup Rule
   | ClosePopup Msg
   | Ignore

webapp/sources/rudder/rudder-web/src/main/elm/rules/sources/Init.elm

@@ -12,7 +12,7 @@ init : { contextPath : String } -> ( Model, Cmd Msg )
 init flags =
   let
 
-    initCategory      = Category "" "" (SubCategories []) []
+    initCategory      = Category "" "" "" (SubCategories []) []
     initModel = Model flags.contextPath Loading "" initCategory initCategory initCategory [] [] Nothing
 
     listInitActions =

webapp/sources/rudder/rudder-web/src/main/elm/rules/sources/JsonDecoder.elm

@@ -13,22 +13,30 @@ decodeGetPolicyMode =
 
 decodeCategoryWithLeaves : String -> String -> String -> Decoder a -> Decoder ((Category a), List a)
 decodeCategoryWithLeaves idIdentifier categoryIdentifier elemIdentifier elemDecoder =
-  map4 (\id name subCats elems -> (Category id name (SubCategories (List.map Tuple.first subCats)) elems, List.concat [ elems, List.concatMap Tuple.second subCats ] ))
-     (field idIdentifier  D.string)
-     (field "name"        D.string)
-     (field categoryIdentifier   (D.list (D.lazy (\_ -> (decodeCategoryWithLeaves idIdentifier categoryIdentifier elemIdentifier elemDecoder)))))
-     (field elemIdentifier      (D.list elemDecoder))
-
-
+  D.map5 (\id name description subCats elems -> (Category id name description (SubCategories (List.map Tuple.first subCats)) elems, List.concat [ elems, List.concatMap Tuple.second subCats ] ))
+    (field idIdentifier  D.string)
+    (field "name"        D.string)
+    (field "description" D.string)
+    (field categoryIdentifier (D.list (D.lazy (\_ -> (decodeCategoryWithLeaves idIdentifier categoryIdentifier elemIdentifier elemDecoder)))))
+    (field elemIdentifier (D.list elemDecoder))
 
 decodeCategory : String -> String -> String -> Decoder a -> Decoder (Category a)
 decodeCategory idIdentifier categoryIdentifier elemIdentifier elemDecoder =
   succeed Category
     |> required idIdentifier  D.string
     |> required "name"        D.string
+    |> required "description" D.string
     |> required categoryIdentifier (D.map SubCategories  (D.list (D.lazy (\_ -> (decodeCategory idIdentifier categoryIdentifier elemIdentifier elemDecoder)))))
     |> required elemIdentifier      (D.list elemDecoder)
 
+decodeCategoryDetails : Decoder (Category Rule)
+decodeCategoryDetails =
+  succeed Category
+    |> required "id"          D.string
+    |> required "name"        D.string
+    |> required "description" D.string
+    |> hardcoded (SubCategories [])
+    |> hardcoded []
 
 decodeGetRulesTree =
   D.at [ "data" , "ruleCategories" ] (decodeCategory "id" "categories" "rules" decodeRule)
@@ -37,6 +45,10 @@ decodeGetRuleDetails : Decoder Rule
 decodeGetRuleDetails =
   D.at [ "data" , "rules" ] (index 0 decodeRule)
 
+decodeGetCategoryDetails : Decoder (Category Rule)
+decodeGetCategoryDetails =
+  D.at [ "data" , "ruleCategories" ] decodeCategoryDetails
+
 decodeRule : Decoder Rule
 decodeRule =
   D.succeed Rule
@@ -67,6 +79,13 @@ decodeDeleteRuleResponse =
      |> required "displayName" string
   ))
 
+decodeDeleteCategoryResponse : Decoder (String, String)
+decodeDeleteCategoryResponse =
+  D.at ["data", "ruleCategories" ](index 0
+  ( succeed Tuple.pair
+     |> required "id" string
+     |> required "name" string
+  ))
 
 -- COMPLIANCE
 decodeGetRulesCompliance : Decoder (List RuleCompliance)

webapp/sources/rudder/rudder-web/src/main/elm/rules/sources/JsonEncoder.elm

@@ -21,6 +21,13 @@ encodeRuleDetails ruleDetails =
       , ("tags"             , list encodeTags ruleDetails.tags    )
       ]
 
+encodeCategoryDetails: (Category Rule) -> Value
+encodeCategoryDetails category =
+  object [
+    ("name"        , string category.name        )
+  , ("description" , string category.description )
+  ]
+
 encodeDirectives: Directive -> Value
 encodeDirectives directive=
   object [

webapp/sources/rudder/rudder-web/src/main/elm/rules/sources/Rules.elm

@@ -115,7 +115,10 @@ update msg model =
     OpenRuleDetails rId ->
       (model, (getRuleDetails model rId))
 
-    CloseRuleDetails ->
+    OpenCategoryDetails category ->
+      ({model | mode = EditCategory (EditCategoryDetails category category Information )}, Cmd.none)
+
+    CloseDetails ->
       ( { model | mode  = RuleTable } , Cmd.none )
 
     GetRulesComplianceResult res ->
@@ -125,6 +128,14 @@ update msg model =
         Err err ->
           (model, Cmd.none)
 
+    UpdateCategory category ->
+      case model.mode of
+        EditCategory details   ->
+          ({model | mode = EditCategory   {details | category = category}}, Cmd.none)
+        CreateCategory details ->
+          ({model | mode = CreateCategory {details | category = category}}, Cmd.none)
+        _   -> (model, Cmd.none)
+
     SelectGroup groupId includeBool->
       let
         updateTargets : Rule -> Rule
@@ -177,6 +188,13 @@ update msg model =
       in
         ({model | mode = CreateRule ruleDetails}, Cmd.none)
 
+    NewCategory id ->
+      let
+        category        = Category id "" "" (SubCategories []) []
+        categoryDetails = EditCategoryDetails category category Information
+      in
+        ({model | mode = CreateCategory categoryDetails}, Cmd.none)
+
     UpdateNewTag tag ->
       case model.mode of
         EditRule details ->
@@ -186,7 +204,6 @@ update msg model =
         _   -> (model, Cmd.none)
 
     SaveRuleDetails (Ok ruleDetails) ->
-      -- TODO // Update Rules List
       case model.mode of
         EditRule details ->
           let
@@ -216,19 +233,53 @@ update msg model =
     SaveDisableAction (Err err) ->
       processApiError "Changing rule state" err model
 
+    SaveCategoryResult (Ok category) ->
+      case model.mode of
+        EditCategory details ->
+          let
+            oldCategory = details.category
+            newCategory = {category | subElems = oldCategory.subElems, elems = oldCategory.elems}
+            newModel    = {model | mode = EditCategory {details | originCategory = newCategory, category = newCategory}}
+          in
+            (newModel, Cmd.batch [(successNotification ("Category '"++ category.name ++"' successfully saved")), (getRulesTree newModel)])
+        CreateCategory details ->
+          let
+            oldCategory = details.category
+            newCategory = {category | subElems = oldCategory.subElems, elems = oldCategory.elems}
+            newModel    = {model | mode = EditCategory {details | originCategory = newCategory, category = newCategory}}
+          in
+            (newModel, Cmd.batch [(successNotification ("Category '"++ category.name ++"' successfully created")), (getRulesTree newModel)])
+        _   -> (model, Cmd.none)
+
+    SaveCategoryResult (Err err) ->
+      processApiError "Saving Category" err model
+
     DeleteRule (Ok (ruleId, ruleName)) ->
-    -- TODO // Update Rules List
       case model.mode of
         EditRule r ->
           let
-            newMode = if r.rule.id == ruleId then RuleTable else model.mode
+            newMode  = if r.rule.id == ruleId then RuleTable else model.mode
+            newModel = { model | mode = newMode }
           in
-            ({ model | mode = newMode}, successNotification ("Successfully deleted rule '" ++ ruleName ++  "' (id: "++ ruleId.value ++")"))
+            (newModel, Cmd.batch [(successNotification ("Successfully deleted rule '" ++ ruleName ++  "' (id: "++ ruleId.value ++")")), (getRulesTree newModel)])
         _ -> (model, Cmd.none)
 
     DeleteRule (Err err) ->
       processApiError "Deleting Rule" err model
 
+    DeleteCategory (Ok (categoryId, categoryName)) ->
+      case model.mode of
+        EditCategory c ->
+          let
+            newMode  = if c.category.id == categoryId then RuleTable else model.mode
+            newModel = { model | mode = newMode }
+          in
+            (newModel, Cmd.batch [(successNotification ("Successfully deleted category '" ++ categoryName ++  "' (id: "++ categoryId ++")")), (getRulesTree newModel)])
+        _ -> (model, Cmd.none)
+
+    DeleteCategory (Err err) ->
+      processApiError "Deleting category" err model
+
     CloneRule rule rulelId ->
       let
         newModel = case model.mode of
@@ -248,6 +299,12 @@ update msg model =
             ( { model | modal = Just (DeletionValidation rule)} , Cmd.none )
         _ -> (model, Cmd.none)
 
+    OpenDeletionPopupCat category ->
+      case model.mode of
+        EditCategory _ ->
+            ( { model | modal = Just (DeletionValidationCat category)} , Cmd.none )
+        _ -> (model, Cmd.none)
+
     OpenDeactivationPopup rule ->
       case model.mode of
         EditRule _ ->