-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.API.Routes.Public.Brig.OAuth where

import Data.Id as Id
import Data.SOP
import Imports hiding (exp, head)
import Servant (JSON)
import Servant hiding (Handler, JSON, Tagged, addHeader, respond)
import Servant.OpenApi.Internal.Orphans ()
import Wire.API.Error
import Wire.API.Error.Brig
import Wire.API.OAuth
import Wire.API.Password
import Wire.API.Routes.API
import Wire.API.Routes.MultiVerb
import Wire.API.Routes.Named (Named)
import Wire.API.Routes.Public
import Wire.API.Routes.Version

type OAuthAPI =
  Named
    "get-oauth-client"
    ( Summary "Get OAuth client information"
        :> CanThrow 'OAuthFeatureDisabled
        :> CanThrow 'OAuthClientNotFound
        :> ZLocalUser
        :> "oauth"
        :> "clients"
        :> Capture' '[Description "The ID of the OAuth client"] "OAuthClientId" OAuthClientId
        :> MultiVerb
             'GET
             '[JSON]
             '[ ErrorResponse 'OAuthClientNotFound,
                Respond 200 "OAuth client found" OAuthClient
              ]
             (Maybe OAuthClient)
    )
    :<|> Named
           "create-oauth-auth-code"
           ( Summary "Create an OAuth authorization code"
               :> Description "Currently only supports the 'code' response type, which corresponds to the authorization code flow."
               :> ZLocalUser
               :> "oauth"
               :> "authorization"
               :> "codes"
               :> ReqBody '[JSON] CreateOAuthAuthorizationCodeRequest
               :> MultiVerb
                    'POST
                    '[JSON]
                    CreateOAuthAuthorizationCodeResponses
                    CreateOAuthCodeResponse
           )
    :<|> Named
           "create-oauth-access-token"
           ( Summary "Create an OAuth access token"
               :> Description "Obtain a new access token from an authorization code or a refresh token."
               :> CanThrow 'OAuthJwtError
               :> CanThrow 'OAuthAuthorizationCodeNotFound
               :> CanThrow 'OAuthClientNotFound
               :> CanThrow 'OAuthFeatureDisabled
               :> CanThrow 'OAuthInvalidRefreshToken
               :> CanThrow 'OAuthInvalidGrantType
               :> CanThrow 'OAuthInvalidClientCredentials
               :> CanThrow 'OAuthInvalidGrant
               :> "oauth"
               :> "token"
               :> ReqBody '[FormUrlEncoded] (Either OAuthAccessTokenRequest OAuthRefreshAccessTokenRequest)
               :> Post '[JSON] OAuthAccessTokenResponse
           )
    :<|> Named
           "revoke-oauth-refresh-token"
           ( Summary "Revoke an OAuth refresh token"
               :> Description "Revoke an access token."
               :> CanThrow 'OAuthJwtError
               :> CanThrow 'OAuthInvalidRefreshToken
               :> CanThrow 'OAuthClientNotFound
               :> "oauth"
               :> "revoke"
               :> ReqBody '[JSON] OAuthRevokeRefreshTokenRequest
               :> Post '[JSON] ()
           )
    :<|> Named
           "get-oauth-applications"
           ( Summary "Get OAuth applications with account access"
               :> Description "Get all OAuth applications with active account access for a user."
               :> ZLocalUser
               :> "oauth"
               :> "applications"
               :> MultiVerb1
                    'GET
                    '[JSON]
                    (Respond 200 "OAuth applications found" [OAuthApplication])
           )
    :<|> Named
           "revoke-oauth-account-access-v6"
           ( Summary "Revoke account access from an OAuth application"
               :> ZLocalUser
               :> Until 'V7
               :> "oauth"
               :> "applications"
               :> Capture' '[Description "The ID of the OAuth client"] "OAuthClientId" OAuthClientId
               :> MultiVerb
                    'DELETE
                    '[JSON]
                    '[RespondEmpty 204 "OAuth application access revoked"]
                    ()
           )
    :<|> Named
           "revoke-oauth-account-access"
           ( Summary "Revoke account access from an OAuth application"
               :> CanThrow 'AccessDenied
               :> ZLocalUser
               :> From 'V7
               :> "oauth"
               :> "applications"
               :> Capture' '[Description "The ID of the OAuth client"] "OAuthClientId" OAuthClientId
               :> "sessions"
               :> ReqBody '[JSON] PasswordReqBody
               :> MultiVerb
                    'DELETE
                    '[JSON]
                    '[RespondEmpty 204 "OAuth application access revoked"]
                    ()
           )
    :<|> Named
           "delete-oauth-refresh-token"
           ( Summary "Revoke an active OAuth session"
               :> Description "Revoke an active OAuth session by providing the refresh token ID."
               :> ZLocalUser
               :> CanThrow 'AccessDenied
               :> CanThrow 'OAuthClientNotFound
               :> "oauth"
               :> "applications"
               :> Capture' '[Description "The ID of the OAuth client"] "OAuthClientId" OAuthClientId
               :> "sessions"
               :> Capture' '[Description "The ID of the refresh token"] "RefreshTokenId" OAuthRefreshTokenId
               :> ReqBody '[JSON] PasswordReqBody
               :> Delete '[JSON] ()
           )

type CreateOAuthAuthorizationCodeHeaders = '[Header "Location" RedirectUrl]

