{-# OPTIONS_GHC -fno-warn-orphans #-}

module Mensam.Client.OrphanInstances where

import Mensam.API.Route.Api.User

import Data.ByteString qualified as B
import Data.Kind
import Data.Proxy
import Data.Sequence
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Encoding.Base64 qualified as T
import GHC.Generics
import Network.HTTP.Types
import Servant.API hiding (BasicAuth, Header)
import Servant.Auth
import Servant.Auth.JWT.WithSession
import Servant.Client
import Servant.Client.Core qualified as Core

type AuthData :: [Type] -> Type
data AuthData xs :: Type where
  DataBasicAuth :: Credentials -> AuthData (BasicAuth ': auths)
  DataJWT :: Jwt -> AuthData (JWT ': auths)
  DataJWTWithSession :: Jwt -> AuthData (JWTWithSession ': auths)
  DataCookie :: Cookies -> AuthData (Cookie ': auths)
  DataNextAuth :: AuthData xs -> AuthData (x ': xs)

instance HasClient m api => HasClient m (Auth auths a :> api) where
  type Client m (Auth auths a :> api) = AuthData auths -> Client m api
  clientWithRoute :: Proxy m
-> Proxy (Auth auths a :> api)
-> Request
-> Client m (Auth auths a :> api)
clientWithRoute Proxy m
Proxy Proxy (Auth auths a :> api)
Proxy Request
req = \case
    DataBasicAuth Credentials
credentials ->
      Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @m) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api) (Request -> Client m api) -> Request -> Client m api
forall a b. (a -> b) -> a -> b
$
        Request
req {Core.requestHeaders = credentialsAuthorizationHeader credentials <| Core.requestHeaders req}
    DataJWT Jwt
token ->
      Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @m) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api) (Request -> Client m api) -> Request -> Client m api
forall a b. (a -> b) -> a -> b
$
        Request
req {Core.requestHeaders = jwTokenAuthorizationHeader token <| Core.requestHeaders req}
    DataJWTWithSession Jwt
token ->
      Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @m) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api) (Request -> Client m api) -> Request -> Client m api
forall a b. (a -> b) -> a -> b
$
        Request
req {Core.requestHeaders = jwTokenAuthorizationHeader token <| Core.requestHeaders req}
    DataCookie Cookies
cookies ->
      Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @m) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api) (Request -> Client m api) -> Request -> Client m api
forall a b. (a -> b) -> a -> b
$
        Request
req {Core.requestHeaders = cookiesCookieHeader cookies <| Core.requestHeaders req}
    DataNextAuth (AuthData xs
otherAuthData :: AuthData otherAuths) ->
      Proxy m
