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