inter-hub/Test/Main.hs

module Main where

import Test.Hspec
import IHP.Prelude
import qualified Test.Architecture.LayerBoundarySpec as LayerBoundary
import Data.Aeson (Value(..), object, toJSON, (.=))
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import Web.Controller.Api.V2.InteractionEvents
    ( declaredEventTypeNames, manifestAllowsEvent, metadataFromJsonBody
    , metadataParamOrEmpty
    )
import Web.Controller.Api.V2.Hubs
    ( missingRequiredFields, validCreateHubKind, validVsmMetadata
    , validVsmSystem )
import Web.Controller.Api.V2.HubCapabilityManifests
    ( jsonArrayTexts, textArrayFieldFromJsonBody )
import Web.Controller.Api.V2.ApiConsumers (positiveLimit)
import Web.Controller.Api.V2.OpenApi (buildPaths)
import Web.Controller.Api.V2.Widgets (missingWidgetCreateFields, validWidgetStatus)

main :: IO ()
main = hspec do
    describe "Example" do
        it "should pass" do
            1 + 1 `shouldBe` (2 :: Int)

    describe "API v2 interaction-event manifest validation" do
        let opsEventTypes = toJSON
                ( [ "ops-endpoint-verified"
                  , "ops-workflow-started"
                  ] :: [Text]
                )

        it "decodes manifest-declared event types from JSON arrays" do
            declaredEventTypeNames opsEventTypes
                `shouldBe` ["ops-endpoint-verified", "ops-workflow-started"]

        it "allows manifest-declared ops-owned domain events" do
            manifestAllowsEvent "ops-endpoint-verified" opsEventTypes
                `shouldBe` True

        it "rejects events absent from an active manifest declaration" do
            manifestAllowsEvent "clicked" opsEventTypes
                `shouldBe` False

        it "keeps empty declarations unrestricted for legacy manifests" do
            manifestAllowsEvent "clicked" (toJSON ([] :: [Text]))
                `shouldBe` True

        it "preserves submitted metadata values and defaults missing metadata" do
            let metadata = object ["source" .= ("ops-hub" :: Text)]
            metadataFromJsonBody (object ["metadata" .= metadata]) `shouldBe` Just metadata
            metadataParamOrEmpty (Just metadata) `shouldBe` metadata
            metadataParamOrEmpty Nothing `shouldBe` object []

    describe "API v2 hub and widget create validation" do
        it "accepts scriptable domain/shared hub kinds only" do
            validCreateHubKind "domain" `shouldBe` True
            validCreateHubKind "shared" `shouldBe` True
            validCreateHubKind "framework" `shouldBe` False

        it "reports missing hub create fields including empty strings" do
            missingRequiredFields
                [ ("slug", Just "")
                , ("name", Nothing)
                , ("domain", Just "operations")
                ]
                `shouldBe` ["slug", "name"]

        it "accepts complete VSM hub classification for ops-hub" do
            validVsmMetadata (Just "vsm") (Just "operations") (Just "1")
                `shouldBe` True
            validVsmSystem "1" `shouldBe` True
            validVsmSystem "6" `shouldBe` False

        it "rejects partial VSM metadata" do
            validVsmMetadata (Just "vsm") (Just "operations") Nothing
                `shouldBe` False
            validVsmMetadata Nothing (Just "operations") (Just "1")
                `shouldBe` False

        it "accepts widget statuses supported by the UI create flow" do
            validWidgetStatus "active" `shouldBe` True
            validWidgetStatus "deprecated" `shouldBe` True
            validWidgetStatus "draft" `shouldBe` True
            validWidgetStatus "archived" `shouldBe` False

        it "reports missing widget create fields including empty strings" do
            missingWidgetCreateFields
                [ ("hubId", Just "")
                , ("name", Just "Ops endpoint card")
                , ("widgetType", Nothing)
                ]
                `shouldBe` ["hubId", "widgetType"]

    describe "API v2 manifest vocabulary parsing" do
        it "decodes declared vocabulary arrays from JSON request bodies" do
            textArrayFieldFromJsonBody
                "declaredPolicyScopes"
                (object ["declaredPolicyScopes" .= (["ops-internal", "ops-external"] :: [Text])])
                `shouldBe` Just ["ops-internal", "ops-external"]

        it "extracts manifest-declared text arrays for activation" do
            jsonArrayTexts (toJSON (["ops-endpoint-card", "ops-alert-panel"] :: [Text]))
                `shouldBe` ["ops-endpoint-card", "ops-alert-panel"]

    describe "API v2 API consumer bootstrap validation" do
        it "requires positive rate-limit and quota values" do
            positiveLimit 1 `shouldBe` True
            positiveLimit 0 `shouldBe` False
            positiveLimit (-1) `shouldBe` False

    describe "API v2 OpenAPI auth contract" do
        it "documents unauthenticated hub discovery for bootstrap clients" do
            openApiOperationSecurity "/hubs" "get" buildPaths
                `shouldBe` Just (toJSON ([] :: [Value]))

        it "keeps hub creation authenticated" do
            openApiOperationSecurity "/hubs" "post" buildPaths
                `shouldBe` Just (toJSON [object ["BearerAuth" .= ([] :: [Text])]])

        it "marks public vocabulary registries as unauthenticated" do
            openApiOperationSecurity "/policy-scopes" "get" buildPaths
                `shouldBe` Just (toJSON ([] :: [Value]))

    LayerBoundary.spec

openApiOperationSecurity :: Text -> Text -> Value -> Maybe Value
openApiOperationSecurity path method (Object paths) = do
    Object pathSpec <- KM.lookup (K.fromText path) paths
    Object operation <- KM.lookup (K.fromText method) pathSpec
    KM.lookup (K.fromText "security") operation
openApiOperationSecurity _ _ _ = Nothing