Files
inter-hub/Web/Controller/Api/V2/ApiConsumers.hs
tegwick a2d0dddddd
Some checks failed
Build and Deploy / build-push-deploy (push) Failing after 8m21s
fix(api): unblock production build
2026-06-14 14:42:11 +02:00

176 lines
7.0 KiB
Haskell

module Web.Controller.Api.V2.ApiConsumers where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (Value, object, (.=))
import Network.Wai (requestMethod)
import Web.Controller.Api.V2.Auth
( requireApiConsumer, paginatedResponse, getPageParams
, respondWithStatus, hashApiKey )
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Random as Random
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.UUID as UUID
instance Controller ApiV2ApiConsumersController where
action ApiV2IndexApiConsumersAction = do
case requestMethod ?request of
"GET" -> listApiConsumers
"POST" -> createApiConsumerRecord
_ -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
action ApiV2ShowApiConsumerAction { apiConsumerId } = do
_consumer <- requireApiConsumer
apiConsumer <- fetch apiConsumerId
renderJson (apiConsumerToJson apiConsumer)
action ApiV2CreateApiConsumerAction = createApiConsumerRecord
action ApiV2CreateApiConsumerKeyAction { apiConsumerId } = do
when (requestMethod ?request /= "POST") do
respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
createApiConsumerKey apiConsumerId
listApiConsumers :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
listApiConsumers = do
_consumer <- requireApiConsumer
(page, perPage) <- getPageParams
let pageOffset = (page - 1) * perPage
total <- query @ApiConsumer |> fetchCount
consumers <- query @ApiConsumer
|> orderByDesc #createdAt
|> limit perPage
|> offset pageOffset
|> fetch
renderJson $ paginatedResponse (map apiConsumerToJson consumers) page perPage total
createApiConsumerRecord :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
createApiConsumerRecord = do
_consumer <- requireApiConsumer
let name = paramOrNothing @Text "name"
description = paramOrNothing @Text "description"
rateLimit = fromMaybe 60 (paramOrNothing @Int "rateLimitPerMinute")
quota = fromMaybe 10000 (paramOrNothing @Int "quotaPerDay")
when (maybe True (== "") name) do
respondWithStatus 422 $ object
[ "error" .= ("Missing required fields" :: Text)
, "missing" .= (["name"] :: [Text])
]
unless (positiveLimit rateLimit) do
respondWithStatus 422 $ object
[ "error" .= ("rateLimitPerMinute must be positive" :: Text)
, "code" .= ("invalid_rate_limit" :: Text)
]
unless (positiveLimit quota) do
respondWithStatus 422 $ object
[ "error" .= ("quotaPerDay must be positive" :: Text)
, "code" .= ("invalid_quota" :: Text)
]
mManifestId <- parseOptionalActiveManifestId
let Just nameText = name
apiConsumer <- newRecord @ApiConsumer
|> set #name nameText
|> set #description description
|> set #hubCapabilityManifestId mManifestId
|> set #rateLimitPerMinute rateLimit
|> set #quotaPerDay quota
|> createRecord
respondWithStatus 201 (apiConsumerToJson apiConsumer)
createApiConsumerKey :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => Id ApiConsumer -> IO ()
createApiConsumerKey apiConsumerId = do
_requestingConsumer <- requireApiConsumer
apiConsumer <- fetch apiConsumerId
unless apiConsumer.isActive do
respondWithStatus 422 $ object
[ "error" .= ("API consumer is inactive" :: Text)
, "code" .= ("api_consumer_inactive" :: Text)
]
let scopes = fromMaybe "" (paramOrNothing @Text "scopes")
fullKey <- generateApiKeySecret
let prefix = T.take 8 fullKey
keyHash = hashApiKey fullKey
apiKey <- newRecord @ApiKey
|> set #apiConsumerId apiConsumer.id
|> set #keyPrefix prefix
|> set #keyHash keyHash
|> set #scopes scopes
|> set #tokenType "static"
|> createRecord
respondWithStatus 201 (apiKeyCreatedToJson apiKey fullKey)
parseOptionalActiveManifestId :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO (Maybe (Id HubCapabilityManifest))
parseOptionalActiveManifestId =
case nonEmptyText =<< paramOrNothing @Text "hubCapabilityManifestId" of
Nothing -> pure Nothing
Just manifestIdRaw ->
case UUID.fromText manifestIdRaw of
Nothing -> respondWithStatus 422 $ object
["error" .= ("hubCapabilityManifestId must be a valid UUID" :: Text)]
Just rawId -> do
let manifestId = Id rawId :: Id HubCapabilityManifest
mManifest <- fetchOneOrNothing manifestId
case mManifest of
Nothing -> respondWithStatus 422 $ object
["error" .= ("Hub capability manifest not found" :: Text)]
Just manifest -> do
unless (manifest.status == "active") do
respondWithStatus 422 $ object
[ "error" .= ("Hub capability manifest must be active" :: Text)
, "code" .= ("manifest_not_active" :: Text)
]
pure (Just manifestId)
generateApiKeySecret :: IO Text
generateApiKeySecret = do
rawBytes <- Random.random 32
pure $ TE.decodeUtf8 (Base16.encode rawBytes)
apiConsumerToJson :: ApiConsumer -> Value
apiConsumerToJson apiConsumer = object
[ "id" .= apiConsumer.id
, "name" .= apiConsumer.name
, "description" .= apiConsumer.description
, "hubCapabilityManifestId" .= apiConsumer.hubCapabilityManifestId
, "rateLimitPerMinute" .= apiConsumer.rateLimitPerMinute
, "quotaPerDay" .= apiConsumer.quotaPerDay
, "quotaResetsAt" .= apiConsumer.quotaResetsAt
, "isActive" .= apiConsumer.isActive
, "createdAt" .= apiConsumer.createdAt
, "updatedAt" .= apiConsumer.updatedAt
]
apiKeyToJson :: ApiKey -> Value
apiKeyToJson apiKey = object
[ "id" .= apiKey.id
, "apiConsumerId" .= apiKey.apiConsumerId
, "keyPrefix" .= apiKey.keyPrefix
, "scopes" .= apiKey.scopes
, "tokenType" .= apiKey.tokenType
, "expiresAt" .= apiKey.expiresAt
, "revokedAt" .= apiKey.revokedAt
, "lastUsedAt" .= apiKey.lastUsedAt
, "createdAt" .= apiKey.createdAt
]
apiKeyCreatedToJson :: ApiKey -> Text -> Value
apiKeyCreatedToJson apiKey fullKey = object
[ "apiKey" .= apiKeyToJson apiKey
, "fullKey" .= fullKey
, "displayOnce" .= True
]
positiveLimit :: Int -> Bool
positiveLimit value = value > 0
nonEmptyText :: Text -> Maybe Text
nonEmptyText "" = Nothing
nonEmptyText value = Just value