{-# LANGUAGE AllowAmbiguousTypes #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2020 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.Client
  ( HasScimClient,

    -- * config
    spConfig,
    getSchemas,
    schema,
    resourceTypes,

    -- * user
    scimClients,
    getUsers,
    getUser,
    postUser,
    putUser,
    patchUser,
    deleteUser,

    -- * group
    getGroups,
    getGroup,
    postGroup,
    putGroup,
    patchGroup,
    deleteGroup,
  )
where

import Control.Exception
import Data.Aeson (FromJSON, ToJSON, Value)
import Data.Text
import Servant.API
import Servant.Client
import Servant.Client.Generic
import qualified Web.Scim.Capabilities.MetaSchema as MetaSchema
import Web.Scim.Class.Auth
import Web.Scim.Class.Group (Group, GroupId, StoredGroup)
import Web.Scim.Class.User (StoredUser)
import Web.Scim.Filter (Filter)
import Web.Scim.Schema.ListResponse (ListResponse)
import Web.Scim.Schema.PatchOp (PatchOp)
import qualified Web.Scim.Schema.ResourceType as ResourceType
import Web.Scim.Schema.User (User)
import Web.Scim.Schema.UserTypes (UserExtra, UserId)
import Web.Scim.Server

type HasScimClient tag =
  ( AuthTypes tag,
    ToJSON (UserExtra tag),
    FromJSON (UserExtra tag),
    FromJSON (UserId tag),
    FromJSON (GroupId tag),
    ToHttpApiData (AuthData tag),
    ToHttpApiData (UserId tag),
    ToHttpApiData (GroupId tag)
  )

scimClients :: HasScimClient tag => ClientEnv -> Site tag (AsClientT IO)
scimClients :: ClientEnv -> Site tag (AsClientT IO)
scimClients ClientEnv
env = (forall x. ClientM x -> IO x) -> Site tag (AsClientT IO)
forall (routes :: * -> *) (m :: * -> *) (n :: * -> *).
(HasClient m (ToServantApi routes),
 GenericServant routes (AsClientT n),
 Client n (ToServantApi routes) ~ ToServant routes (AsClientT n)) =>
(forall x. m x -> n x) -> routes (AsClientT n)
genericClientHoist ((forall x. ClientM x -> IO x) -> Site tag (AsClientT IO))
-> (forall x. ClientM x -> IO x) -> Site tag (AsClientT IO)
forall a b. (a -> b) -> a -> b
$ \ClientM x
x -> ClientM x -> ClientEnv -> IO (Either ClientError x)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM x
x ClientEnv
env IO (Either ClientError x) -> (Either ClientError x -> IO x) -> IO x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ClientError -> IO x)
-> (x -> IO x) -> Either ClientError x -> IO x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ClientError -> IO x
forall e a. Exception e => e -> IO a
throwIO x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return

-- config

spConfig ::
  forall tag.
  HasScimClient tag =>
  ClientEnv ->
  IO MetaSchema.Configuration
spConfig :: ClientEnv -> IO Configuration
spConfig ClientEnv
env = case Site tag (AsClientT IO) -> AsClientT IO :- ConfigAPI
forall tag route. Site tag route -> route :- ConfigAPI
config @tag (ClientEnv -> Site tag (AsClientT IO)
forall tag.
HasScimClient tag =>
ClientEnv -> Site tag (AsClientT IO)
scimClients ClientEnv
env) of ((r :<|> _) :<|> (_ :<|> _)) -> IO Configuration
r

getSchemas ::
  forall tag.
  HasScimClient tag =>
  ClientEnv ->
  IO (ListResponse Value)
getSchemas :: ClientEnv -> IO (ListResponse Value)
getSchemas ClientEnv
env = case Site tag (AsClientT IO) -> AsClientT IO :- ConfigAPI
forall tag route. Site tag route -> route :- ConfigAPI
config @tag (ClientEnv -> Site tag (AsClientT IO)
forall tag.
HasScimClient tag =>
ClientEnv -> Site tag (AsClientT IO)
scimClients ClientEnv
env) of ((_ :<|> r) :<|> (_ :<|> _)) -> IO (ListResponse Value)
r

