SecurityRoleMappingsSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.SecurityRoleMappingsSpec (spec) where

import Data.Aeson
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Lazy.Char8 qualified as L
import TestsUtils.Import
import Prelude

-- | A role mapping with a nested @any -> all -> field@ rule tree.
sampleMappingBytes :: L.ByteString
sampleMappingBytes =
  "{\
  \  \"enabled\": true,\
  \  \"roles\": [\"admin\"],\
  \  \"rules\": {\
  \    \"any\": [\
  \      {\"field\": {\"username\": \"alice\"}},\
  \      {\"all\": [\
  \        {\"field\": {\"realm.name\": \"ad\"}},\
  \        {\"field\": {\"groups\": \"cn=admins\"}}\
  \      ]}\
  \    ]\
  \  },\
  \  \"metadata\": {\"version\": 1}\
  \}"

-- | A mapping using the @except@ composite rule.
sampleExceptMappingBytes :: L.ByteString
sampleExceptMappingBytes =
  "{\
  \  \"roles\": [\"user\"],\
  \  \"rules\": {\"except\": {\"field\": {\"username\": \"blacklist\"}}}\
  \}"

spec :: Spec
spec = do
  describe "RoleMapping" $ do
    it "decodes a nested any/all/field rule tree" $ do
      let Just decoded = decode sampleMappingBytes :: Maybe RoleMapping
      romEnabled decoded `shouldBe` Just True
      romRoles decoded `shouldBe` [RoleName "admin"]
      -- The top rule is an @any@ over two branches.
      case romRules decoded of
        RuleAny branches ->
          length (branches) `shouldBe` 2
        other -> expectationFailure ("expected RuleAny, got " <> show other)
      -- Stable round-trip.
      let Just rt = decode (encode decoded) :: Maybe RoleMapping
      romRoles rt `shouldBe` [RoleName "admin"]

    it "decodes the except composite rule" $ do
      let Just decoded = decode sampleExceptMappingBytes :: Maybe RoleMapping
      case romRules decoded of
        RuleExcept (RuleField km) ->
          KM.lookup "username" km `shouldSatisfy` isJust
        other -> expectationFailure ("expected RuleExcept (RuleField), got " <> show other)

    it "encodes a field rule as {field: {...}}" $ do
      let rule = RuleField (KM.singleton "dn" "CN=alice")
      decode (encode rule) `shouldBe` Just (rule :: RoleMappingRule)

  describe "RoleMappingRule" $ do
    it "rejects an empty object" $ do
      decode "{}" `shouldBe` (Nothing :: Maybe RoleMappingRule)

    it "preserves an unknown rule kind verbatim" $ do
      let decoded = decode "{\"future_rule\":{\"x\":1}}" :: Maybe RoleMappingRule
      decoded `shouldSatisfy` isJust
      case decoded of
        Just (RuleCustom _ _) -> True `shouldBe` True
        other -> expectationFailure ("expected RuleCustom, got " <> show other)

  describe "RoleMappingsListResponse" $ do
    it "decodes an object keyed by mapping name" $ do
      let bytes =
            "{\
            \  \"mapping1\": {\
            \    \"roles\": [\"admin\"],\
            \    \"rules\": {\"field\": {\"username\": \"x\"}}\
            \  }\
            \}"
      let Just resp = decode bytes :: Maybe RoleMappingsListResponse
      length (roleMappingsListEntries resp) `shouldBe` 1