-> Proxy (Auth xs a :> api)
-> Request
-> Client m (Auth xs a :> api)
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @m) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Auth otherAuths a :> api)) Request
req AuthData xs
otherAuthData
  hoistClientMonad :: forall (mon :: * -> *) (mon' :: * -> *).
Proxy m
-> Proxy (Auth auths a :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (Auth auths a :> api)
-> Client mon' (Auth auths a :> api)
hoistClientMonad Proxy m
Proxy Proxy (Auth auths a :> api)
Proxy forall x. mon x -> mon' x
f Client mon (Auth auths a :> api)
cl AuthData auths
arg =
    Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (mon :: * -> *) (mon' :: * -> *).
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @m) (Proxy api
forall {k} (t :: k). Proxy t
Proxy :: Proxy api) mon x -> mon' x
forall x. mon x -> mon' x
f (Client mon (Auth auths a :> api)
AuthData auths -> Client mon api
cl AuthData auths
arg)

type Credentials :: Type
data Credentials = MkCredentials {Credentials -> Text
credentialsUsername :: T.Text, Credentials -> Text
credentialsPassword :: T.Text}
  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, (forall x. Credentials -> Rep Credentials x)
-> (forall x. Rep Credentials x -> Credentials)
-> Generic Credentials
forall x. Rep Credentials x -> Credentials
forall x. Credentials -> Rep Credentials x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Credentials -> Rep Credentials x
from :: forall x. Credentials -> Rep Credentials x
$cto :: forall x. Rep Credentials x -> Credentials
to :: forall x. Rep Credentials x -> Credentials
Generic, 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, 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, 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)

credentialsAuthorizationHeader :: Credentials -> Header
credentialsAuthorizationHeader :: Credentials -> Header
credentialsAuthorizationHeader MkCredentials {Text
credentialsUsername :: Credentials -> Text
credentialsUsername :: Text
credentialsUsername, Text
credentialsPassword :: Credentials -> Text
credentialsPassword :: Text
credentialsPassword} =
  (HeaderName
hAuthorization,) (ByteString -> Header) -> ByteString -> Header
forall a b. (a -> b) -> a -> b
$ (ByteString
"Basic " <>) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.encodeBase64 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
credentialsUsername Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
credentialsPassword

jwTokenAuthorizationHeader :: Jwt -> Header
jwTokenAuthorizationHeader :: Jwt -> Header
jwTokenAuthorizationHeader MkJwt {unJwt :: Jwt -> Text
unJwt = Text
jwt} =
  (HeaderName
hAuthorization,) (ByteString -> Header) -> ByteString -> Header
forall a b. (a -> b) -> a -> b
$ (ByteString
"Bearer " <>) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
jwt

type Cookies :: Type
newtype Cookies = MkCookies {Cookies -> ByteString
unCookies :: B.ByteString}
  deriving stock (Cookies -> Cookies -> Bool
(Cookies -> Cookies -> Bool)
-> (Cookies -> Cookies -> Bool) -> Eq Cookies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cookies -> Cookies -> Bool
== :: Cookies -> Cookies -> Bool
$c/= :: Cookies -> Cookies -> Bool
/= :: Cookies -> Cookies -> Bool
Eq, (forall x. Cookies -> Rep Cookies x)
-> (forall x. Rep Cookies x -> Cookies) -> Generic Cookies
forall x. Rep Cookies x -> Cookies
forall x. Cookies -> Rep Cookies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Cookies -> Rep Cookies x
from :: forall x. Cookies -> Rep Cookies x
$cto :: forall x. Rep Cookies x -> Cookies
to :: forall x. Rep Cookies x -> Cookies
Generic, Eq Cookies
Eq Cookies =>
(Cookies -> Cookies -> Ordering)
-> (Cookies -> Cookies -> Bool)
-> (Cookies -> Cookies -> Bool)
-> (Cookies -> Cookies -> Bool)
-> (Cookies -> Cookies -> Bool)
-> (Cookies -> Cookies -> Cookies)
-> (Cookies -> Cookies -> Cookies)
-> Ord Cookies
Cookies -> Cookies -> Bool
Cookies -> Cookies -> Ordering
Cookies -> Cookies -> Cookies
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 :: Cookies -> Cookies -> Ordering
compare :: Cookies -> Cookies -> Ordering
$c< :: Cookies -> Cookies -> Bool
< :: Cookies -> Cookies -> Bool
$c<= :: Cookies -> Cookies -> Bool
<= :: Cookies -> Cookies -> Bool
$c> :: Cookies -> Cookies -> Bool
> :: Cookies -> Cookies -> Bool
$c>= :: Cookies -> Cookies -> Bool
>= :: Cookies -> Cookies -> Bool
$cmax :: Cookies -> Cookies -> Cookies
max :: Cookies -> Cookies -> Cookies
$cmin :: Cookies -> Cookies -> Cookies
min :: Cookies -> Cookies -> Cookies
Ord, ReadPrec [Cookies]
ReadPrec Cookies
Int -> ReadS Cookies
ReadS [Cookies]
(Int -> ReadS Cookies)
-> ReadS [Cookies]
-> ReadPrec Cookies
-> ReadPrec [Cookies]
-> Read Cookies
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Cookies
readsPrec :: Int -> ReadS Cookies
$creadList :: ReadS [Cookies]
readList :: ReadS [Cookies]
$creadPrec :: ReadPrec Cookies
readPrec :: ReadPrec Cookies
$creadListPrec :: ReadPrec [Cookies]
readListPrec :: ReadPrec [Cookies]
Read, Int -> Cookies -> ShowS
[Cookies] -> ShowS
Cookies -> String
(Int -> Cookies -> ShowS)
-> (Cookies -> String) -> ([Cookies] -> ShowS) -> Show Cookies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cookies -> ShowS
showsPrec :: Int -> Cookies -> ShowS
$cshow :: Cookies -> String
show :: Cookies -> String
$cshowList :: [Cookies] -> ShowS
showList :: [Cookies] -> ShowS
Show)

cookiesCookieHeader :: Cookies -> Header
cookiesCookieHeader :: Cookies -> Header
cookiesCookieHeader MkCookies {ByteString
unCookies :: Cookies -> ByteString
unCookies :: ByteString
unCookies} = (HeaderName
hCookie, ByteString
unCookies)