schema ::
  forall tag.
  HasScimClient tag =>
  ClientEnv ->
  Text ->
  IO Value
schema :: ClientEnv -> Text -> IO Value
schema ClientEnv
env = case Site tag (AsClientT IO) -> AsClientT IO :- ConfigAPI
forall tag route. Site tag route -> route :- ConfigAPI
config @tag (ClientEnv -> Site tag (AsClientT IO)
forall tag.
HasScimClient tag =>
ClientEnv -> Site tag (AsClientT IO)
scimClients ClientEnv
env) of ((_ :<|> _) :<|> (r :<|> _)) -> Text -> IO Value
r

resourceTypes ::
  forall tag.
  HasScimClient tag =>
  ClientEnv ->
  IO (ListResponse ResourceType.Resource)
resourceTypes :: ClientEnv -> IO (ListResponse Resource)
resourceTypes ClientEnv
env = case Site tag (AsClientT IO) -> AsClientT IO :- ConfigAPI
forall tag route. Site tag route -> route :- ConfigAPI
config @tag (ClientEnv -> Site tag (AsClientT IO)
forall tag.
HasScimClient tag =>
ClientEnv -> Site tag (AsClientT IO)
scimClients ClientEnv
env) of ((_ :<|> _) :<|> (_ :<|> r)) -> IO (ListResponse Resource)
r

-- users

getUsers ::
  HasScimClient tag =>
  ClientEnv ->
  Maybe (AuthData tag) ->
  Maybe Filter ->
  IO (ListResponse (StoredUser tag))
getUsers :: ClientEnv
-> Maybe (AuthData tag)
-> Maybe Filter
-> IO (ListResponse (StoredUser tag))
getUsers ClientEnv
env Maybe (AuthData tag)
tok = case Site tag (AsClientT IO)
-> Maybe (AuthData tag)
-> ((Maybe Filter -> IO (ListResponse (StoredUser tag)))
    :<|> ((UserId tag -> IO (StoredUser tag))
          :<|> (User tag -> IO (StoredUser tag))))
   :<|> ((UserId tag -> User tag -> IO (StoredUser tag))
         :<|> ((UserId tag -> PatchOp tag -> IO (StoredUser tag))
               :<|> (UserId tag -> IO NoContent)))
forall tag route.
Site tag route
-> route
   :- (Header "Authorization" (AuthData tag)
       :> ("Users" :> UserAPI tag))
users (ClientEnv -> Site tag (AsClientT IO)
forall tag.
HasScimClient tag =>
ClientEnv -> Site tag (AsClientT IO)
scimClients ClientEnv
env) Maybe (AuthData tag)
tok of ((Maybe Filter -> IO (ListResponse (StoredUser tag))
r :<|> (UserId tag -> IO (StoredUser tag)
_ :<|> User tag -> IO (StoredUser tag)
_)) :<|> (UserId tag -> User tag -> IO (StoredUser tag)
_ :<|> (UserId tag -> PatchOp tag -> IO (StoredUser tag)
_ :<|> UserId tag -> IO NoContent
_))) -> Maybe Filter -> IO (ListResponse (StoredUser tag))
r

getUser ::
  HasScimClient tag =>
  ClientEnv ->
  Maybe (AuthData tag) ->
  UserId tag ->
  IO (StoredUser tag)
getUser :: ClientEnv
-> Maybe (AuthData tag) -> UserId tag -> IO (StoredUser tag)
getUser ClientEnv
env Maybe (AuthData tag)
tok = case Site tag (AsClientT IO)
-> Maybe (AuthData tag)
-> ((Maybe Filter -> IO (ListResponse (StoredUser tag)))
    :<|> ((UserId tag -> IO (StoredUser tag))
          :<|> (User tag -> IO (StoredUser tag))))
   :<|> ((UserId tag -> User tag -> IO (StoredUser tag))
         :<|> ((UserId tag -> PatchOp tag -> IO (StoredUser tag))
               :<|> (UserId tag -> IO NoContent)))
