{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

{-# LANGUAGE NoImplicitPrelude #-}

module Client.ApiRequests where

import Relude

import Data.Morpheus.Client
import Yesod hiding (Header)
import Yesod.Auth

type ClientTypeConstraint (a :: Type) = (RequestType a, ToJSON (RequestArgs a), FromJSON a)
-- From Data.Morpheus.Client.Fetch.RequestType
type Header = (Text, Text)
-- From Data.Morpheus.Client.Fetch.GQLClient
-- No clue why these are not exported

type RequestConstraint a site = (ClientTypeConstraint a, ApiRequest site)

type Authorization = Text

class YesodAuth site => ApiRequest site where
    getApiUrl :: HandlerFor site Text
    authIdToAuthorization :: site -> AuthId site -> Authorization

apiRequest' :: RequestConstraint a site => [Header] -> Bool -> Args a -> HandlerFor site a
apiRequest' extraHeaders authRequired args = do
    yesod <- liftHandler getYesod
    auth <- fmap (authIdToAuthorization yesod) <$> if authRequired then Just <$> requireAuthId else maybeAuthId
    apiRequestAuth extraHeaders (("Bearer " <>) <$> auth) args >>= handleErrors

apiRequestAuth :: RequestConstraint a site =>
    [Header] -> Maybe Authorization -> Args a -> HandlerFor site (GQLClientResult a)
apiRequestAuth extraHeaders auth args = do
    apiUrl <- getApiUrl
    stream <- liftIO $ request (fromString (toString apiUrl) `withHeaders` headers) args
    single stream
        where headers = maybe [] (\x -> [("Authorization", x)]) auth <> extraHeaders

apiRequest :: RequestConstraint a site => Bool -> Args a -> HandlerFor site a
apiRequest authRequired = apiRequest' [] authRequired

handleErrors :: RequestConstraint a site => GQLClientResult a -> HandlerFor site a
handleErrors (Right a) = pure a
handleErrors (Left (FetchErrorParseFailure s)) = error $ "GQL parse failure: " <> toText s
handleErrors (Left (FetchErrorProducedErrors errs Nothing)) = error $ "GQL errors: " <> show errs
handleErrors (Left (FetchErrorProducedErrors _ (Just a))) = pure a -- TODO log the errors?
handleErrors (Left (FetchErrorNoResult)) = error $ "GQL no results"