generated from coulomb/repo-seed
feat(WP-0010): IHF Phase 9 — External API Surface and Consumer SDKs
Some checks failed
Test / test (push) Has been cancelled
Some checks failed
Test / test (push) Has been cancelled
Delivers the full Phase 9 external API layer: - Versioned REST API (/api/v2/) with OpenAPI 3.1 spec; enum arrays for widget_type, event_type, annotation category drawn live from registry tables - OAuth 2.0 client credentials flow (/api/v2/token); hub:*:write scopes gated on active HubCapabilityManifest FK - API key management: SHA256-hashed tokens, key_prefix for display, one-time reveal on creation, revocation support - TypeScript and Python consumer SDKs generated from registry tables (/api/v2/sdk/ihf-client.ts, /api/v2/sdk/ihf-client.py) - Webhook delivery: HMAC-SHA256 signing, append-only webhook_deliveries, fire-and-forget dispatch via forkIO, 3-retry logic - Admin API dashboard with 24h stats (request count, error rate, last seen) - Rate limiting (per-minute) and daily quota enforcement via api_request_log - Schema migration: api_consumers, api_keys, webhook_subscriptions (CHECK constraint on 6 framework lifecycle topics), webhook_deliveries (append-only trigger), api_request_log - ARCHITECTURE-LAYERS.md scorecard: 3.34 → 3.41 (approaching Strong) - contracts/functional/interaction-reporting-v1.md extended with Phase 9 endpoint catalogue and 422 validation error format GAAF: no bare TEXT discriminators; webhook event_type uses CHECK constraint over 6 allowed framework lifecycle topic strings (not widget event types). Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
128
Web/Controller/Api/V2/Token.hs
Normal file
128
Web/Controller/Api/V2/Token.hs
Normal file
@@ -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")
|
||||
Reference in New Issue
Block a user