Webhook Examples

share-api.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.37.0.
+-- This file has been generated from package.yaml by hpack version 0.38.1.
 --
 -- see: https://github.com/sol/hpack
 
@@ -40,6 +40,7 @@ library
       Share.BackgroundJobs.Search.DefinitionSync
       Share.BackgroundJobs.Search.DefinitionSync.Types
       Share.BackgroundJobs.Webhooks.Queries
+      Share.BackgroundJobs.Webhooks.Types
       Share.BackgroundJobs.Webhooks.Worker
       Share.BackgroundJobs.Workers
       Share.Branch
@@ -188,6 +189,8 @@ library
       Share.Web.Share.Tickets.Types
       Share.Web.Share.Types
       Share.Web.Share.Users.API
+      Share.Web.Share.Webhooks.API
+      Share.Web.Share.Webhooks.Impl
       Share.Web.Support.API
       Share.Web.Support.Impl
       Share.Web.Support.Types

src/Share/BackgroundJobs/Webhooks/Types.hs

@@ -0,0 +1,146 @@
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Share.BackgroundJobs.Webhooks.Types
+  ( WebhookSendFailure (..),
+    WebhookEventPayload (..),
+  )
+where
+
+import Control.Lens hiding ((.=))
+import Crypto.JWT (JWTError)
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Aeson qualified as Aeson
+import Data.ByteString.Lazy.Char8 qualified as BL
+import Data.Text qualified as Text
+import Data.Text.Encoding qualified as Text
+import Data.Time (UTCTime)
+import Network.HTTP.Types qualified as HTTP
+import Servant.Server
+import Share.IDs
+import Share.JWT (JWTParam (..))
+import Share.JWT qualified as JWT
+import Share.Notifications.Types
+import Share.Notifications.Webhooks.Secrets (WebhookSecretError)
+import Share.Prelude
+import Share.Utils.Logging qualified as Logging
+import Share.Web.Errors
+import UnliftIO qualified
+
+data WebhookSendFailure
+  = ReceiverError NotificationEventId NotificationWebhookId HTTP.Status BL.ByteString
+  | InvalidRequest NotificationEventId NotificationWebhookId UnliftIO.SomeException
+  | WebhookSecretFetchError NotificationEventId NotificationWebhookId WebhookSecretError
+  | JWTError NotificationEventId NotificationWebhookId JWTError
+  deriving stock (Show)
+
+instance ToServerError WebhookSendFailure where
+  toServerError = \case
+    ReceiverError _eventId _webhookId status _body ->
+      ( ErrorID "webhook:receiver-error",
+        err500
+          { errBody =
+              BL.fromStrict $
+                Text.encodeUtf8 $
+                  "Webhook receiver returned error status: "
+                    <> Text.pack (show status)
+          }
+      )
+    InvalidRequest _eventId _webhookId _err ->
+      ( ErrorID "webhook:invalid-request",
+        err400
+          { errBody =
+              BL.fromStrict $
+                Text.encodeUtf8 $
+                  "Invalid webhook request."
+          }
+      )
+    WebhookSecretFetchError _eventId _webhookId _err ->
+      ( ErrorID "webhook:secret-fetch-error",
+        err500
+          { errBody =
+              BL.fromStrict $
+                Text.encodeUtf8 $
+                  "Failed to fetch webhook secret."
+          }
+      )
+    JWTError _eventId _webhookId _err ->
+      ( ErrorID "webhook:jwt-error",
+        err500
+          { errBody =
+              BL.fromStrict $
+                Text.encodeUtf8 $
+                  "Failed to generate or verify JWT."
+          }
+      )
+
+instance Logging.Loggable WebhookSendFailure where
+  toLog = \case
+    ReceiverError eventId webhookId status body ->
+      Logging.textLog
+        ( "Webhook receiver error: "
+            <> Text.pack (show status)
+            <> " "
+            <> Text.decodeUtf8 (BL.toStrict body)
+        )
+        & Logging.withTag ("status", tShow status)
+        & Logging.withTag ("event_id", tShow eventId)
+        & Logging.withTag ("webhook_id", tShow webhookId)
+        & Logging.withSeverity Logging.UserFault
+    InvalidRequest eventId webhookId err ->
+      Logging.textLog ("Invalid request: " <> Text.pack (show err))
+        & Logging.withTag ("event_id", tShow eventId)
+        & Logging.withTag ("webhook_id", tShow webhookId)
+        & Logging.withSeverity Logging.UserFault
+    WebhookSecretFetchError eventId webhookId err ->
+      Logging.textLog ("Failed to fetch webhook secret: " <> Text.pack (show err))
+        & Logging.withTag ("event_id", tShow eventId)
+        & Logging.withTag ("webhook_id", tShow webhookId)
+        & Logging.withSeverity Logging.Error
+    JWTError eventId webhookId err ->
+      Logging.textLog ("JWT error: " <> Text.pack (show err))
+        & Logging.withTag ("event_id", tShow eventId)
+        & Logging.withTag ("webhook_id", tShow webhookId)
+        & Logging.withSeverity Logging.Error
+
+data WebhookEventPayload jwt = WebhookEventPayload
+  { -- | The event ID of the notification event.
+    eventId :: NotificationEventId,
+    -- | The time at which the event occurred.
+    occurredAt :: UTCTime,
+    -- | The topic of the notification event.
+    topic :: NotificationTopic,
+    -- | The data associated with the notification event.
+    data_ :: HydratedEvent,
+    -- | A signed token containing all of the same data.
+    jwt :: jwt
+  }
+  deriving stock (Show, Eq)
+
+deriving via JWT.JSONJWTClaims (WebhookEventPayload ()) instance JWT.AsJWTClaims (WebhookEventPayload ())
+
+instance ToJSON (WebhookEventPayload JWTParam) where
+  toJSON WebhookEventPayload {eventId, occurredAt, topic, data_, jwt} =
+    Aeson.object
+      [ "eventId" Aeson..= eventId,
+        "occurredAt" Aeson..= occurredAt,
+        "topic" Aeson..= topic,
+        "data" Aeson..= data_,
+        "signed" Aeson..= jwt
+      ]
+
+instance ToJSON (WebhookEventPayload ()) where
+  toJSON WebhookEventPayload {eventId, occurredAt, topic, data_} =
+    Aeson.object
+      [ "eventId" Aeson..= eventId,
+        "occurredAt" Aeson..= occurredAt,
+        "topic" Aeson..= topic,
+        "data" Aeson..= data_
+      ]
+
+instance FromJSON (WebhookEventPayload ()) where
+  parseJSON = Aeson.withObject "WebhookEventPayload" $ \o -> do
+    eventId <- o Aeson..: "eventId"
+    occurredAt <- o Aeson..: "occurredAt"
+    topic <- o Aeson..: "topic"
+    data_ <- o Aeson..: "data"
+    pure WebhookEventPayload {eventId, occurredAt, topic, data_, jwt = ()}

