{-# LANGUAGE DataKinds #-}

module Hercules.API.Auth where

import Hercules.API.Forge.Forge (Forge)
import Hercules.API.Prelude
import Hercules.API.Servant.Status
import Servant.API
import Web.Cookie (SetCookie)

type OAuthReturn stage view =
  "api"
    :> "auth"
    :> "forge"
    :> Capture "forge" (Id Forge)
    :> "return"
    :> QueryParam' '[stage, Strict] "code" Text
    :> QueryParam' '[Optional, Strict] "redirect" Text
    :> view

-- | Endpoints for authentication
data AuthAPI auth f = AuthAPI
  { forall auth f.
AuthAPI auth f
-> f
   :- ("api"
       :> ("auth"
           :> ("github"
               :> (QueryParam' '[Optional, Strict] "redirect" Text
                   :> Get302 '[PlainText, JSON] '[]))))
initiateGitHubLogin ::
      f
        :- "api"
          :> "auth"
          :> "github"
          :> QueryParam' '[Optional, Strict] "redirect" Text
          :> Get302 '[PlainText, JSON] '[],
    forall auth f.
AuthAPI auth f
-> f
   :- (Summary "Terminate the session and help clear the cookies."
       :> ("api"
           :> ("auth"
               :> ("sign-out"
                   :> (auth
                       :> Post
                            '[JSON]
                            (Headers
                               '[Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie]
                               NoContent))))))
signOut ::
      f
        :- Summary "Terminate the session and help clear the cookies."
          :> "api"
          :> "auth"
          :> "sign-out"
          :> auth
          :> Post '[JSON] (Headers '[Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie] NoContent),
    forall auth f.
AuthAPI auth f
-> f
   :- (Summary
         "Initiate an OAuth login, redirecting the client to a URL at the OAuth provider."
       :> ("api"
           :> ("auth"
               :> (Capture "type" Text
                   :> ("start"
                       :> (Capture "forgeId" (Id Forge)
                           :> (QueryParam' '[Optional, Strict] "redirect" Text
                               :> (auth :> Get302 '[PlainText, JSON] '[]))))))))
start ::
      f
        :- Summary "Initiate an OAuth login, redirecting the client to a URL at the OAuth provider."
          :> "api"
          :> "auth"
          :> Capture "type" Text
          :> "start"
          :> Capture "forgeId" (Id Forge)
          :> QueryParam' '[Optional, Strict] "redirect" Text
          :> auth
          :> Get302 '[PlainText, JSON] '[],
    forall auth f.
AuthAPI auth f
-> f
   :- OAuthReturn
        Required
        (auth
         :> Get302
              '[PlainText, JSON]
              '[Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie])
return ::
      f
        :- OAuthReturn
             Required
             ( auth
                 :> Get302
                      '[PlainText, JSON]
                      '[ Header "Set-Cookie" SetCookie,
                         Header "Set-Cookie" SetCookie
                       ]
             )
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall auth f x. Rep (AuthAPI auth f) x -> AuthAPI auth f
forall auth f x. AuthAPI auth f -> Rep (AuthAPI auth f) x
$cto :: forall auth f x. Rep (AuthAPI auth f) x -> AuthAPI auth f
$cfrom :: forall auth f x. AuthAPI auth f -> Rep (AuthAPI auth f) x
Generic)

data AuthRoutes view f = AuthRoutes
  { forall view f. AuthRoutes view f -> f :- OAuthReturn Optional view
authRouteReturn :: f :- OAuthReturn Optional view
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall view f x. Rep (AuthRoutes view f) x -> AuthRoutes view f
forall view f x. AuthRoutes view f -> Rep (AuthRoutes view f) x
$cto :: forall view f x. Rep (AuthRoutes view f) x -> AuthRoutes view f
$cfrom :: forall view f x. AuthRoutes view f -> Rep (AuthRoutes view f) x
Generic)