type CreateOAuthAuthorizationCodeResponses =
  '[ -- success
     WithHeaders CreateOAuthAuthorizationCodeHeaders RedirectUrl (RespondEmpty 201 "Created"),
     -- feature disabled
     WithHeaders CreateOAuthAuthorizationCodeHeaders RedirectUrl (RespondEmpty 403 "Forbidden"),
     -- unsupported response type
     WithHeaders CreateOAuthAuthorizationCodeHeaders RedirectUrl (RespondEmpty 400 "Bad Request"),
     -- client not found
     WithHeaders CreateOAuthAuthorizationCodeHeaders RedirectUrl (RespondEmpty 404 "Not Found"),
     -- redirect url mismatch
     ErrorResponse 'OAuthRedirectUrlMissMatch
   ]

data CreateOAuthCodeResponse
  = CreateOAuthCodeSuccess RedirectUrl
  | CreateOAuthCodeFeatureDisabled RedirectUrl
  | CreateOAuthCodeUnsupportedResponseType RedirectUrl
  | CreateOAuthCodeClientNotFound RedirectUrl
  | CreateOAuthCodeRedirectUrlMissMatch

instance AsUnion CreateOAuthAuthorizationCodeResponses CreateOAuthCodeResponse where
  toUnion :: CreateOAuthCodeResponse -> Union (ResponseTypes CreateOAuthAuthorizationCodeResponses)
  toUnion :: CreateOAuthCodeResponse
-> Union (ResponseTypes CreateOAuthAuthorizationCodeResponses)
toUnion (CreateOAuthCodeSuccess RedirectUrl
url) = I RedirectUrl
-> NS
     I '[RedirectUrl, RedirectUrl, RedirectUrl, RedirectUrl, DynError]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (RedirectUrl -> I RedirectUrl
forall a. a -> I a
I RedirectUrl
url)
  toUnion (CreateOAuthCodeFeatureDisabled RedirectUrl
url) = NS I '[RedirectUrl, RedirectUrl, RedirectUrl, DynError]
-> NS
     I '[RedirectUrl, RedirectUrl, RedirectUrl, RedirectUrl, DynError]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I RedirectUrl
-> NS I '[RedirectUrl, RedirectUrl, RedirectUrl, DynError]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (RedirectUrl -> I RedirectUrl
forall a. a -> I a
I RedirectUrl
url))
  toUnion (CreateOAuthCodeUnsupportedResponseType RedirectUrl
url) = NS I '[RedirectUrl, RedirectUrl, RedirectUrl, DynError]
-> NS
     I '[RedirectUrl, RedirectUrl, RedirectUrl, RedirectUrl, DynError]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS I '[RedirectUrl, RedirectUrl, DynError]
-> NS I '[RedirectUrl, RedirectUrl, RedirectUrl, DynError]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I RedirectUrl -> NS I '[RedirectUrl, RedirectUrl, DynError]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (RedirectUrl -> I RedirectUrl
forall a. a -> I a
I RedirectUrl
url)))
  toUnion (CreateOAuthCodeClientNotFound RedirectUrl
url) = NS I '[RedirectUrl, RedirectUrl, RedirectUrl, DynError]
-> NS
     I '[RedirectUrl, RedirectUrl, RedirectUrl, RedirectUrl, DynError]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS I '[RedirectUrl, RedirectUrl, DynError]
-> NS I '[RedirectUrl, RedirectUrl, RedirectUrl, DynError]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS I '[RedirectUrl, DynError]
-> NS I '[RedirectUrl, RedirectUrl, DynError]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I RedirectUrl -> NS I '[RedirectUrl, DynError]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (RedirectUrl -> I RedirectUrl
forall a. a -> I a
I RedirectUrl
url))))
  toUnion CreateOAuthCodeResponse
CreateOAuthCodeRedirectUrlMissMatch = NS I '[RedirectUrl, RedirectUrl, RedirectUrl, DynError]
-> NS
     I '[RedirectUrl, RedirectUrl, RedirectUrl, RedirectUrl, DynError]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS I '[RedirectUrl, RedirectUrl, DynError]
-> NS I '[RedirectUrl, RedirectUrl, RedirectUrl, DynError]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS I '[RedirectUrl, DynError]
-> NS I '[RedirectUrl, RedirectUrl, DynError]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS I '[DynError] -> NS I '[RedirectUrl, DynError]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I DynError -> NS I '[DynError]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (DynError -> I DynError
forall a. a -> I a
I (forall (e :: StaticError). KnownError e => DynError
dynError @(MapError 'OAuthRedirectUrlMissMatch)))))))
  fromUnion :: Union (ResponseTypes CreateOAuthAuthorizationCodeResponses) -> CreateOAuthCodeResponse
  fromUnion :: Union (ResponseTypes CreateOAuthAuthorizationCodeResponses)
-> CreateOAuthCodeResponse
fromUnion (Z (I x
url)) = RedirectUrl -> CreateOAuthCodeResponse
CreateOAuthCodeSuccess x
RedirectUrl
url
  fromUnion (S (Z (I x
url))) = RedirectUrl -> CreateOAuthCodeResponse
CreateOAuthCodeFeatureDisabled x
RedirectUrl
url
  fromUnion (S (S (Z (I x
url)))) = RedirectUrl -> CreateOAuthCodeResponse
CreateOAuthCodeUnsupportedResponseType x
RedirectUrl
url
  fromUnion (S (S (S (Z (I x
url))))) = RedirectUrl -> CreateOAuthCodeResponse
CreateOAuthCodeClientNotFound x
RedirectUrl
url
  fromUnion (S (S (S (S (Z (I x
_)))))) = CreateOAuthCodeResponse
CreateOAuthCodeRedirectUrlMissMatch
  fromUnion (S (S (S (S (S NS I xs
x))))) = case NS I xs
x of {}

data OAuthAPITag

instance ServiceAPI OAuthAPITag v where
  type ServiceAPIRoutes OAuthAPITag = OAuthAPI