inter-hub-haskell/Web/Controller/WebhookSubscriptions.hs

module Web.Controller.WebhookSubscriptions where

import Web.Types
import Web.View.WebhookSubscriptions.New
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import qualified Data.ByteString.Random as Random
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString.Base16 as Base16

-- Webhook event topics are framework lifecycle events, not interaction event types
allowedWebhookTopics :: [Text]
allowedWebhookTopics =
    [ "interaction_event.created"
    , "annotation.created"
    , "requirement_candidate.created"
    , "decision_record.created"
    , "deployment_record.created"
    , "outcome_signal.created"
    ]

instance Controller WebhookSubscriptionsController where
    beforeAction = ensureIsUser

    action WebhookSubscriptionsAction { apiConsumerId } = do
        redirectTo (ShowApiConsumerAction apiConsumerId)

    action NewWebhookSubscriptionAction { apiConsumerId } = do
        consumer <- fetch apiConsumerId
        let subscription = newRecord @WebhookSubscription
        render NewView { subscription, consumer }

    action CreateWebhookSubscriptionAction = do
        let apiConsumerId = param @(Id ApiConsumer) "apiConsumerId"
            eventType     = param @Text "eventType"
            targetUrl     = param @Text "targetUrl"
        consumer  <- fetch apiConsumerId

        -- Validate against allowed webhook topics
        unless (eventType `elem` allowedWebhookTopics) $ do
            setErrorMessage ("Unknown webhook topic: " <> eventType)
            redirectTo (NewWebhookSubscriptionAction apiConsumerId)

        -- Generate HMAC signing secret
        secretBytes <- liftIO $ Random.random 32
        let secret = TE.decodeUtf8 (Base16.encode secretBytes)
        _sub <- newRecord @WebhookSubscription
            |> set #apiConsumerId consumer.id
            |> set #eventType eventType
            |> set #targetUrl targetUrl
            |> set #secret secret
            |> set #isActive True
            |> createRecord
        redirectTo (ShowApiConsumerAction apiConsumerId)

    action ToggleWebhookSubscriptionAction { webhookSubscriptionId } = do
        sub     <- fetch webhookSubscriptionId
        sub     |> set #isActive (not sub.isActive) |> updateRecord
        consumer <- fetch sub.apiConsumerId
        redirectTo (ShowApiConsumerAction consumer.id)

    action DeleteWebhookSubscriptionAction { webhookSubscriptionId } = do
        sub      <- fetch webhookSubscriptionId
        consumerId <- pure sub.apiConsumerId
        deleteRecord sub
        redirectTo (ShowApiConsumerAction consumerId)