forall tag route.
Site tag route
-> route
   :- (Header "Authorization" (AuthData tag)
       :> ("Users" :> UserAPI tag))
users (ClientEnv -> Site tag (AsClientT IO)
forall tag.
HasScimClient tag =>
ClientEnv -> Site tag (AsClientT IO)
scimClients ClientEnv
env) Maybe (AuthData tag)
tok of ((Maybe Filter -> IO (ListResponse (StoredUser tag))
_ :<|> (UserId tag -> IO (StoredUser tag)
r :<|> User tag -> IO (StoredUser tag)
_)) :<|> (UserId tag -> User tag -> IO (StoredUser tag)
_ :<|> (UserId tag -> PatchOp tag -> IO (StoredUser tag)
_ :<|> UserId tag -> IO NoContent
_))) -> UserId tag -> IO (StoredUser tag)
r

postUser ::
  HasScimClient tag =>
  ClientEnv ->
  Maybe (AuthData tag) ->
  (User tag) ->
  IO (StoredUser tag)
postUser :: ClientEnv
-> Maybe (AuthData tag) -> User tag -> IO (StoredUser tag)
postUser ClientEnv
env Maybe (AuthData tag)
tok = case Site tag (AsClientT IO)
-> Maybe (AuthData tag)
-> ((Maybe Filter -> IO (ListResponse (StoredUser tag)))
    :<|> ((UserId tag -> IO (StoredUser tag))
          :<|> (User tag -> IO (StoredUser tag))))
   :<|> ((UserId tag -> User tag -> IO (StoredUser tag))
         :<|> ((UserId tag -> PatchOp tag -> IO (StoredUser tag))
               :<|> (UserId tag -> IO NoContent)))
forall tag route.
Site tag route
-> route
   :- (Header "Authorization" (AuthData tag)
       :> ("Users" :> UserAPI tag))
users (ClientEnv -> Site tag (AsClientT IO)
forall tag.
HasScimClient tag =>
ClientEnv -> Site tag (AsClientT IO)
scimClients ClientEnv
env) Maybe (AuthData tag)
tok of ((Maybe Filter -> IO (ListResponse (StoredUser tag))
_ :<|> (UserId tag -> IO (StoredUser tag)
_ :<|> User tag -> IO (StoredUser tag)
r)) :<|> (UserId tag -> User tag -> IO (StoredUser tag)
_ :<|> (UserId tag -> PatchOp tag -> IO (StoredUser tag)
_ :<|> UserId tag -> IO NoContent
_))) -> User tag -> IO (StoredUser tag)
r

putUser ::
  HasScimClient tag =>
  ClientEnv ->
  Maybe (AuthData tag) ->
  UserId tag ->
  (User tag) ->
  IO (StoredUser tag)
putUser :: ClientEnv
-> Maybe (AuthData tag)
-> UserId tag
-> User tag
-> IO (StoredUser tag)
putUser ClientEnv
env Maybe (AuthData tag)
tok = case Site tag (AsClientT IO)
-> Maybe (AuthData tag)
-> ((Maybe Filter -> IO (ListResponse (StoredUser tag)))
    :<|> ((UserId tag -> IO (StoredUser tag))
          :<|> (User tag -> IO (StoredUser tag))))
   :<|> ((UserId tag -> User tag -> IO (StoredUser tag))
         :<|> ((UserId tag -> PatchOp tag -> IO (StoredUser tag))
               :<|> (UserId tag -> IO NoContent)))
forall tag route.
Site tag route
-> route
   :- (Header "Authorization" (AuthData tag)
       :> ("Users" :> UserAPI tag))