src/Share/BackgroundJobs/Webhooks/Worker.hs

@@ -8,13 +8,10 @@ module Share.BackgroundJobs.Webhooks.Worker (worker) where
 
 import Control.Lens hiding ((.=))
 import Control.Monad.Except (ExceptT (..), runExceptT)
-import Crypto.JWT (JWTError)
-import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Aeson (ToJSON (..))
 import Data.Aeson qualified as Aeson
-import Data.ByteString.Lazy.Char8 qualified as BL
 import Data.List.Extra qualified as List
 import Data.Text qualified as Text
-import Data.Text.Encoding qualified as Text
 import Data.Time (UTCTime)
 import Ki.Unlifted qualified as Ki
 import Network.HTTP.Client qualified as HTTPClient
@@ -24,6 +21,7 @@ import Network.URI qualified as URI
 import Share.BackgroundJobs.Errors (reportError)
 import Share.BackgroundJobs.Monad (Background)
 import Share.BackgroundJobs.Webhooks.Queries qualified as WQ
+import Share.BackgroundJobs.Webhooks.Types
 import Share.BackgroundJobs.Workers (newWorker)
 import Share.ChatApps (Author (..))
 import Share.ChatApps qualified as ChatApps
@@ -37,7 +35,7 @@ import Share.Metrics qualified as Metrics
 import Share.Notifications.Ops qualified as NotOps
 import Share.Notifications.Queries qualified as NQ
 import Share.Notifications.Types
