-----------------------------------------------------------------------------
-- |
-- License     :  BSD-3-Clause
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
module GitHub.Auth (
    Auth (..),
    AuthMethod,
    endpoint,
    setAuthRequest
    ) where

import GitHub.Internal.Prelude
import Prelude ()

import qualified Data.ByteString     as BS
import qualified Network.HTTP.Client as HTTP

type Token = BS.ByteString

-- | The Github auth data type
data Auth
    = BasicAuth BS.ByteString BS.ByteString  -- ^ Username and password
    | OAuth Token                            -- ^ OAuth token
    | EnterpriseOAuth Text Token             -- ^ Custom endpoint and OAuth token
    deriving (Int -> Auth -> ShowS
[Auth] -> ShowS
Auth -> String
(Int -> Auth -> ShowS)
-> (Auth -> String) -> ([Auth] -> ShowS) -> Show Auth
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, Typeable Auth
DataType
Constr
Typeable Auth
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Auth -> c Auth)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Auth)
-> (Auth -> Constr)
-> (Auth -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Auth))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Auth))
-> ((forall b. Data b => b -> b) -> Auth -> Auth)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Auth -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Auth -> r)
-> (forall u. (forall d. Data d => d -> u) -> Auth -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Auth -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Auth -> m Auth)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Auth -> m Auth)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Auth -> m Auth)
-> Data Auth
Auth -> DataType
Auth -> Constr
(forall b. Data b => b -> b) -> Auth -> Auth
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Auth -> c Auth
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Auth
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Auth -> u
forall u. (forall d. Data d => d -> u) -> Auth -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Auth -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Auth -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Auth -> m Auth
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Auth -> m Auth
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Auth
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Auth -> c Auth
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Auth)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Auth)
$cEnterpriseOAuth :: Constr
$cOAuth :: Constr
$cBasicAuth :: Constr
$tAuth :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Auth -> m Auth
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Auth -> m Auth
gmapMp :: (forall d. Data d => d -> m d) -> Auth -> m Auth
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Auth -> m Auth
gmapM :: (forall d. Data d => d -> m d) -> Auth -> m Auth
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Auth -> m Auth
gmapQi :: Int -> (forall d. Data d => d -> u) -> Auth -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Auth -> u
gmapQ :: (forall d. Data d => d -> u) -> Auth -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Auth -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Auth -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Auth -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Auth -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Auth -> r
gmapT :: (forall b. Data b => b -> b) -> Auth -> Auth
$cgmapT :: (forall b. Data b => b -> b) -> Auth -> Auth
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Auth)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Auth)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Auth)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Auth)
dataTypeOf :: Auth -> DataType
$cdataTypeOf :: Auth -> DataType
toConstr :: Auth -> Constr
$ctoConstr :: Auth -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Auth
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Auth
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Auth -> c Auth
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Auth -> c Auth
$cp1Data :: Typeable Auth
Data, Typeable, Auth -> Auth -> Bool
(Auth -> Auth -> Bool) -> (Auth -> Auth -> Bool) -> Eq Auth
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
Eq Auth
-> (Auth -> Auth -> Ordering)
-> (Auth -> Auth -> Bool)
-> (Auth -> Auth -> Bool)
-> (Auth -> Auth -> Bool)
-> (Auth -> Auth -> Bool)
-> (Auth -> Auth -> Auth)
-> (Auth -> Auth -> Auth)
-> Ord 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
$cp1Ord :: Eq Auth
Ord, (forall x. Auth -> Rep Auth x)
-> (forall x. Rep Auth x -> Auth) -> Generic Auth
forall x. Rep Auth x -> Auth
forall x. Auth -> Rep Auth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Auth x -> Auth
$cfrom :: forall x. Auth -> Rep Auth x
Generic)

instance NFData Auth where rnf :: Auth -> ()
rnf = Auth -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary Auth
instance Hashable Auth

-- | A type class for different authentication methods
--
-- Note the '()' intance, which doee nothing, i.e. is unauthenticated.
class AuthMethod a where
    -- | Custom API endpoint without trailing slash
    endpoint       :: a -> Maybe Text
    -- | A function which sets authorisation on an HTTP request
    setAuthRequest :: a -> HTTP.Request -> HTTP.Request

instance AuthMethod () where
    endpoint :: () -> Maybe Text
endpoint ()
_ = Maybe Text
forall a. Maybe a
Nothing
    setAuthRequest :: () -> Request -> Request
setAuthRequest ()
_ = Request -> Request
forall a. a -> a
id

instance AuthMethod Auth where
    endpoint :: Auth -> Maybe Text
endpoint (BasicAuth ByteString
_ ByteString
_)       = Maybe Text
forall a. Maybe a
Nothing
    endpoint (OAuth ByteString
_)             = Maybe Text
forall a. Maybe a
Nothing
    endpoint (EnterpriseOAuth Text
e ByteString
_) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
e

    setAuthRequest :: Auth -> Request -> Request
setAuthRequest (BasicAuth ByteString
u ByteString
p)       = ByteString -> ByteString -> Request -> Request
HTTP.applyBasicAuth ByteString
u ByteString
p
    setAuthRequest (OAuth ByteString
t)             = ByteString -> Request -> Request
setAuthHeader (ByteString -> Request -> Request)
-> ByteString -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString
"token " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
t
    setAuthRequest (EnterpriseOAuth Text
_ ByteString
t) = ByteString -> Request -> Request
setAuthHeader (ByteString -> Request -> Request)
-> ByteString -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString
"token " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
t

setAuthHeader :: BS.ByteString -> HTTP.Request -> HTTP.Request
setAuthHeader :: ByteString -> Request -> Request
setAuthHeader ByteString
auth Request
req =
    Request
req { requestHeaders :: RequestHeaders
HTTP.requestHeaders = (HeaderName
"Authorization", ByteString
auth) (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Request -> RequestHeaders
HTTP.requestHeaders Request
req }