users (ClientEnv -> Site tag (AsClientT IO)
forall tag.
HasScimClient tag =>
ClientEnv -> Site tag (AsClientT IO)
scimClients ClientEnv
env) Maybe (AuthData tag)
tok of ((Maybe Filter -> IO (ListResponse (StoredUser tag))
_ :<|> (UserId tag -> IO (StoredUser tag)
_ :<|> User tag -> IO (StoredUser tag)
_)) :<|> (UserId tag -> User tag -> IO (StoredUser tag)
r :<|> (UserId tag -> PatchOp tag -> IO (StoredUser tag)
_ :<|> UserId tag -> IO NoContent
_))) -> UserId tag -> User tag -> IO (StoredUser tag)
r

patchUser ::
  HasScimClient tag =>
  ClientEnv ->
  Maybe (AuthData tag) ->
  UserId tag ->
  PatchOp tag ->
  IO (StoredUser tag)
patchUser :: ClientEnv
-> Maybe (AuthData tag)
-> UserId tag
-> PatchOp tag
-> IO (StoredUser tag)
patchUser ClientEnv
env Maybe (AuthData tag)
tok = case Site tag (AsClientT IO)
-> Maybe (AuthData tag)
-> ((Maybe Filter -> IO (ListResponse (StoredUser tag)))
    :<|> ((UserId tag -> IO (StoredUser tag))
          :<|> (User tag -> IO (StoredUser tag))))
   :<|> ((UserId tag -> User tag -> IO (StoredUser tag))
         :<|> ((UserId tag -> PatchOp tag -> IO (StoredUser tag))
               :<|> (UserId tag -> IO NoContent)))
forall tag route.
Site tag route
-> route
   :- (Header "Authorization" (AuthData tag)
       :> ("Users" :> UserAPI tag))
users (ClientEnv -> Site tag (AsClientT IO)
forall tag.
HasScimClient tag =>
ClientEnv -> Site tag (AsClientT IO)
scimClients ClientEnv
env) Maybe (AuthData tag)
tok of ((Maybe Filter -> IO (ListResponse (StoredUser tag))
_ :<|> (UserId tag -> IO (StoredUser tag)
_ :<|> User tag -> IO (StoredUser tag)
_)) :<|> (UserId tag -> User tag -> IO (StoredUser tag)
_ :<|> (UserId tag -> PatchOp tag -> IO (StoredUser tag)
r :<|> UserId tag -> IO NoContent
_))) -> UserId tag -> PatchOp tag -> IO (StoredUser tag)
r

deleteUser ::
  forall tag.
  HasScimClient tag =>
  ClientEnv ->
  Maybe (AuthData tag) ->
  UserId tag ->
  IO NoContent
deleteUser :: ClientEnv -> Maybe (AuthData tag) -> UserId tag -> IO NoContent
deleteUser ClientEnv
env Maybe (AuthData tag)
tok = case Site tag (AsClientT IO)
-> Maybe (AuthData tag)
-> ((Maybe Filter
     -> IO (ListResponse (WithMeta (WithId (UserId tag) (User tag)))))
    :<|> ((UserId tag
           -> IO (WithMeta (WithId (UserId tag) (User tag))))
          :<|> (User tag -> IO (WithMeta (WithId (UserId tag) (User tag))))))
   :<|> ((UserId tag
          -> User tag -> IO (WithMeta (WithId (UserId tag) (User tag))))
         :<|> ((UserId tag
                -> PatchOp tag -> IO (WithMeta (WithId (UserId tag) (User tag))))
               :<|> (UserId tag -> IO NoContent)))
forall tag route.
Site tag route
-> route
   :- (Header "Authorization" (AuthData tag)
       :> ("Users" :> UserAPI tag))
