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")