-import Share.Notifications.Webhooks.Secrets (WebhookConfig (..), WebhookSecretError)
+import Share.Notifications.Webhooks.Secrets (WebhookConfig (..))
 import Share.Notifications.Webhooks.Secrets qualified as Webhooks
 import Share.Postgres qualified as PG
 import Share.Postgres.Notifications qualified as Notif
@@ -53,42 +51,6 @@ import Share.Web.Share.DisplayInfo.Types qualified as DisplayInfo
 import Share.Web.UI.Links qualified as Links
 import UnliftIO qualified
 
-data WebhookSendFailure
-  = ReceiverError NotificationEventId NotificationWebhookId HTTP.Status BL.ByteString
-  | InvalidRequest NotificationEventId NotificationWebhookId UnliftIO.SomeException
-  | WebhookSecretFetchError NotificationEventId NotificationWebhookId WebhookSecretError
-  | JWTError NotificationEventId NotificationWebhookId JWTError
-  deriving stock (Show)
-
-instance Logging.Loggable WebhookSendFailure where
-  toLog = \case
-    ReceiverError eventId webhookId status body ->
-      Logging.textLog
-        ( "Webhook receiver error: "
-            <> Text.pack (show status)
-            <> " "
-            <> Text.decodeUtf8 (BL.toStrict body)
-        )
-        & Logging.withTag ("status", tShow status)
-        & Logging.withTag ("event_id", tShow eventId)
-        & Logging.withTag ("webhook_id", tShow webhookId)
-        & Logging.withSeverity Logging.UserFault
-    InvalidRequest eventId webhookId err ->
-      Logging.textLog ("Invalid request: " <> Text.pack (show err))
-        & Logging.withTag ("event_id", tShow eventId)
-        & Logging.withTag ("webhook_id", tShow webhookId)
-        & Logging.withSeverity Logging.UserFault
-    WebhookSecretFetchError eventId webhookId err ->
-      Logging.textLog ("Failed to fetch webhook secret: " <> Text.pack (show err))
-        & Logging.withTag ("event_id", tShow eventId)
-        & Logging.withTag ("webhook_id", tShow webhookId)
-        & Logging.withSeverity Logging.Error
-    JWTError eventId webhookId err ->
-      Logging.textLog ("JWT error: " <> Text.pack (show err))
-        & Logging.withTag ("event_id", tShow eventId)
-        & Logging.withTag ("webhook_id", tShow webhookId)
-        & Logging.withSeverity Logging.Error
-
 -- | Check every 10 minutes if we haven't heard on the notifications channel.
 -- Just in case we missed a notification.
 maxPollingIntervalSeconds :: Int
@@ -140,49 +102,6 @@ processWebhook authZReceipt = withSpan "background:webhooks:process-webhook" mem
 webhookTimeout :: HTTPClient.ResponseTimeout
 webhookTimeout = HTTPClient.responseTimeoutMicro (20 * 1000000 {- 20 seconds -})
 
-data WebhookEventPayload jwt = WebhookEventPayload
-  { -- | The event ID of the notification event.
-    eventId :: NotificationEventId,
-    -- | The time at which the event occurred.
-    occurredAt :: UTCTime,
-    -- | The topic of the notification event.
-    topic :: NotificationTopic,
-    -- | The data associated with the notification event.
-    data_ :: HydratedEvent,
-    -- | A signed token containing all of the same data.
-    jwt :: jwt
-  }
-  deriving stock (Show, Eq)
-
-deriving via JWT.JSONJWTClaims (WebhookEventPayload ()) instance JWT.AsJWTClaims (WebhookEventPayload ())
-
-instance ToJSON (WebhookEventPayload JWTParam) where
-  toJSON WebhookEventPayload {eventId, occurredAt, topic, data_, jwt} =
-    Aeson.object
-      [ "eventId" Aeson..= eventId,
-        "occurredAt" Aeson..= occurredAt,
-        "topic" Aeson..= topic,
-        "data" Aeson..= data_,
-        "signed" Aeson..= jwt
-      ]
-
-instance ToJSON (WebhookEventPayload ()) where
-  toJSON WebhookEventPayload {eventId, occurredAt, topic, data_} =
-    Aeson.object
-      [ "eventId" Aeson..= eventId,
-        "occurredAt" Aeson..= occurredAt,
-        "topic" Aeson..= topic,
-        "data" Aeson..= data_
-      ]
-
-instance FromJSON (WebhookEventPayload ()) where
-  parseJSON = Aeson.withObject "WebhookEventPayload" $ \o -> do
-    eventId <- o Aeson..: "eventId"
-    occurredAt <- o Aeson..: "occurredAt"
-    topic <- o Aeson..: "topic"
-    data_ <- o Aeson..: "data"
-    pure WebhookEventPayload {eventId, occurredAt, topic, data_, jwt = ()}
-
 tryWebhook ::
   NotificationEvent NotificationEventId UnifiedDisplayInfo UTCTime HydratedEvent ->
   NotificationWebhookId ->