users @tag (ClientEnv -> Site tag (AsClientT IO)
forall tag.
HasScimClient tag =>
ClientEnv -> Site tag (AsClientT IO)
scimClients ClientEnv
env) Maybe (AuthData tag)
tok of ((Maybe Filter
-> IO (ListResponse (WithMeta (WithId (UserId tag) (User tag))))
_ :<|> (UserId tag -> IO (WithMeta (WithId (UserId tag) (User tag)))
_ :<|> User tag -> IO (WithMeta (WithId (UserId tag) (User tag)))
_)) :<|> (UserId tag
-> User tag -> IO (WithMeta (WithId (UserId tag) (User tag)))
_ :<|> (UserId tag
-> PatchOp tag -> IO (WithMeta (WithId (UserId tag) (User tag)))
_ :<|> UserId tag -> IO NoContent
r))) -> UserId tag -> IO NoContent
r

-- groups

getGroups ::
  forall tag.
  HasScimClient tag =>
  ClientEnv ->
  Maybe (AuthData tag) ->
  IO (ListResponse (StoredGroup tag))
getGroups :: ClientEnv
-> Maybe (AuthData tag) -> IO (ListResponse (StoredGroup tag))
getGroups = [Char]
-> ClientEnv
-> Maybe (AuthData tag)
-> IO (ListResponse (StoredGroup tag))
forall a. HasCallStack => [Char] -> a
error [Char]
"groups are not authenticated at the moment; implement that first!"

getGroup ::
  forall tag.
  HasScimClient tag =>
  ClientEnv ->
  Maybe (AuthData tag) ->
  GroupId tag ->
  IO (StoredGroup tag)
getGroup :: ClientEnv
-> Maybe (AuthData tag) -> GroupId tag -> IO (StoredGroup tag)
getGroup = [Char]
-> ClientEnv
-> Maybe (AuthData tag)
-> GroupId tag
-> IO (StoredGroup tag)
forall a. HasCallStack => [Char] -> a
error [Char]
"groups are not authenticated at the moment; implement that first!"

postGroup ::
  forall tag.
  HasScimClient tag =>
  ClientEnv ->
  Maybe (AuthData tag) ->
  Group ->
  IO (StoredGroup tag)
postGroup :: ClientEnv -> Maybe (AuthData tag) -> Group -> IO (StoredGroup tag)
postGroup = [Char]
-> ClientEnv
-> Maybe (AuthData tag)
-> Group
-> IO (StoredGroup tag)
forall a. HasCallStack => [Char] -> a
error [Char]
"groups are not authenticated at the moment; implement that first!"

putGroup ::
  forall tag.
  HasScimClient tag =>
  ClientEnv ->
  Maybe (AuthData tag) ->
  GroupId tag ->
  IO (StoredGroup tag)
putGroup :: ClientEnv
-> Maybe (AuthData tag) -> GroupId tag -> IO (StoredGroup tag)
putGroup = [Char]
-> ClientEnv
-> Maybe (AuthData tag)
-> GroupId tag
-> IO (StoredGroup tag)
forall a. HasCallStack => [Char] -> a
error [Char]
"groups are not authenticated at the moment; implement that first!"

patchGroup ::
  forall tag.
  HasScimClient tag =>
  ClientEnv ->
  Maybe (AuthData tag) ->
  GroupId tag ->
  IO (StoredGroup tag)
patchGroup :: ClientEnv
-> Maybe (AuthData tag) -> GroupId tag -> IO (StoredGroup tag)
patchGroup = [Char]
-> ClientEnv
-> Maybe (AuthData tag)
-> GroupId tag
-> IO (StoredGroup tag)
forall a. HasCallStack => [Char] -> a
error [Char]
"groups are not authenticated at the moment; implement that first!"

deleteGroup ::
  forall tag.
  HasScimClient tag =>
  ClientEnv ->
  Maybe (AuthData tag) ->
  GroupId tag ->
  IO DeleteNoContent
deleteGroup :: ClientEnv
-> Maybe (AuthData tag) -> GroupId tag -> IO DeleteNoContent
deleteGroup = [Char]
-> ClientEnv
-> Maybe (AuthData tag)
-> GroupId tag
-> IO DeleteNoContent
forall a. HasCallStack => [Char] -> a
error [Char]
"groups are not authenticated at the moment; implement that first!"