{-|
Module      : Gargantext.API.ThrowAll
Description : ThrowAll class and instance
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase             #-}
{-# LANGUAGE MonoLocalBinds         #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}

module Gargantext.API.ThrowAll where

import Control.Lens ((#))
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.EnvTypes (Env)
import Gargantext.API.Errors.Types
import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Private qualified as Named
import Gargantext.API.Server.Named.Private qualified as Named
import Gargantext.Database.Admin.Types.Node (UserId (..))
import Gargantext.Prelude
import Servant
import Servant.Auth.Server (AuthResult(..))
import Servant.Server.Generic (AsServerT)
import Servant.API.Generic ()


throwAll' :: forall err m routes. ( MonadError err m
         , HasServerError err
         , HasServer (NamedRoutes routes) '[]
         , Generic (routes (AsServerT m))
         ) => err
           -> routes (AsServerT m)
           -> routes (AsServerT m)
throwAll' errCode server =
  hoistServer (Proxy @(NamedRoutes routes)) f server
  where
    f :: forall a. m a -> m a
    f = const (throwError errCode)

serverPrivateGargAPI :: Named.GargPrivateAPI (AsServerT (GargM Env BackendInternalError))
serverPrivateGargAPI = Named.GargPrivateAPI $ \case
  (Authenticated auser) -> Named.serverPrivateGargAPI' auser
  -- In the code below we just needed a mock 'AuthenticatedUser' to make the type check, but
  -- they will never be evaluated.
  _                     -> throwAll' (_ServerError # err401)
                             $ Named.serverPrivateGargAPI' (AuthenticatedUser 0 (UnsafeMkUserId 0))
-- Here throwAll' requires a concrete type for the monad.