src/Share/Notifications/Types.hs

@@ -71,7 +71,7 @@ data NotificationTopic
   | ProjectTicketStatusUpdated
   | ProjectTicketComment
   | ProjectReleaseCreated
-  deriving (Eq, Show, Ord)
+  deriving (Eq, Show, Ord, Enum, Bounded)
 
 instance PG.EncodeValue NotificationTopic where
   encodeValue = HasqlEncoders.enum \case

src/Share/Notifications/Webhooks/Secrets.hs

@@ -19,7 +19,7 @@ import Servant.Client qualified as ServantClient
 import Servant.Server (err500)
 import Share.App (AppM)
 import Share.Env qualified as Env
-import Share.IDs (NotificationWebhookId)
+import Share.IDs 
 import Share.IDs qualified as IDs
 import Share.Prelude
 import Share.Utils.Logging qualified as Logging

src/Share/Web/API.hs

@@ -14,6 +14,7 @@ import Share.Web.Share.API qualified as Share
 import Share.Web.Share.Orgs.API qualified as Orgs
 import Share.Web.Share.Projects.API qualified as Projects
 import Share.Web.Share.Users.API qualified as Users
+import Share.Web.Share.Webhooks.API qualified as Webhooks
 import Share.Web.Support.API qualified as Support
 import Share.Web.Types
 import Share.Web.UCM.SyncV2.API qualified as SyncV2
@@ -55,6 +56,7 @@ type API =
     :<|> ("ucm" :> "v1" :> "projects" :> MaybeAuthenticatedSession :> UCMProjects.ProjectsAPI)
     :<|> ("ucm" :> "v2" :> "sync" :> MaybeAuthenticatedUserId :> SyncV2.API)
     :<|> ("admin" :> Admin.API)
+    :<|> ("webhooks" :> Webhooks.API)
 
 api :: Proxy API
 api = Proxy @API

src/Share/Web/Impl.hs

@@ -24,6 +24,7 @@ import Share.Web.OAuth.Impl qualified as OAuth
 import Share.Web.Share.Impl qualified as Share
 import Share.Web.Share.Orgs.Impl qualified as Orgs
 import Share.Web.Share.Projects.Impl qualified as Projects
+import Share.Web.Share.Webhooks.Impl qualified as Webhooks
 import Share.Web.Support.Impl qualified as Support
 import Share.Web.Types
 import Share.Web.UCM.Projects.Impl qualified as UCMProjects
@@ -91,3 +92,4 @@ server =
     :<|> UCMProjects.server
     :<|> SyncV2.server
     :<|> Admin.server
+    :<|> Webhooks.server

src/Share/Web/Share/Webhooks/API.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Share.Web.Share.Webhooks.API
+  ( API,
+    Routes (..),
+    WebhookPayloadExamples,
+  )
+where
+
+import Servant
+import Share.BackgroundJobs.Webhooks.Types
+import Share.JWT
+import Share.Prelude
+
+type API = NamedRoutes Routes
+
+data Routes mode
+  = Routes
+  { payloadExamples :: mode :- "examples" :> WebhookExamplesEndpoint
+  }
+  deriving stock (Generic)
+
+type WebhookPayloadExamples = [WebhookEventPayload JWTParam]
+
+type WebhookExamplesEndpoint =
+  Get '[JSON] WebhookPayloadExamples