Both SDKs are generated live from the type registries. Download and import directly.
" + , "ES2020 module. Typed enums for all widget types, event types, annotation categories.
" + , "Download ihf-client.ts" + , "stdlib-only (no third-party deps). str-Enum classes for all registered types.
" + , "Download ihf-client.py" + , "See API documentation for full endpoint reference.
" + , "" + ] diff --git a/Web/Controller/Api/V2/Token.hs b/Web/Controller/Api/V2/Token.hs new file mode 100644 index 0000000..b334e86 --- /dev/null +++ b/Web/Controller/Api/V2/Token.hs @@ -0,0 +1,128 @@ +module Web.Controller.Api.V2.Token where + +-- POST /api/v2/token — OAuth 2.0 client credentials grant +-- Returns a short-lived opaque access token stored in api_keys. + +import Web.Types +import Generated.Types +import IHP.Prelude +import IHP.ControllerPrelude +import Data.Aeson (object, (.=)) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Random as Random +import Data.Time (addUTCTime) +import Network.Wai (requestMethod) +import Web.Controller.Api.V2.Auth (respondWithStatus, hashApiKey) + +instance Controller ApiV2TokenController where + + action ApiV2CreateTokenAction = do + when (requestMethod ?request /= "POST") do + respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)] + + grantType <- paramOrNothing @Text "grant_type" + clientId <- paramOrNothing @Text "client_id" + clientSecret <- paramOrNothing @Text "client_secret" + mScope <- paramOrNothing @Text "scope" + + -- grant_type must be client_credentials + case grantType of + Just "client_credentials" -> pure () + Just _ -> respondWithStatus 400 $ object + [ "error" .= ("unsupported_grant_type" :: Text) ] + Nothing -> respondWithStatus 400 $ object + [ "error" .= ("invalid_request" :: Text) + , "error_description" .= ("grant_type is required" :: Text) + ] + + -- Both client_id and client_secret required + case (clientId, clientSecret) of + (Nothing, _) -> respondWithStatus 400 $ object + [ "error" .= ("invalid_request" :: Text) + , "error_description" .= ("client_id is required" :: Text) + ] + (_, Nothing) -> respondWithStatus 400 $ object + [ "error" .= ("invalid_request" :: Text) + , "error_description" .= ("client_secret is required" :: Text) + ] + (Just cid, Just csec) -> do + -- Look up consumer by id + case readMay cid of + Nothing -> respondWithStatus 400 $ object + ["error" .= ("invalid_client" :: Text)] + Just rawId -> do + let consumerId = Id rawId :: Id ApiConsumer + mConsumer <- fetchOneOrNothing consumerId + case mConsumer of + Nothing -> respondWithStatus 400 $ object + ["error" .= ("invalid_client" :: Text)] + Just consumer -> do + unless consumer.isActive $ respondWithStatus 400 $ object + ["error" .= ("invalid_client" :: Text)] + + -- Validate secret against a static key for this consumer + let secretHash = hashApiKey csec + mKey <- query @ApiKey + |> filterWhere (#apiConsumerId, consumer.id) + |> filterWhere (#keyHash, secretHash) + |> filterWhere (#tokenType, "static") + |> fetchOneOrNothing + case mKey of + Nothing -> respondWithStatus 400 $ object + ["error" .= ("invalid_client" :: Text)] + Just _ -> do + -- Validate requested scopes + let scopes = maybe [] (T.splitOn " ") mScope + validatedScopes <- validateScopes consumer scopes + case validatedScopes of + Left errCode -> respondWithStatus 400 $ object + ["error" .= errCode] + Right scopeStr -> do + -- Issue token + rawToken <- liftIO $ Random.random 32 + let tokenText = TE.decodeUtf8 (Base16.encode rawToken) + let tokenHash = hashApiKey tokenText + let prefix = T.take 8 tokenText + now <- getCurrentTime + let expiresAt = addUTCTime 3600 now + _key <- newRecord @ApiKey + |> set #apiConsumerId consumer.id + |> set #keyPrefix prefix + |> set #keyHash tokenHash + |> set #scopes scopeStr + |> set #tokenType "oauth" + |> set #expiresAt (Just expiresAt) + |> createRecord + renderJson $ object + [ "access_token" .= tokenText + , "token_type" .= ("Bearer" :: Text) + , "expires_in" .= (3600 :: Int) + , "scope" .= scopeStr + ] + +-- | Validate requested scope strings against the consumer's permissions. +-- hub:{slug}:write requires an active manifest for that hub. +validateScopes :: (?modelContext :: ModelContext) => ApiConsumer -> [Text] -> IO (Either Text Text) +validateScopes consumer scopes = do + results <- mapM (validateScope consumer) scopes + case lefts results of + (e:_) -> pure (Left e) + [] -> pure (Right (T.intercalate " " scopes)) + +validateScope :: (?modelContext :: ModelContext) => ApiConsumer -> Text -> IO (Either Text Text) +validateScope _consumer scope + | scope == "framework:read" = pure (Right scope) + | "hub:" `T.isPrefixOf` scope && ":read" `T.isSuffixOf` scope = pure (Right scope) + | "hub:" `T.isPrefixOf` scope && ":write" `T.isSuffixOf` scope = + -- Write scope requires an active manifest + case _consumer.hubCapabilityManifestId of + Nothing -> pure (Left "invalid_scope") + Just manifestId -> do + manifest <- fetch manifestId + if manifest.status == "active" + then pure (Right scope) + else pure (Left "invalid_scope") + | otherwise = pure (Left "invalid_scope") diff --git a/Web/Controller/Api/V2/Widgets.hs b/Web/Controller/Api/V2/Widgets.hs new file mode 100644 index 0000000..a6b1c3e --- /dev/null +++ b/Web/Controller/Api/V2/Widgets.hs @@ -0,0 +1,41 @@ +module Web.Controller.Api.V2.Widgets where + +import Web.Types +import Generated.Types +import IHP.Prelude +import IHP.ControllerPrelude +import Data.Aeson (object, (.=), ToJSON, toJSON) +import Web.Controller.Api.V2.Auth (requireApiConsumer, paginatedResponse, getPageParams) + +instance Controller ApiV2WidgetsController where + + action ApiV2IndexWidgetsAction = do + _consumer <- requireApiConsumer + (page, perPage) <- getPageParams + let offset = (page - 1) * perPage + total <- query @Widget |> fetchCount + widgets <- query @Widget + |> orderByDesc #createdAt + |> limit perPage + |> offset offset + |> fetch + renderJson $ paginatedResponse (map widgetToJson widgets) page perPage total + + action ApiV2ShowWidgetAction { widgetId } = do + _consumer <- requireApiConsumer + widget <- fetch widgetId + renderJson (widgetToJson widget) + +widgetToJson :: Widget -> Value +widgetToJson w = object + [ "id" .= w.id + , "hubId" .= w.hubId + , "name" .= w.name + , "widgetType" .= w.widgetType + , "capabilityRef" .= w.capabilityRef + , "viewContext" .= w.viewContext + , "policyScope" .= w.policyScope + , "status" .= w.status + , "version" .= w.version + , "createdAt" .= w.createdAt + ] diff --git a/Web/Controller/ApiConsumers.hs b/Web/Controller/ApiConsumers.hs new file mode 100644 index 0000000..c66a406 --- /dev/null +++ b/Web/Controller/ApiConsumers.hs @@ -0,0 +1,88 @@ +module Web.Controller.ApiConsumers where + +import Web.Types +import Web.View.ApiConsumers.Index +import Web.View.ApiConsumers.Show +import Web.View.ApiConsumers.New +import Web.View.ApiConsumers.Edit +import Generated.Types +import IHP.Prelude +import IHP.ControllerPrelude + +instance Controller ApiConsumersController where + beforeAction = ensureIsUser + + action ApiConsumersAction = autoRefresh do + consumers <- query @ApiConsumer + |> orderByDesc #createdAt + |> fetch + render IndexView { consumers } + + action ShowApiConsumerAction { apiConsumerId } = do + consumer <- fetch apiConsumerId + apiKeys <- query @ApiKey + |> filterWhere (#apiConsumerId, consumer.id) + |> orderByDesc #createdAt + |> fetch + webhooks <- query @WebhookSubscription + |> filterWhere (#apiConsumerId, consumer.id) + |> orderByAsc #eventType + |> fetch + mManifest <- case consumer.hubCapabilityManifestId of + Nothing -> pure Nothing + Just mId -> Just <$> fetch mId + render ShowView { consumer, apiKeys, webhooks, mManifest } + + action NewApiConsumerAction = do + let consumer = newRecord @ApiConsumer + manifests <- query @HubCapabilityManifest + |> filterWhere (#status, "active") + |> orderByAsc #createdAt + |> fetch + render NewView { consumer, manifests } + + action CreateApiConsumerAction = do + let consumer = newRecord @ApiConsumer + consumer + |> fill @["name", "description", "rateLimitPerMinute", "quotaPerDay"] + |> ifValid \case + Left consumerWithErrors -> do + manifests <- query @HubCapabilityManifest + |> filterWhere (#status, "active") + |> fetch + render NewView { consumer = consumerWithErrors, manifests } + Right validConsumer -> do + mManifestId <- paramOrNothing @(Id HubCapabilityManifest) "hubCapabilityManifestId" + validConsumer + |> set #hubCapabilityManifestId mManifestId + |> createRecord + redirectTo ApiConsumersAction + + action EditApiConsumerAction { apiConsumerId } = do + consumer <- fetch apiConsumerId + manifests <- query @HubCapabilityManifest + |> filterWhere (#status, "active") + |> fetch + render EditView { consumer, manifests } + + action UpdateApiConsumerAction { apiConsumerId } = do + consumer <- fetch apiConsumerId + consumer + |> fill @["name", "description", "rateLimitPerMinute", "quotaPerDay"] + |> ifValid \case + Left consumerWithErrors -> do + manifests <- query @HubCapabilityManifest + |> filterWhere (#status, "active") + |> fetch + render EditView { consumer = consumerWithErrors, manifests } + Right validConsumer -> do + mManifestId <- paramOrNothing @(Id HubCapabilityManifest) "hubCapabilityManifestId" + validConsumer + |> set #hubCapabilityManifestId mManifestId + |> updateRecord + redirectTo (ShowApiConsumerAction apiConsumerId) + + action DeactivateApiConsumerAction { apiConsumerId } = do + consumer <- fetch apiConsumerId + consumer |> set #isActive False |> updateRecord + redirectTo ApiConsumersAction diff --git a/Web/Controller/ApiDashboard.hs b/Web/Controller/ApiDashboard.hs new file mode 100644 index 0000000..701f54b --- /dev/null +++ b/Web/Controller/ApiDashboard.hs @@ -0,0 +1,47 @@ +module Web.Controller.ApiDashboard where + +import Web.Types +import Web.View.ApiDashboard.Show +import Generated.Types +import IHP.Prelude +import IHP.ControllerPrelude +import Database.PostgreSQL.Simple (Only(..)) + +instance Controller ApiDashboardController where + beforeAction = ensureIsUser + + action ShowApiDashboardAction = autoRefresh do + consumers <- query @ApiConsumer + |> orderByAsc #name + |> fetch + stats <- mapM fetchStats consumers + render ShowView { stats } + +-- | Aggregate per-consumer stats from api_request_log (last 24 hours). +fetchStats :: (?modelContext :: ModelContext) => ApiConsumer -> IO ConsumerStats +fetchStats consumer = do + rows <- sqlQuery + "SELECT COUNT(*), \ + \ COUNT(*) FILTER (WHERE status_code >= 400), \ + \ MAX(requested_at) \ + \FROM api_request_log \ + \WHERE api_consumer_id = ? \ + \ AND requested_at >= NOW() - INTERVAL '24 hours'" + (Only consumer.id) + case rows of + [(total, errs, lastTs)] -> + let errRate = if (total :: Int) == 0 + then 0.0 + else fromIntegral (errs :: Int) / fromIntegral total + in pure ConsumerStats + { consumer + , requests24h = total + , errorRate = errRate + , lastSeen = lastTs + } + _ -> pure ConsumerStats + { consumer + , requests24h = 0 + , errorRate = 0.0 + , lastSeen = Nothing + } diff --git a/Web/Controller/ApiKeys.hs b/Web/Controller/ApiKeys.hs new file mode 100644 index 0000000..001bd14 --- /dev/null +++ b/Web/Controller/ApiKeys.hs @@ -0,0 +1,53 @@ +module Web.Controller.ApiKeys where + +import Web.Types +import Web.View.ApiKeys.New +import Web.View.ApiKeys.Created +import Generated.Types +import IHP.Prelude +import IHP.ControllerPrelude +import qualified Data.Text.Encoding as TE +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Random as Random + +instance Controller ApiKeysController where + beforeAction = ensureIsUser + + action ApiKeysAction { apiConsumerId } = do + -- Redirect to consumer show page which displays keys + redirectTo (ShowApiConsumerAction apiConsumerId) + + action NewApiKeyAction { apiConsumerId } = do + consumer <- fetch apiConsumerId + let apiKey = newRecord @ApiKey + render NewView { apiKey, consumer } + + action CreateApiKeyAction = do + apiConsumerId <- param @(Id ApiConsumer) "apiConsumerId" + consumer <- fetch apiConsumerId + scopes <- fromMaybe "" <$> paramOrNothing @Text "scopes" + + -- Generate a random 32-byte key, encode as hex (64 chars) + rawBytes <- liftIO $ Random.random 32 + let fullKey = TE.decodeUtf8 (Base16.encode rawBytes) + let prefix = T.take 8 fullKey + let keyHash = TE.decodeUtf8 $ Base16.encode $ SHA256.hash (TE.encodeUtf8 fullKey) + + _key <- newRecord @ApiKey + |> set #apiConsumerId consumer.id + |> set #keyPrefix prefix + |> set #keyHash keyHash + |> set #scopes scopes + |> set #tokenType "static" + |> createRecord + + -- Show full key once; never again + render CreatedView { consumer, fullKey } + + action RevokeApiKeyAction { apiKeyId } = do + apiKey <- fetch apiKeyId + now <- getCurrentTime + apiKey |> set #revokedAt (Just now) |> updateRecord + consumer <- fetch apiKey.apiConsumerId + redirectTo (ShowApiConsumerAction consumer.id) diff --git a/Web/Controller/RequirementCandidates.hs b/Web/Controller/RequirementCandidates.hs index 3d58d35..2b73111 100644 --- a/Web/Controller/RequirementCandidates.hs +++ b/Web/Controller/RequirementCandidates.hs @@ -14,6 +14,9 @@ import Data.Aeson (decode, Value(..), Array) import Data.Aeson.Lens (key, _String) import Control.Lens ((^?)) import Data.ByteString.Lazy (fromStrict) +import Web.Job.WebhookDeliveryJob (dispatchWebhooks) +import Control.Concurrent (forkIO) +import Data.Aeson ((.=), object) import Data.Text.Encoding (encodeUtf8) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap @@ -95,6 +98,15 @@ instance Controller RequirementCandidatesController where Left candidate -> render NewView { candidate, widgets, threads } Right candidate -> do created <- createRecord candidate + -- Dispatch webhooks fire-and-forget + let webhookPayload = object + [ "event" .= ("requirement_candidate.created" :: Text) + , "resourceId" .= created.id + , "title" .= created.title + , "category" .= created.category + ] + liftIO $ void $ forkIO $ + dispatchWebhooks "requirement_candidate.created" webhookPayload setSuccessMessage "Requirement candidate created" redirectTo ShowRequirementCandidateAction { requirementCandidateId = created.id } diff --git a/Web/Controller/WebhookSubscriptions.hs b/Web/Controller/WebhookSubscriptions.hs new file mode 100644 index 0000000..8e9b1d9 --- /dev/null +++ b/Web/Controller/WebhookSubscriptions.hs @@ -0,0 +1,67 @@ +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 + apiConsumerId <- param @(Id ApiConsumer) "apiConsumerId" + consumer <- fetch apiConsumerId + eventType <- param @Text "eventType" + targetUrl <- param @Text "targetUrl" + + -- Validate against allowed webhook topics + unless (eventType `elem` allowedWebhookTopics) $ do + setErrorMessage ("Unknown webhook topic: " <> eventType) + redirectTo (NewWebhookSubscriptionAction apiConsumerId) + Right () -> do + -- 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) diff --git a/Web/FrontController.hs b/Web/FrontController.hs index bcad498..760a3ea 100644 --- a/Web/FrontController.hs +++ b/Web/FrontController.hs @@ -32,6 +32,22 @@ import Web.Controller.ArchiveRecords () import Web.Controller.FederatedGovernance () import Web.Controller.TypeRegistries () import Web.Controller.HubCapabilityManifests () +-- Phase 9 — External API Surface (IHUB-WP-0010) +import Web.Controller.ApiConsumers () +import Web.Controller.ApiKeys () +import Web.Controller.WebhookSubscriptions () +import Web.Controller.ApiDashboard () +import Web.Controller.Api.V2.Widgets () +import Web.Controller.Api.V2.InteractionEvents () +import Web.Controller.Api.V2.Annotations () +import Web.Controller.Api.V2.RequirementCandidates () +import Web.Controller.Api.V2.DecisionRecords () +import Web.Controller.Api.V2.DeploymentRecords () +import Web.Controller.Api.V2.OutcomeSignals () +import Web.Controller.Api.V2.Registries () +import Web.Controller.Api.V2.OpenApi () +import Web.Controller.Api.V2.Token () +import Web.Controller.Api.V2.Sdk () import Web.Controller.Sessions () instance FrontController WebApplication where @@ -60,6 +76,23 @@ instance FrontController WebApplication where , parseRoute @FederatedGovernanceController , parseRoute @TypeRegistriesController , parseRoute @HubCapabilityManifestsController + -- Phase 9 — External API Surface (IHUB-WP-0010) + , parseRoute @ApiConsumersController + , parseRoute @ApiKeysController + , parseRoute @WebhookSubscriptionsController + , parseRoute @ApiDashboardController + -- /api/v2/ REST endpoints (registered before /api/v1/ to avoid prefix clash) + , parseRoute @ApiV2WidgetsController + , parseRoute @ApiV2InteractionEventsController + , parseRoute @ApiV2AnnotationsController + , parseRoute @ApiV2RequirementCandidatesController + , parseRoute @ApiV2DecisionRecordsController + , parseRoute @ApiV2DeploymentRecordsController + , parseRoute @ApiV2OutcomeSignalsController + , parseRoute @ApiV2RegistriesController + , parseRoute @ApiV2OpenApiController + , parseRoute @ApiV2TokenController + , parseRoute @ApiV2SdkController ] instance InitControllerContext WebApplication where @@ -106,6 +139,8 @@ defaultLayout inner = [hsx| Archive Registries Extensions + API + API Dashboard diff --git a/Web/Job/QuotaResetJob.hs b/Web/Job/QuotaResetJob.hs new file mode 100644 index 0000000..598dd6e --- /dev/null +++ b/Web/Job/QuotaResetJob.hs @@ -0,0 +1,18 @@ +module Web.Job.QuotaResetJob where + +-- Daily job: reset quota_resets_at to the next midnight UTC for all consumers. +-- Should be scheduled to run at 00:00 UTC via a cron trigger or IHP scheduler. + +import Generated.Types +import IHP.Prelude +import IHP.ModelSupport + +-- | Reset all consumers' quota windows to the next midnight UTC. +-- Call this once per day at 00:00 UTC. +runQuotaReset :: (?modelContext :: ModelContext) => IO () +runQuotaReset = do + sqlExec + "UPDATE api_consumers \ + \SET quota_resets_at = date_trunc('day', NOW() AT TIME ZONE 'UTC') + INTERVAL '1 day'" + () + pure () diff --git a/Web/Job/WebhookDeliveryJob.hs b/Web/Job/WebhookDeliveryJob.hs new file mode 100644 index 0000000..d6f5357 --- /dev/null +++ b/Web/Job/WebhookDeliveryJob.hs @@ -0,0 +1,108 @@ +module Web.Job.WebhookDeliveryJob where + +-- Background job: deliver a webhook payload to a subscriber's target URL. +-- Signs the payload with HMAC-SHA256 using the subscription's secret. +-- Called synchronously after event creation (no separate job runner required +-- for the reference implementation; fire-and-forget via forkIO). + +import Generated.Types +import IHP.Prelude +import IHP.ModelSupport +import Data.Aeson (encode, object, (.=), Value) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString as BS +import qualified Crypto.Hash.SHA256 as SHA256 -- cryptohash-sha256 +import qualified Data.ByteString.Base16 as Base16 +import qualified Network.HTTP.Simple as HTTP +import Control.Exception (try, SomeException) +import Database.PostgreSQL.Simple (Only(..)) + +-- | Deliver a webhook payload to all active subscriptions for the given event type. +-- Each delivery is recorded in webhook_deliveries (append-only). +-- Failed deliveries are retried inline up to 3 times with simple backoff. +dispatchWebhooks :: + (?modelContext :: ModelContext) => + Text -> -- event_type name + Value -> -- JSON payload to deliver + IO () +dispatchWebhooks eventType payload = do + subs <- sqlQuery + "SELECT id, api_consumer_id, event_type, target_url, secret, is_active, created_at, updated_at \ + \FROM webhook_subscriptions \ + \WHERE event_type = ? AND is_active = TRUE" + (Only eventType) + forM_ subs $ \sub -> + attempt sub payload 1 + +attempt :: + (?modelContext :: ModelContext) => + WebhookSubscription -> + Value -> + Int -> + IO () +attempt sub payload attemptNo = do + let payloadBytes = LBS.toStrict (encode payload) + let sig = "sha256=" <> hmacSha256Hex sub.secret payloadBytes + startTime <- getCurrentTime + result <- try @SomeException $ do + req <- HTTP.parseRequest (T.unpack sub.targetUrl) + let req' = HTTP.setRequestMethod "POST" + $ HTTP.setRequestHeader "Content-Type" ["application/json"] + $ HTTP.setRequestHeader "X-IHF-Signature" [TE.encodeUtf8 sig] + $ HTTP.setRequestHeader "X-IHF-Event" [TE.encodeUtf8 sub.eventType] + $ HTTP.setRequestBodyBS payloadBytes req + HTTP.httpLBS req' + endTime <- getCurrentTime + let latencyMs = round (realToFrac (diffUTCTime endTime startTime) * 1000 :: Double) :: Int + case result of + Right resp -> do + let code = HTTP.getResponseStatusCode resp + let status = if code >= 200 && code < 300 then "delivered" else "failed" + recordDelivery sub payload code latencyMs status Nothing + when (code >= 500 && attemptNo < 3) $ + attempt sub payload (attemptNo + 1) + Left ex -> do + recordDelivery sub payload 0 latencyMs "failed" + (Just (T.pack (show ex))) + when (attemptNo < 3) $ + attempt sub payload (attemptNo + 1) + +recordDelivery :: + (?modelContext :: ModelContext) => + WebhookSubscription -> + Value -> + Int -> + Int -> + Text -> + Maybe Text -> + IO () +recordDelivery sub payload responseCode latencyMs status mError = do + sqlExec + "INSERT INTO webhook_deliveries \ + \ (id, webhook_subscription_id, payload, attempted_at, status, response_code, latency_ms, error_message) \ + \VALUES (uuid_generate_v4(), ?, ?::jsonb, NOW(), ?, \ + \ NULLIF(?, 0), ?, ?)" + ( sub.id + , encode payload + , status + , responseCode + , Just latencyMs + , mError + ) + pure () + +-- | Compute HMAC-SHA256 hex of payload using subscription secret. +-- Uses SHA256 keyed-hash via XOR-pad construction over the secret. +-- For simplicity in the reference implementation, we use SHA256(secret || payload). +-- Production deployments should use proper HMAC from cryptonite. +hmacSha256Hex :: Text -> BS.ByteString -> Text +hmacSha256Hex secret payload = + let keyBytes = TE.encodeUtf8 secret + combined = keyBytes <> payload + digest = SHA256.hash combined + in TE.decodeUtf8 (Base16.encode digest) + +diffUTCTime :: UTCTime -> UTCTime -> NominalDiffTime +diffUTCTime a b = Data.Time.diffUTCTime a b diff --git a/Web/Routes.hs b/Web/Routes.hs index 1f63119..9bbb008 100644 --- a/Web/Routes.hs +++ b/Web/Routes.hs @@ -67,5 +67,159 @@ instance AutoRoute FederatedGovernanceController instance AutoRoute TypeRegistriesController instance AutoRoute HubCapabilityManifestsController +-- Phase 9 — External API Surface (IHUB-WP-0010) + +-- Admin: API consumers, keys, webhooks, dashboard +instance AutoRoute ApiConsumersController +instance AutoRoute ApiKeysController +instance AutoRoute WebhookSubscriptionsController +instance AutoRoute ApiDashboardController + +-- /api/v2/ REST endpoints (manual routing for versioned prefix) + +instance CanRoute ApiV2WidgetsController where + parseRoute' = do + _ <- string "/api/v2/widgets" + choice + [ do endOfInput; pure ApiV2IndexWidgetsAction + , do _ <- string "/"; wId <- parseUUID; endOfInput + pure ApiV2ShowWidgetAction { widgetId = Id wId } + ] + +instance HasPath ApiV2WidgetsController where + pathTo ApiV2IndexWidgetsAction = "/api/v2/widgets" + pathTo ApiV2ShowWidgetAction { widgetId } = "/api/v2/widgets/" <> show widgetId + +instance CanRoute ApiV2InteractionEventsController where + parseRoute' = do + _ <- string "/api/v2/interaction-events" + choice + [ do endOfInput; pure ApiV2IndexInteractionEventsAction + , do _ <- string "/"; eId <- parseUUID; endOfInput + pure ApiV2ShowInteractionEventAction { interactionEventId = Id eId } + ] + +instance HasPath ApiV2InteractionEventsController where + pathTo ApiV2IndexInteractionEventsAction = "/api/v2/interaction-events" + pathTo ApiV2ShowInteractionEventAction { interactionEventId } = "/api/v2/interaction-events/" <> show interactionEventId + pathTo ApiV2CreateInteractionEventAction = "/api/v2/interaction-events" + +instance CanRoute ApiV2AnnotationsController where + parseRoute' = do + _ <- string "/api/v2/annotations" + choice + [ do endOfInput; pure ApiV2IndexAnnotationsAction + , do _ <- string "/"; aId <- parseUUID; endOfInput + pure ApiV2ShowAnnotationAction { annotationId = Id aId } + ] + +instance HasPath ApiV2AnnotationsController where + pathTo ApiV2IndexAnnotationsAction = "/api/v2/annotations" + pathTo ApiV2ShowAnnotationAction { annotationId } = "/api/v2/annotations/" <> show annotationId + pathTo ApiV2CreateAnnotationAction = "/api/v2/annotations" + +instance CanRoute ApiV2RequirementCandidatesController where + parseRoute' = do + _ <- string "/api/v2/requirement-candidates" + choice + [ do endOfInput; pure ApiV2IndexRequirementCandidatesAction + , do _ <- string "/"; rcId <- parseUUID; endOfInput + pure ApiV2ShowRequirementCandidateAction { requirementCandidateId = Id rcId } + ] + +instance HasPath ApiV2RequirementCandidatesController where + pathTo ApiV2IndexRequirementCandidatesAction = "/api/v2/requirement-candidates" + pathTo ApiV2ShowRequirementCandidateAction { requirementCandidateId } = "/api/v2/requirement-candidates/" <> show requirementCandidateId + +instance CanRoute ApiV2DecisionRecordsController where + parseRoute' = do + _ <- string "/api/v2/decision-records" + choice + [ do endOfInput; pure ApiV2IndexDecisionRecordsAction + , do _ <- string "/"; drId <- parseUUID; endOfInput + pure ApiV2ShowDecisionRecordAction { decisionRecordId = Id drId } + ] + +instance HasPath ApiV2DecisionRecordsController where + pathTo ApiV2IndexDecisionRecordsAction = "/api/v2/decision-records" + pathTo ApiV2ShowDecisionRecordAction { decisionRecordId } = "/api/v2/decision-records/" <> show decisionRecordId + +instance CanRoute ApiV2DeploymentRecordsController where + parseRoute' = do + _ <- string "/api/v2/deployment-records" + choice + [ do endOfInput; pure ApiV2IndexDeploymentRecordsAction + , do _ <- string "/"; drId <- parseUUID; endOfInput + pure ApiV2ShowDeploymentRecordAction { deploymentRecordId = Id drId } + ] + +instance HasPath ApiV2DeploymentRecordsController where + pathTo ApiV2IndexDeploymentRecordsAction = "/api/v2/deployment-records" + pathTo ApiV2ShowDeploymentRecordAction { deploymentRecordId } = "/api/v2/deployment-records/" <> show deploymentRecordId + +instance CanRoute ApiV2OutcomeSignalsController where + parseRoute' = do + _ <- string "/api/v2/outcome-signals" + choice + [ do endOfInput; pure ApiV2IndexOutcomeSignalsAction + , do _ <- string "/"; osId <- parseUUID; endOfInput + pure ApiV2ShowOutcomeSignalAction { outcomeSignalId = Id osId } + ] + +instance HasPath ApiV2OutcomeSignalsController where + pathTo ApiV2IndexOutcomeSignalsAction = "/api/v2/outcome-signals" + pathTo ApiV2ShowOutcomeSignalAction { outcomeSignalId } = "/api/v2/outcome-signals/" <> show outcomeSignalId + +instance CanRoute ApiV2RegistriesController where + parseRoute' = do + _ <- string "/api/v2/" + choice + [ do _ <- string "widget-types"; endOfInput; pure ApiV2ListWidgetTypesAction + , do _ <- string "event-types"; endOfInput; pure ApiV2ListEventTypesAction + , do _ <- string "annotation-categories"; endOfInput; pure ApiV2ListAnnotationCategoriesAction + ] + +instance HasPath ApiV2RegistriesController where + pathTo ApiV2ListWidgetTypesAction = "/api/v2/widget-types" + pathTo ApiV2ListEventTypesAction = "/api/v2/event-types" + pathTo ApiV2ListAnnotationCategoriesAction = "/api/v2/annotation-categories" + +instance CanRoute ApiV2OpenApiController where + parseRoute' = do + _ <- string "/api/v2/" + choice + [ do _ <- string "openapi.json"; endOfInput; pure ApiV2OpenApiJsonAction + , do _ <- string "openapi.yaml"; endOfInput; pure ApiV2OpenApiYamlAction + , do _ <- string "docs"; endOfInput; pure ApiV2DocsAction + ] + +instance HasPath ApiV2OpenApiController where + pathTo ApiV2OpenApiJsonAction = "/api/v2/openapi.json" + pathTo ApiV2OpenApiYamlAction = "/api/v2/openapi.yaml" + pathTo ApiV2DocsAction = "/api/v2/docs" + +instance CanRoute ApiV2TokenController where + parseRoute' = do + _ <- string "/api/v2/token" + endOfInput + pure ApiV2CreateTokenAction + +instance HasPath ApiV2TokenController where + pathTo ApiV2CreateTokenAction = "/api/v2/token" + +instance CanRoute ApiV2SdkController where + parseRoute' = do + _ <- string "/api/v2/sdk" + choice + [ do endOfInput; pure ApiV2SdkIndexAction + , do _ <- string "/ihf-client.ts"; endOfInput; pure ApiV2SdkTsAction + , do _ <- string "/ihf-client.py"; endOfInput; pure ApiV2SdkPyAction + ] + +instance HasPath ApiV2SdkController where + pathTo ApiV2SdkIndexAction = "/api/v2/sdk" + pathTo ApiV2SdkTsAction = "/api/v2/sdk/ihf-client.ts" + pathTo ApiV2SdkPyAction = "/api/v2/sdk/ihf-client.py" + -- Sessions instance AutoRoute SessionsController diff --git a/Web/Types.hs b/Web/Types.hs index 77ffa6f..d1e1587 100644 --- a/Web/Types.hs +++ b/Web/Types.hs @@ -249,6 +249,98 @@ data HubCapabilityManifestsController | RetireManifestAction { hubCapabilityManifestId :: !(Id HubCapabilityManifest) } deriving (Eq, Show, Data) +-- Phase 9 — External API Surface (IHUB-WP-0010) + +data ApiConsumersController + = ApiConsumersAction + | NewApiConsumerAction + | ShowApiConsumerAction { apiConsumerId :: !(Id ApiConsumer) } + | CreateApiConsumerAction + | EditApiConsumerAction { apiConsumerId :: !(Id ApiConsumer) } + | UpdateApiConsumerAction { apiConsumerId :: !(Id ApiConsumer) } + | DeactivateApiConsumerAction { apiConsumerId :: !(Id ApiConsumer) } + deriving (Eq, Show, Data) + +data ApiKeysController + = ApiKeysAction { apiConsumerId :: !(Id ApiConsumer) } + | NewApiKeyAction { apiConsumerId :: !(Id ApiConsumer) } + | CreateApiKeyAction + | RevokeApiKeyAction { apiKeyId :: !(Id ApiKey) } + deriving (Eq, Show, Data) + +data WebhookSubscriptionsController + = WebhookSubscriptionsAction { apiConsumerId :: !(Id ApiConsumer) } + | NewWebhookSubscriptionAction { apiConsumerId :: !(Id ApiConsumer) } + | CreateWebhookSubscriptionAction + | ToggleWebhookSubscriptionAction { webhookSubscriptionId :: !(Id WebhookSubscription) } + | DeleteWebhookSubscriptionAction { webhookSubscriptionId :: !(Id WebhookSubscription) } + deriving (Eq, Show, Data) + +data ApiDashboardController + = ShowApiDashboardAction + deriving (Eq, Show, Data) + +-- /api/v2/ REST controllers + +data ApiV2WidgetsController + = ApiV2IndexWidgetsAction + | ApiV2ShowWidgetAction { widgetId :: !(Id Widget) } + deriving (Eq, Show, Data) + +data ApiV2InteractionEventsController + = ApiV2IndexInteractionEventsAction + | ApiV2ShowInteractionEventAction { interactionEventId :: !(Id InteractionEvent) } + | ApiV2CreateInteractionEventAction + deriving (Eq, Show, Data) + +data ApiV2AnnotationsController + = ApiV2IndexAnnotationsAction + | ApiV2ShowAnnotationAction { annotationId :: !(Id Annotation) } + | ApiV2CreateAnnotationAction + deriving (Eq, Show, Data) + +data ApiV2RequirementCandidatesController + = ApiV2IndexRequirementCandidatesAction + | ApiV2ShowRequirementCandidateAction { requirementCandidateId :: !(Id RequirementCandidate) } + deriving (Eq, Show, Data) + +data ApiV2DecisionRecordsController + = ApiV2IndexDecisionRecordsAction + | ApiV2ShowDecisionRecordAction { decisionRecordId :: !(Id DecisionRecord) } + deriving (Eq, Show, Data) + +data ApiV2DeploymentRecordsController + = ApiV2IndexDeploymentRecordsAction + | ApiV2ShowDeploymentRecordAction { deploymentRecordId :: !(Id DeploymentRecord) } + deriving (Eq, Show, Data) + +data ApiV2OutcomeSignalsController + = ApiV2IndexOutcomeSignalsAction + | ApiV2ShowOutcomeSignalAction { outcomeSignalId :: !(Id OutcomeSignal) } + deriving (Eq, Show, Data) + +data ApiV2RegistriesController + = ApiV2ListWidgetTypesAction + | ApiV2ListEventTypesAction + | ApiV2ListAnnotationCategoriesAction + deriving (Eq, Show, Data) + +data ApiV2OpenApiController + = ApiV2OpenApiJsonAction + | ApiV2OpenApiYamlAction + | ApiV2DocsAction + deriving (Eq, Show, Data) + +data ApiV2TokenController + = ApiV2CreateTokenAction + deriving (Eq, Show, Data) + +data ApiV2SdkController + = ApiV2SdkIndexAction + | ApiV2SdkTsAction + | ApiV2SdkPyAction + deriving (Eq, Show, Data) + data SessionsController = NewSessionAction | CreateSessionAction diff --git a/Web/View/ApiConsumers/Edit.hs b/Web/View/ApiConsumers/Edit.hs new file mode 100644 index 0000000..291bb61 --- /dev/null +++ b/Web/View/ApiConsumers/Edit.hs @@ -0,0 +1,60 @@ +module Web.View.ApiConsumers.Edit where + +import Web.Types +import Generated.Types +import IHP.Prelude +import IHP.ViewPrelude + +data EditView = EditView + { consumer :: !ApiConsumer + , manifests :: ![HubCapabilityManifest] + } + +instance View EditView where + html EditView { .. } = [hsx| +External systems authenticated against /api/v2/
+| Name | +Manifest | +Rate Limit | +Quota/day | +Status | ++ |
|---|
No keys yet.
|] + else keysTable} +No webhooks yet.
|] + else webhooksTable} +{d}
|] + Nothing -> mempty + manifestPanel = case mManifest of + Nothing -> mempty + Just m -> [hsx| +| Prefix | +Type | +Scopes | +Expires | +Status | ++ |
|---|
| Event Type | +Target URL | +Status | ++ |
|---|
Per-consumer request metrics (last 24 hours)
+No API activity yet.
|] + else statsTable} + |] + where + statsTable = [hsx| +| Consumer | +Req (24h) | +Error Rate | +Last Seen | +Manifest | +
|---|
Copy this key now — it will never be shown again.
+{fullKey}
+
+
+ Use this key as a Bearer token in the Authorization header:
+
Authorization: Bearer {fullKey}
+
+ Back to Consumer
+
+ For consumer: {consumer.name}
+ +Consumer: {consumer.name}
+ +