{-# LANGUAGE AllowAmbiguousTypes #-}

-- 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 Web.Scim.Server
  ( -- * WAI application
    app,
    mkapp,
    App,

    -- * API tree
    SiteAPI,
    Site (..),
    siteServer,

    -- ** API subtrees, useful for tests
    ConfigAPI,
    configServer,
    UserAPI,
    userServer,
    GroupAPI,
    groupServer,
  )
where

import Network.Wai
import Servant
import Servant.API.Generic
import Servant.Server.Generic
import Web.Scim.Capabilities.MetaSchema (ConfigSite, Configuration, configServer)
import Web.Scim.Class.Auth (AuthDB (..), AuthTypes (..))
import Web.Scim.Class.Group (GroupDB, GroupSite (..), GroupTypes (..), groupServer)
import Web.Scim.Class.User (UserDB (..), UserSite (..), userServer)
import Web.Scim.Handler

----------------------------------------------------------------------------
-- API specification

-- | A constraint indicating that monad @m@ supports operations with users and groups marked
-- with tag @t@.
type DB tag m = (UserDB tag m, GroupDB tag m, AuthDB tag m)

type ConfigAPI = ToServantApi ConfigSite

type UserAPI tag = ToServantApi (UserSite tag)

type GroupAPI tag = ToServantApi (GroupSite tag)

type SiteAPI tag = ToServantApi (Site tag)

data Site tag route = Site
  { forall tag route. Site tag route -> route :- ConfigAPI
config ::
      route
        :- ConfigAPI,
    forall tag route.
Site tag route
-> route
   :- (Header "Authorization" (AuthData tag)
       :> ("Users" :> UserAPI tag))
users ::
      route
        :- Header "Authorization" (AuthData tag)
          :> "Users"
          :> UserAPI tag,
    forall tag route.
Site tag route
-> route
   :- (Header "Authorization" (AuthData tag)
       :> ("Groups" :> GroupAPI tag))
groups ::
      route
        :- Header "Authorization" (AuthData tag)
          :> "Groups"
          :> GroupAPI tag
  }
  deriving ((forall x. Site tag route -> Rep (Site tag route) x)
-> (forall x. Rep (Site tag route) x -> Site tag route)
-> Generic (Site tag route)
forall x. Rep (Site tag route) x -> Site tag route
forall x. Site tag route -> Rep (Site tag route) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tag route x. Rep (Site tag route) x -> Site tag route
forall tag route x. Site tag route -> Rep (Site tag route) x
$cfrom :: forall tag route x. Site tag route -> Rep (Site tag route) x
from :: forall x. Site tag route -> Rep (Site tag route) x
$cto :: forall tag route x. Rep (Site tag route) x -> Site tag route
to :: forall x. Rep (Site tag route) x -> Site tag route
Generic)

----------------------------------------------------------------------------
-- API implementation

siteServer ::
  forall tag m.
  (DB tag m) =>
  Configuration ->
  Site tag (AsServerT (ScimHandler m))
siteServer :: forall tag (m :: * -> *).
DB tag m =>
Configuration -> Site tag (AsServerT (ScimHandler m))
siteServer Configuration
conf =
  Site
    { config :: AsServerT (ScimHandler m) :- ConfigAPI
config = ConfigSite (AsServerT (ScimHandler m))
-> ToServant ConfigSite (AsServerT (ScimHandler m))
forall {k} (routes :: k -> *) (mode :: k).
GenericServant routes mode =>
routes mode -> ToServant routes mode
toServant (ConfigSite (AsServerT (ScimHandler m))
 -> ToServant ConfigSite (AsServerT (ScimHandler m)))
-> ConfigSite (AsServerT (ScimHandler m))
-> ToServant ConfigSite (AsServerT (ScimHandler m))
forall a b. (a -> b) -> a -> b
$ Configuration -> ConfigSite (AsServerT (ScimHandler m))
forall (m :: * -> *).
Monad m =>
Configuration -> ConfigSite (AsServerT (ScimHandler m))
configServer Configuration
conf,
      users :: AsServerT (ScimHandler m)
:- (Header "Authorization" (AuthData tag)
    :> ("Users" :> UserAPI tag))
users = \Maybe (AuthData tag)
authData -> UserSite tag (AsServerT (ScimHandler m))
-> ToServant (UserSite tag) (AsServerT (ScimHandler m))
forall {k} (routes :: k -> *) (mode :: k).
GenericServant routes mode =>
routes mode -> ToServant routes mode
toServant (forall tag (m :: * -> *).
(AuthDB tag m, UserDB tag m) =>
Maybe (AuthData tag) -> UserSite tag (AsServerT (ScimHandler m))
userServer @tag Maybe (AuthData tag)
authData),
      groups :: AsServerT (ScimHandler m)
:- (Header "Authorization" (AuthData tag)
    :> ("Groups" :> GroupAPI tag))
groups = \Maybe (AuthData tag)
authData -> GroupSite tag (AsServerT (ScimHandler m))
-> ToServant (GroupSite tag) (AsServerT (ScimHandler m))
forall {k} (routes :: k -> *) (mode :: k).
GenericServant routes mode =>
routes mode -> ToServant routes mode
toServant (forall tag (m :: * -> *).
GroupDB tag m =>
Maybe (AuthData tag) -> GroupSite tag (AsServerT (ScimHandler m))
groupServer @tag Maybe (AuthData tag)
authData)
    }

----------------------------------------------------------------------------
-- Server-starting utilities

type App tag m api =
  ( DB tag m,
    Show (GroupId tag),
    HasServer api '[]
  )

mkapp ::
  forall tag m api.
  (App tag m api) =>
  Proxy api ->
  ServerT api (ScimHandler m) ->
  (forall a. ScimHandler m a -> Handler a) ->
  Application
mkapp :: forall tag (m :: * -> *) api.
App tag m api =>
Proxy api
-> ServerT api (ScimHandler m)
-> (forall a. ScimHandler m a -> Handler a)
-> Application
mkapp Proxy api
proxy ServerT api (ScimHandler m)
api forall a. ScimHandler m a -> Handler a
nt =
  Proxy api -> Server api -> Application
forall {k} (api :: k).
HasServer api '[] =>
Proxy api -> Server api -> Application
serve Proxy api
proxy (Server api -> Application) -> Server api -> Application
forall a b. (a -> b) -> a -> b
$
    Proxy api
-> (forall a. ScimHandler m a -> Handler a)
-> ServerT api (ScimHandler m)
-> Server api
forall {k} (api :: k) (m :: * -> *) (n :: * -> *).
HasServer api '[] =>
Proxy api
-> (forall x. m x -> n x) -> ServerT api m -> ServerT api n
hoistServer Proxy api
proxy ScimHandler m x -> Handler x
forall a. ScimHandler m a -> Handler a
nt ServerT api (ScimHandler m)
api

app ::
  forall tag m.
  (App tag m (SiteAPI tag)) =>
  Configuration ->
  (forall a. ScimHandler m a -> Handler a) ->
  Application
app :: forall tag (m :: * -> *).
App tag m (SiteAPI tag) =>
Configuration
-> (forall a. ScimHandler m a -> Handler a) -> Application
app Configuration
c =
  forall tag (m :: * -> *) api.
App tag m api =>
Proxy api
-> ServerT api (ScimHandler m)
-> (forall a. ScimHandler m a -> Handler a)
-> Application
mkapp @tag
    (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SiteAPI tag))
    (Site tag (AsServerT (ScimHandler m))
-> ToServant (Site tag) (AsServerT (ScimHandler m))
forall {k} (routes :: k -> *) (mode :: k).
GenericServant routes mode =>
routes mode -> ToServant routes mode
toServant (Site tag (AsServerT (ScimHandler m))
 -> ToServant (Site tag) (AsServerT (ScimHandler m)))
-> Site tag (AsServerT (ScimHandler m))
-> ToServant (Site tag) (AsServerT (ScimHandler m))
forall a b. (a -> b) -> a -> b
$ Configuration -> Site tag (AsServerT (ScimHandler m))
forall tag (m :: * -> *).
DB tag m =>
Configuration -> Site tag (AsServerT (ScimHandler m))
siteServer Configuration
c)