{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
module Gargantext.API.Routes.Types where

import Control.Lens
import Data.ByteString (ByteString)
import Data.CaseInsensitive qualified as CI
import Data.List qualified as L
import Data.Proxy
import Data.Set qualified as Set
import Gargantext.API.Errors
import Network.Wai hiding (responseHeaders)
import Prelude
import Servant.API.Routes
import Servant.API.Routes.Internal.Response (unResponses)
import Servant.API.Routes.Route
import Servant.Client hiding (responseHeaders)
import Servant.Client.Core.Request (addHeader)
import Servant.Ekg
import Servant.Server
import Servant.Server.Internal.Delayed
import Servant.Server.Internal.DelayedIO
import Network.HTTP.Types (HeaderName)

data WithCustomErrorScheme a

xGargErrorScheme :: HeaderName
xGargErrorScheme = CI.mk "X-Garg-Error-Scheme"

instance (HasServer subApi ctx) => HasServer (WithCustomErrorScheme subApi) ctx where
  type ServerT (WithCustomErrorScheme subApi) m = GargErrorScheme -> ServerT subApi m
  hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy subApi) pc nt . s
  route Proxy ctx d = route (Proxy :: Proxy subApi) ctx (d `addHeaderCheck` getErrorScheme)
    where
      getErrorScheme :: DelayedIO GargErrorScheme
      getErrorScheme = withRequest $ \rq -> do
        let hdrs = requestHeaders rq
            in case L.lookup xGargErrorScheme hdrs of
                 Nothing     -> pure GES_old
                 Just "new"  -> pure GES_new
                 Just _      -> pure GES_old

instance HasEndpoint sub => HasEndpoint (WithCustomErrorScheme sub) where
  getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
  enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)

instance HasClient m sub => HasClient m (WithCustomErrorScheme sub) where
  type Client m (WithCustomErrorScheme sub) = GargErrorScheme -> Client m sub
  clientWithRoute m _ req0 _mgr =
    let req = addHeader xGargErrorScheme (renderGargErrorScheme $ GES_new) req0
    in clientWithRoute m (Proxy :: Proxy sub) req

  hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl

instance (HasRoutes subApi) => HasRoutes (WithCustomErrorScheme subApi) where
  getRoutes =
    let apiRoutes = getRoutes @subApi
        errHeader = mkHeaderRep @"X-Garg-Error-Scheme" @ByteString
        addHeader' rt = rt & routeResponse . unResponses . traversed . responseHeaders %~ Set.insert errHeader
    in  addHeader' <$> apiRoutes
