inter-hub/Test/Main.hs

module Main where

import Test.Hspec
import IHP.Prelude
import qualified Test.Architecture.LayerBoundarySpec as LayerBoundary
import Data.Aeson (object, toJSON, (.=))
import Web.Controller.Api.V2.InteractionEvents
    ( declaredEventTypeNames, manifestAllowsEvent, metadataFromJsonBody
    , metadataParamOrEmpty
    )
import Web.Controller.Api.V2.Hubs (missingRequiredFields, validCreateHubKind)
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 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"]

    LayerBoundary.spec