{-# LANGUAGE DuplicateRecordFields #-}

{- | HTTP basic authentication support.

 Middlewares defined in this module add basic authentication support
 to handlers. In most cases, you just need to use `BasicAuth` trait
 and `basicAuth` middleware. The table below describes when to use
 other traits and middlewares.

 +----------+-------------+-------------------------+----------------------+
 | Type     | Auth Scheme | Trait                   | Middleware           |
 +----------+-------------+-------------------------+----------------------+
 | Required | Basic       | 'BasicAuth'             | 'basicAuth'          |
 +----------+-------------+-------------------------+----------------------+
 | Optional | Basic       | 'BasicAuth'' 'Optional' | 'optionalBasicAuth'  |
 +----------+-------------+-------------------------+----------------------+
 | Required | Any scheme  | 'BasicAuth'' 'Required' | 'basicAuth''         |
 +----------+-------------+-------------------------+----------------------+
 | Optional | Any scheme  | 'BasicAuth'' 'Optional' | 'optionalBasicAuth'' |
 +----------+-------------+-------------------------+----------------------+

 For example, given this handler:

 @
 myHandler :: ('Handler' h IO, 'HasTrait' ('BasicAuth' IO () 'Credentials') ts) => 'RequestHandler' h ts
 myHandler = ....
 @

 and the following definitions:

 @
 authConfig :: 'BasicAuth' IO () 'Credentials'
 authConfig = 'BasicAuth'' { toBasicAttribute = pure . Right }

 type ErrorTraits = [Status, RequiredRequestHeader \"Content-Type\" Text, RequiredRequestHeader \"WWW-Authenticate\" Text, Body Text]

 errorHandler :: ('Handler' h IO, Sets h ErrorTraits Response)
              => h (Request \`With\` ts, 'BasicAuthError' e) Response
 errorHandler = 'respondUnauthorized' \"Basic\" \"MyRealm\"
 @

 we can add basic authentication to @myHandler@:

 @
 myHandlerWithAuth :: ('Handler' h IO, Get h ('BasicAuth' IO () 'Credentials') Request, Sets h ErrorTraits Response)
                   => 'RequestHandler' h ts
 myHandlerWithAuth = 'basicAuth' authConfig errorHandler myHandler
 @

 The middlewares defined below take a 'BasicAuth'' parameter which is
 a newtype wrapper over a function of type @'Credentials' -> m (Either
 e a)@. This is used to convert the user supplied credentials to a
 value of type @a@ or fail with an error of type @e@. The next handler
 is invoked after this conversion and can access @a@ as a trait
 attribute.

 Middlewares marked as 'Required' take an additional error handling
 arrow as a parameter. This arrow is used when an error is encountered
 in authentication. This arrow receives the original request and a
 'BasicAuthError' as inputs and must produce a response as the output.

 Middlewares marked as 'Optional' do not have this additional error
 handling arrow. Instead, the trait attribute is of type @Either
 ('BasicAuthError' e) a@. The next handler will get the errors in this
 trait attribute and must handle it.
-}
module WebGear.Core.Trait.Auth.Basic (
  BasicAuth' (..),
  BasicAuth,
  Realm (..),
  Username (..),
  Password (..),
  Credentials (..),
  BasicAuthError (..),
  basicAuth,
  basicAuth',
  optionalBasicAuth,
  optionalBasicAuth',
) where

import Control.Arrow (ArrowChoice, arr)
import Data.ByteString (ByteString)
import Data.String (IsString)
import Data.Void (Void, absurd)
import GHC.TypeLits (Symbol)
import WebGear.Core.Handler
import WebGear.Core.Modifiers (Existence (..))
import WebGear.Core.Request (Request)
import WebGear.Core.Response (Response)
import WebGear.Core.Trait
import WebGear.Core.Trait.Auth.Common

-- | Trait for HTTP basic authentication: https://tools.ietf.org/html/rfc7617
newtype BasicAuth' (x :: Existence) (scheme :: Symbol) m e a = BasicAuth'
  { forall (x :: Existence) (scheme :: Symbol) (m :: * -> *) e a.
BasicAuth' x scheme m e a -> Credentials -> m (Either e a)
toBasicAttribute :: Credentials -> m (Either e a)
  -- ^ Convert the credentials to the trait attribute or an error
  }

-- | Trait for HTTP basic authentication with the "Basic" scheme.
type BasicAuth = BasicAuth' Required "Basic"

{- | Username for basic authentication. Valid usernames cannot contain
 \':\' characters.
-}
newtype Username = Username ByteString
  deriving newtype (Username -> Username -> Bool
(Username -> Username -> Bool)
-> (Username -> Username -> Bool) -> Eq Username
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Username -> Username -> Bool
== :: Username -> Username -> Bool
$c/= :: Username -> Username -> Bool
/= :: Username -> Username -> Bool
Eq, Eq Username
Eq Username =>
(Username -> Username -> Ordering)
-> (Username -> Username -> Bool)
-> (Username -> Username -> Bool)
-> (Username -> Username -> Bool)
-> (Username -> Username -> Bool)
-> (Username -> Username -> Username)
-> (Username -> Username -> Username)
-> Ord Username
Username -> Username -> Bool
Username -> Username -> Ordering
Username -> Username -> Username
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
$ccompare :: Username -> Username -> Ordering
compare :: Username -> Username -> Ordering
$c< :: Username -> Username -> Bool
< :: Username -> Username -> Bool
$c<= :: Username -> Username -> Bool
<= :: Username -> Username -> Bool
$c> :: Username -> Username -> Bool
> :: Username -> Username -> Bool
$c>= :: Username -> Username -> Bool
>= :: Username -> Username -> Bool
$cmax :: Username -> Username -> Username
max :: Username -> Username -> Username
$cmin :: Username -> Username -> Username
min :: Username -> Username -> Username
Ord, Int -> Username -> ShowS
[Username] -> ShowS
Username -> String
(Int -> Username -> ShowS)
-> (Username -> String) -> ([Username] -> ShowS) -> Show Username
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Username -> ShowS
showsPrec :: Int -> Username -> ShowS
$cshow :: Username -> String
show :: Username -> String
$cshowList :: [Username] -> ShowS
showList :: [Username] -> ShowS
Show, ReadPrec [Username]
ReadPrec Username
Int -> ReadS Username
ReadS [Username]
(Int -> ReadS Username)
-> ReadS [Username]
-> ReadPrec Username
-> ReadPrec [Username]
-> Read Username
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Username
readsPrec :: Int -> ReadS Username
$creadList :: ReadS [Username]
readList :: ReadS [Username]
$creadPrec :: ReadPrec Username
readPrec :: ReadPrec Username
$creadListPrec :: ReadPrec [Username]
readListPrec :: ReadPrec [Username]
Read, String -> Username
(String -> Username) -> IsString Username
forall a. (String -> a) -> IsString a
$cfromString :: String -> Username
fromString :: String -> Username
IsString)

-- | Password for basic authentication.
newtype Password = Password ByteString
  deriving newtype (Password -> Password -> Bool
(Password -> Password -> Bool)
-> (Password -> Password -> Bool) -> Eq Password
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Password -> Password -> Bool
== :: Password -> Password -> Bool
$c/= :: Password -> Password -> Bool
/= :: Password -> Password -> Bool
Eq, Eq Password
Eq Password =>
(Password -> Password -> Ordering)
-> (Password -> Password -> Bool)
-> (Password -> Password -> Bool)
-> (Password -> Password -> Bool)
-> (Password -> Password -> Bool)
-> (Password -> Password -> Password)
-> (Password -> Password -> Password)
-> Ord Password
Password -> Password -> Bool
Password -> Password -> Ordering
Password -> Password -> Password
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
$ccompare :: Password -> Password -> Ordering
compare :: Password -> Password -> Ordering
$c< :: Password -> Password -> Bool
< :: Password -> Password -> Bool
$c<= :: Password -> Password -> Bool
<= :: Password -> Password -> Bool
$c> :: Password -> Password -> Bool
> :: Password -> Password -> Bool
$c>= :: Password -> Password -> Bool
>= :: Password -> Password -> Bool
$cmax :: Password -> Password -> Password
max :: Password -> Password -> Password
$cmin :: Password -> Password -> Password
min :: Password -> Password -> Password
Ord, Int -> Password -> ShowS
[Password] -> ShowS
Password -> String
(Int -> Password -> ShowS)
-> (Password -> String) -> ([Password] -> ShowS) -> Show Password
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Password -> ShowS
showsPrec :: Int -> Password -> ShowS
$cshow :: Password -> String
show :: Password -> String
$cshowList :: [Password] -> ShowS
showList :: [Password] -> ShowS
Show, ReadPrec [Password]
ReadPrec Password
Int -> ReadS Password
ReadS [Password]
(Int -> ReadS Password)
-> ReadS [Password]
-> ReadPrec Password
-> ReadPrec [Password]
-> Read Password
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Password
readsPrec :: Int -> ReadS Password
$creadList :: ReadS [Password]
readList :: ReadS [Password]
$creadPrec :: ReadPrec Password
readPrec :: ReadPrec Password
$creadListPrec :: ReadPrec [Password]
readListPrec :: ReadPrec [Password]
Read, String -> Password
(String -> Password) -> IsString Password
forall a. (String -> a) -> IsString a
$cfromString :: String -> Password
fromString :: String -> Password
IsString)

-- | Basic authentication credentials retrieved from an HTTP request
data Credentials = Credentials
  { Credentials -> Username
credentialsUsername :: !Username
  , Credentials -> Password
credentialsPassword :: !Password
  }
  deriving stock (Credentials -> Credentials -> Bool
(Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Bool) -> Eq Credentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Credentials -> Credentials -> Bool
== :: Credentials -> Credentials -> Bool
$c/= :: Credentials -> Credentials -> Bool
/= :: Credentials -> Credentials -> Bool
Eq, Eq Credentials
Eq Credentials =>
(Credentials -> Credentials -> Ordering)
-> (Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Credentials)
-> (Credentials -> Credentials -> Credentials)
-> Ord Credentials
Credentials -> Credentials -> Bool
Credentials -> Credentials -> Ordering
Credentials -> Credentials -> Credentials
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
$ccompare :: Credentials -> Credentials -> Ordering
compare :: Credentials -> Credentials -> Ordering
$c< :: Credentials -> Credentials -> Bool
< :: Credentials -> Credentials -> Bool
$c<= :: Credentials -> Credentials -> Bool
<= :: Credentials -> Credentials -> Bool
$c> :: Credentials -> Credentials -> Bool
> :: Credentials -> Credentials -> Bool
$c>= :: Credentials -> Credentials -> Bool
>= :: Credentials -> Credentials -> Bool
$cmax :: Credentials -> Credentials -> Credentials
max :: Credentials -> Credentials -> Credentials
$cmin :: Credentials -> Credentials -> Credentials
min :: Credentials -> Credentials -> Credentials
Ord, Int -> Credentials -> ShowS
[Credentials] -> ShowS
Credentials -> String
(Int -> Credentials -> ShowS)
-> (Credentials -> String)
-> ([Credentials] -> ShowS)
-> Show Credentials
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Credentials -> ShowS
showsPrec :: Int -> Credentials -> ShowS
$cshow :: Credentials -> String
show :: Credentials -> String
$cshowList :: [Credentials] -> ShowS
showList :: [Credentials] -> ShowS
Show, ReadPrec [Credentials]
ReadPrec Credentials
Int -> ReadS Credentials
ReadS [Credentials]
(Int -> ReadS Credentials)
-> ReadS [Credentials]
-> ReadPrec Credentials
-> ReadPrec [Credentials]
-> Read Credentials
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Credentials
readsPrec :: Int -> ReadS Credentials
$creadList :: ReadS [Credentials]
readList :: ReadS [Credentials]
$creadPrec :: ReadPrec Credentials
readPrec :: ReadPrec Credentials
$creadListPrec :: ReadPrec [Credentials]
readListPrec :: ReadPrec [Credentials]
Read)

-- | Error retrieving basic authentication credentials
data BasicAuthError e
  = BasicAuthHeaderMissing
  | BasicAuthSchemeMismatch
  | BasicAuthCredsBadFormat
  | BasicAuthAttributeError e
  deriving stock (BasicAuthError e -> BasicAuthError e -> Bool
(BasicAuthError e -> BasicAuthError e -> Bool)
-> (BasicAuthError e -> BasicAuthError e -> Bool)
-> Eq (BasicAuthError e)
forall e. Eq e => BasicAuthError e -> BasicAuthError e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => BasicAuthError e -> BasicAuthError e -> Bool
== :: BasicAuthError e -> BasicAuthError e -> Bool
$c/= :: forall e. Eq e => BasicAuthError e -> BasicAuthError e -> Bool
/= :: BasicAuthError e -> BasicAuthError e -> Bool
Eq, Int -> BasicAuthError e -> ShowS
[BasicAuthError e] -> ShowS
BasicAuthError e -> String
(Int -> BasicAuthError e -> ShowS)
-> (BasicAuthError e -> String)
-> ([BasicAuthError e] -> ShowS)
-> Show (BasicAuthError e)
forall e. Show e => Int -> BasicAuthError e -> ShowS
forall e. Show e => [BasicAuthError e] -> ShowS
forall e. Show e => BasicAuthError e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> BasicAuthError e -> ShowS
showsPrec :: Int -> BasicAuthError e -> ShowS
$cshow :: forall e. Show e => BasicAuthError e -> String
show :: BasicAuthError e -> String
$cshowList :: forall e. Show e => [BasicAuthError e] -> ShowS
showList :: [BasicAuthError e] -> ShowS
Show, ReadPrec [BasicAuthError e]
ReadPrec (BasicAuthError e)
Int -> ReadS (BasicAuthError e)
ReadS [BasicAuthError e]
(Int -> ReadS (BasicAuthError e))
-> ReadS [BasicAuthError e]
-> ReadPrec (BasicAuthError e)
-> ReadPrec [BasicAuthError e]
-> Read (BasicAuthError e)
forall e. Read e => ReadPrec [BasicAuthError e]
forall e. Read e => ReadPrec (BasicAuthError e)
forall e. Read e => Int -> ReadS (BasicAuthError e)
forall e. Read e => ReadS [BasicAuthError e]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall e. Read e => Int -> ReadS (BasicAuthError e)
readsPrec :: Int -> ReadS (BasicAuthError e)
$creadList :: forall e. Read e => ReadS [BasicAuthError e]
readList :: ReadS [BasicAuthError e]
$creadPrec :: forall e. Read e => ReadPrec (BasicAuthError e)
readPrec :: ReadPrec (BasicAuthError e)
$creadListPrec :: forall e. Read e => ReadPrec [BasicAuthError e]
readListPrec :: ReadPrec [BasicAuthError e]
Read)

instance Trait (BasicAuth' Required scheme m e a) Request where
  type Attribute (BasicAuth' Required scheme m e a) Request = a

instance TraitAbsence (BasicAuth' Required scheme m e a) Request where
  type Absence (BasicAuth' Required scheme m e a) Request = BasicAuthError e

instance Trait (BasicAuth' Optional scheme m e a) Request where
  type Attribute (BasicAuth' Optional scheme m e a) Request = Either (BasicAuthError e) a

instance TraitAbsence (BasicAuth' Optional scheme m e a) Request where
  type Absence (BasicAuth' Optional scheme m e a) Request = Void

type instance
  Prerequisite (BasicAuth' x scheme m e a) ts Request =
    HasTrait (AuthorizationHeader scheme) ts

basicAuthMiddleware ::
  ( ArrowChoice h
  , Get h (BasicAuth' x scheme m e t) Request
  , HasTrait (AuthorizationHeader scheme) ts
  ) =>
  BasicAuth' x scheme m e t ->
  h (Request `With` ts, Absence (BasicAuth' x scheme m e t) Request) Response ->
  Middleware h ts (BasicAuth' x scheme m e t : ts)
basicAuthMiddleware :: forall (h :: * -> * -> *) (x :: Existence) (scheme :: Symbol)
       (m :: * -> *) e t (ts :: [*]).
(ArrowChoice h, Get h (BasicAuth' x scheme m e t) Request,
 HasTrait (AuthorizationHeader scheme) ts) =>
BasicAuth' x scheme m e t
-> h (With Request ts, Absence (BasicAuth' x scheme m e t) Request)
     Response
-> Middleware h ts (BasicAuth' x scheme m e t : ts)
basicAuthMiddleware BasicAuth' x scheme m e t
authCfg h (With Request ts, Absence (BasicAuth' x scheme m e t) Request)
  Response
errorHandler RequestHandler h (BasicAuth' x scheme m e t : ts)
nextHandler =
  proc With Request ts
request -> do
    Either
  (Absence (BasicAuth' x scheme m e t) Request)
  (With Request (BasicAuth' x scheme m e t : ts))
result <- BasicAuth' x scheme m e t
-> h (With Request ts)
     (Either
        (Absence (BasicAuth' x scheme m e t) Request)
        (With Request (BasicAuth' x scheme m e t : ts)))
forall t (ts :: [*]) (h :: * -> * -> *) a.
(Get h t a, Prerequisite t ts a) =>
t -> h (With a ts) (Either (Absence t a) (With a (t : ts)))
probe BasicAuth' x scheme m e t
authCfg -< With Request ts
request
    case Either
  (Absence (BasicAuth' x scheme m e t) Request)
  (With Request (BasicAuth' x scheme m e t : ts))
result of
      Left Absence (BasicAuth' x scheme m e t) Request
err -> h (With Request ts, Absence (BasicAuth' x scheme m e t) Request)
  Response
errorHandler -< (With Request ts
request, Absence (BasicAuth' x scheme m e t) Request
err)
      Right With Request (BasicAuth' x scheme m e t : ts)
val -> RequestHandler h (BasicAuth' x scheme m e t : ts)
nextHandler -< With Request (BasicAuth' x scheme m e t : ts)
val
{-# INLINE basicAuthMiddleware #-}

{- | Middleware to add basic authentication protection for a handler.

 Example usage:

 > basicAuth cfg errorHandler nextHandler

 The @errorHandler@ is invoked if the credentials are invalid or
 missing. The @nextHandler@ is invoked if the credentials were
 retrieved successfully.
-}
basicAuth ::
  forall m e t h ts.
  ( ArrowChoice h
  , Get h (BasicAuth' Required "Basic" m e t) Request
  , HasTrait (AuthorizationHeader "Basic") ts
  ) =>
  -- | Authentication configuration
  BasicAuth m e t ->
  -- | Error handler
  h (Request `With` ts, BasicAuthError e) Response ->
  Middleware h ts (BasicAuth m e t : ts)
basicAuth :: forall (m :: * -> *) e t (h :: * -> * -> *) (ts :: [*]).
(ArrowChoice h, Get h (BasicAuth' 'Required "Basic" m e t) Request,
 HasTrait (AuthorizationHeader "Basic") ts) =>
BasicAuth' 'Required "Basic" m e t
-> h (With Request ts, BasicAuthError e) Response
-> Middleware h ts (BasicAuth' 'Required "Basic" m e t : ts)
basicAuth = BasicAuth' 'Required "Basic" m e t
-> h (With Request ts, BasicAuthError e) Response
-> Middleware h ts (BasicAuth' 'Required "Basic" m e t : ts)
forall (scheme :: Symbol) (m :: * -> *) e t (h :: * -> * -> *)
       (ts :: [*]).
(ArrowChoice h, Get h (BasicAuth' 'Required scheme m e t) Request,
 HasTrait (AuthorizationHeader scheme) ts) =>
BasicAuth' 'Required scheme m e t
-> h (With Request ts, BasicAuthError e) Response
-> Middleware h ts (BasicAuth' 'Required scheme m e t : ts)
basicAuth'
{-# INLINE basicAuth #-}

{- | Similar to `basicAuth` but supports a custom authentication scheme.

 Example usage:

 > basicAuth' @"scheme" cfg errorHandler nextHandler
-}
basicAuth' ::
  forall scheme m e t h ts.
  ( ArrowChoice h
  , Get h (BasicAuth' Required scheme m e t) Request
  , HasTrait (AuthorizationHeader scheme) ts
  ) =>
  -- | Authentication configuration
  BasicAuth' Required scheme m e t ->
  -- | Error handler
  h (Request `With` ts, BasicAuthError e) Response ->
  Middleware h ts (BasicAuth' Required scheme m e t : ts)
basicAuth' :: forall (scheme :: Symbol) (m :: * -> *) e t (h :: * -> * -> *)
       (ts :: [*]).
(ArrowChoice h, Get h (BasicAuth' 'Required scheme m e t) Request,
 HasTrait (AuthorizationHeader scheme) ts) =>
BasicAuth' 'Required scheme m e t
-> h (With Request ts, BasicAuthError e) Response
-> Middleware h ts (BasicAuth' 'Required scheme m e t : ts)
basicAuth' = BasicAuth' 'Required scheme m e t
-> h (With Request ts,
      Absence (BasicAuth' 'Required scheme m e t) Request)
     Response
-> Middleware h ts (BasicAuth' 'Required scheme m e t : ts)
BasicAuth' 'Required scheme m e t
-> h (With Request ts, BasicAuthError e) Response
-> Middleware h ts (BasicAuth' 'Required scheme m e t : ts)
forall (h :: * -> * -> *) (x :: Existence) (scheme :: Symbol)
       (m :: * -> *) e t (ts :: [*]).
(ArrowChoice h, Get h (BasicAuth' x scheme m e t) Request,
 HasTrait (AuthorizationHeader scheme) ts) =>
BasicAuth' x scheme m e t
-> h (With Request ts, Absence (BasicAuth' x scheme m e t) Request)
     Response
-> Middleware h ts (BasicAuth' x scheme m e t : ts)
basicAuthMiddleware
{-# INLINE basicAuth' #-}

{- | Middleware to add optional basic authentication protection for a handler.

 Example usage:

 > optionalBasicAuth cfg nextHandler

 This middleware will not fail if credentials are invalid or
 missing. Instead the trait attribute is of type @'Either'
 ('BasicAuthError' e) t@ so that the handler can process the
 authentication error appropriately.
-}
optionalBasicAuth ::
  forall m e t h ts.
  ( ArrowChoice h
  , Get h (BasicAuth' Optional "Basic" m e t) Request
  , HasTrait (AuthorizationHeader "Basic") ts
  ) =>
  -- | Authentication configuration
  BasicAuth' Optional "Basic" m e t ->
  Middleware h ts (BasicAuth' Optional "Basic" m e t : ts)
optionalBasicAuth :: forall (m :: * -> *) e t (h :: * -> * -> *) (ts :: [*]).
(ArrowChoice h, Get h (BasicAuth' 'Optional "Basic" m e t) Request,
 HasTrait (AuthorizationHeader "Basic") ts) =>
BasicAuth' 'Optional "Basic" m e t
-> Middleware h ts (BasicAuth' 'Optional "Basic" m e t : ts)
optionalBasicAuth = BasicAuth' 'Optional "Basic" m e t
-> Middleware h ts (BasicAuth' 'Optional "Basic" m e t : ts)
forall (scheme :: Symbol) (m :: * -> *) e t (h :: * -> * -> *)
       (ts :: [*]).
(ArrowChoice h, Get h (BasicAuth' 'Optional scheme m e t) Request,
 HasTrait (AuthorizationHeader scheme) ts) =>
BasicAuth' 'Optional scheme m e t
-> Middleware h ts (BasicAuth' 'Optional scheme m e t : ts)
optionalBasicAuth'
{-# INLINE optionalBasicAuth #-}

{- | Similar to `optionalBasicAuth` but supports a custom authentication
   scheme.

 Example usage:

 > optionalBasicAuth' @"scheme" cfg nextHandler
-}
optionalBasicAuth' ::
  forall scheme m e t h ts.
  ( ArrowChoice h
  , Get h (BasicAuth' Optional scheme m e t) Request
  , HasTrait (AuthorizationHeader scheme) ts
  ) =>
  -- | Authentication configuration
  BasicAuth' Optional scheme m e t ->
  Middleware h ts (BasicAuth' Optional scheme m e t : ts)
optionalBasicAuth' :: forall (scheme :: Symbol) (m :: * -> *) e t (h :: * -> * -> *)
       (ts :: [*]).
(ArrowChoice h, Get h (BasicAuth' 'Optional scheme m e t) Request,
 HasTrait (AuthorizationHeader scheme) ts) =>
BasicAuth' 'Optional scheme m e t
-> Middleware h ts (BasicAuth' 'Optional scheme m e t : ts)
optionalBasicAuth' BasicAuth' 'Optional scheme m e t
cfg = BasicAuth' 'Optional scheme m e t
-> h (With Request ts,
      Absence (BasicAuth' 'Optional scheme m e t) Request)
     Response
-> h (With Request (BasicAuth' 'Optional scheme m e t : ts))
     Response
-> h (With Request ts) Response
forall (h :: * -> * -> *) (x :: Existence) (scheme :: Symbol)
       (m :: * -> *) e t (ts :: [*]).
(ArrowChoice h, Get h (BasicAuth' x scheme m e t) Request,
 HasTrait (AuthorizationHeader scheme) ts) =>
BasicAuth' x scheme m e t
-> h (With Request ts, Absence (BasicAuth' x scheme m e t) Request)
     Response
-> Middleware h ts (BasicAuth' x scheme m e t : ts)
basicAuthMiddleware BasicAuth' 'Optional scheme m e t
cfg (h (With Request ts,
    Absence (BasicAuth' 'Optional scheme m e t) Request)
   Response
 -> h (With Request (BasicAuth' 'Optional scheme m e t : ts))
      Response
 -> h (With Request ts) Response)
-> h (With Request ts,
      Absence (BasicAuth' 'Optional scheme m e t) Request)
     Response
-> h (With Request (BasicAuth' 'Optional scheme m e t : ts))
     Response
-> h (With Request ts) Response
forall a b. (a -> b) -> a -> b
$ ((With Request ts, Void) -> Response)
-> h (With Request ts, Void) Response
forall b c. (b -> c) -> h b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Void -> Response
forall a. Void -> a
absurd (Void -> Response)
-> ((With Request ts, Void) -> Void)
-> (With Request ts, Void)
-> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (With Request ts, Void) -> Void
forall a b. (a, b) -> b
snd)
{-# INLINE optionalBasicAuth' #-}