{-# OPTIONS_HADDOCK not-home #-}

{- |
Module      : Servant.API.Routes.Internal.Auth
Copyright   : (c) Frederick Pringle, 2025
License     : BSD-3-Clause
Maintainer  : freddyjepringle@gmail.com

Internal module, subject to change.
-}
module Servant.API.Routes.Internal.Auth
  ( Auth (..)
  )
where

import Data.Aeson
import qualified Data.Text as T

{- | There are 2 variants:

- \"Basic" authentication: corresponds to the 'Servant.API.BasicAuth' type. Construct with 'Servant.API.Routes.Auth.basicAuth'.
- \"Custom" authentication: corresponds to the 'Servant.API.AuthProtect' type. Construct with 'Servant.API.Routes.Auth.customAuth'.
-}
data Auth
  = Basic T.Text
  | Custom T.Text
  deriving (Int -> Auth -> ShowS
[Auth] -> ShowS
Auth -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Auth] -> ShowS
$cshowList :: [Auth] -> ShowS
show :: Auth -> String
$cshow :: Auth -> String
showsPrec :: Int -> Auth -> ShowS
$cshowsPrec :: Int -> Auth -> ShowS
Show, Auth -> Auth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Auth -> Auth -> Bool
$c/= :: Auth -> Auth -> Bool
== :: Auth -> Auth -> Bool
$c== :: Auth -> Auth -> Bool
Eq, Eq Auth
Auth -> Auth -> Bool
Auth -> Auth -> Ordering
Auth -> Auth -> Auth
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Auth -> Auth -> Auth
$cmin :: Auth -> Auth -> Auth
max :: Auth -> Auth -> Auth
$cmax :: Auth -> Auth -> Auth
>= :: Auth -> Auth -> Bool
$c>= :: Auth -> Auth -> Bool
> :: Auth -> Auth -> Bool
$c> :: Auth -> Auth -> Bool
<= :: Auth -> Auth -> Bool
$c<= :: Auth -> Auth -> Bool
< :: Auth -> Auth -> Bool
$c< :: Auth -> Auth -> Bool
compare :: Auth -> Auth -> Ordering
$ccompare :: Auth -> Auth -> Ordering
Ord)

instance ToJSON Auth where
  toJSON :: Auth -> Value
toJSON =
    forall a. ToJSON a => a -> Value
toJSON @T.Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      Basic Text
realm -> Text
"Basic " forall a. Semigroup a => a -> a -> a
<> Text
realm
      Custom Text
tag -> Text
tag