{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_HADDOCK -ignore-exports #-}

-- | A simple OAuth2 Haskell binding.  (This is supposed to be
-- independent of the http client used.)
module Network.OAuth.OAuth2.Internal where

import Control.Applicative
import Control.Arrow (second)
import Control.Monad.Catch
import Data.Aeson
import Data.Aeson.Types (Parser, explicitParseFieldMaybe)
import Data.Binary (Binary)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Default
import Data.Maybe
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding
import GHC.Generics
import Lens.Micro
import Lens.Micro.Extras
import Network.HTTP.Conduit as C
import qualified Network.HTTP.Types as H
import qualified Network.HTTP.Types as HT
import URI.ByteString
import URI.ByteString.Aeson ()
import URI.ByteString.QQ

--------------------------------------------------

-- * Data Types

--------------------------------------------------

-- | Query Parameter Representation
data OAuth2 = OAuth2
  { OAuth2 -> Text
oauth2ClientId :: Text,
    OAuth2 -> Text
oauth2ClientSecret :: Text,
    OAuth2 -> URIRef Absolute
oauth2AuthorizeEndpoint :: URIRef Absolute,
    OAuth2 -> URIRef Absolute
oauth2TokenEndpoint :: URIRef Absolute,
    OAuth2 -> URIRef Absolute
oauth2RedirectUri :: URIRef Absolute
  }
  deriving (Int -> OAuth2 -> ShowS
[OAuth2] -> ShowS
OAuth2 -> String
(Int -> OAuth2 -> ShowS)
-> (OAuth2 -> String) -> ([OAuth2] -> ShowS) -> Show OAuth2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2] -> ShowS
$cshowList :: [OAuth2] -> ShowS
show :: OAuth2 -> String
$cshow :: OAuth2 -> String
showsPrec :: Int -> OAuth2 -> ShowS
$cshowsPrec :: Int -> OAuth2 -> ShowS
Show, OAuth2 -> OAuth2 -> Bool
(OAuth2 -> OAuth2 -> Bool)
-> (OAuth2 -> OAuth2 -> Bool) -> Eq OAuth2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2 -> OAuth2 -> Bool
$c/= :: OAuth2 -> OAuth2 -> Bool
== :: OAuth2 -> OAuth2 -> Bool
$c== :: OAuth2 -> OAuth2 -> Bool
Eq)

instance Default OAuth2 where
  def :: OAuth2
def =
    OAuth2 :: Text
-> Text
-> URIRef Absolute
-> URIRef Absolute
-> URIRef Absolute
-> OAuth2
OAuth2
      { oauth2ClientId :: Text
oauth2ClientId = Text
"",
        oauth2ClientSecret :: Text
oauth2ClientSecret = Text
"",
        oauth2AuthorizeEndpoint :: URIRef Absolute
oauth2AuthorizeEndpoint = [uri|https://www.example.com/|],
        oauth2TokenEndpoint :: URIRef Absolute
oauth2TokenEndpoint = [uri|https://www.example.com/|],
        oauth2RedirectUri :: URIRef Absolute
oauth2RedirectUri = [uri|https://www.example.com/|]
      }

newtype AccessToken = AccessToken {AccessToken -> Text
atoken :: Text} deriving (Get AccessToken
[AccessToken] -> Put
AccessToken -> Put
(AccessToken -> Put)
-> Get AccessToken -> ([AccessToken] -> Put) -> Binary AccessToken
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [AccessToken] -> Put
$cputList :: [AccessToken] -> Put
get :: Get AccessToken
$cget :: Get AccessToken
put :: AccessToken -> Put
$cput :: AccessToken -> Put
Binary, AccessToken -> AccessToken -> Bool
(AccessToken -> AccessToken -> Bool)
-> (AccessToken -> AccessToken -> Bool) -> Eq AccessToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessToken -> AccessToken -> Bool
$c/= :: AccessToken -> AccessToken -> Bool
== :: AccessToken -> AccessToken -> Bool
$c== :: AccessToken -> AccessToken -> Bool
Eq, Int -> AccessToken -> ShowS
[AccessToken] -> ShowS
AccessToken -> String
(Int -> AccessToken -> ShowS)
-> (AccessToken -> String)
-> ([AccessToken] -> ShowS)
-> Show AccessToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessToken] -> ShowS
$cshowList :: [AccessToken] -> ShowS
show :: AccessToken -> String
$cshow :: AccessToken -> String
showsPrec :: Int -> AccessToken -> ShowS
$cshowsPrec :: Int -> AccessToken -> ShowS
Show, Value -> Parser [AccessToken]
Value -> Parser AccessToken
(Value -> Parser AccessToken)
-> (Value -> Parser [AccessToken]) -> FromJSON AccessToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AccessToken]
$cparseJSONList :: Value -> Parser [AccessToken]
parseJSON :: Value -> Parser AccessToken
$cparseJSON :: Value -> Parser AccessToken
FromJSON, [AccessToken] -> Encoding
[AccessToken] -> Value
AccessToken -> Encoding
AccessToken -> Value
(AccessToken -> Value)
-> (AccessToken -> Encoding)
-> ([AccessToken] -> Value)
-> ([AccessToken] -> Encoding)
-> ToJSON AccessToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AccessToken] -> Encoding
$ctoEncodingList :: [AccessToken] -> Encoding
toJSONList :: [AccessToken] -> Value
$ctoJSONList :: [AccessToken] -> Value
toEncoding :: AccessToken -> Encoding
$ctoEncoding :: AccessToken -> Encoding
toJSON :: AccessToken -> Value
$ctoJSON :: AccessToken -> Value
ToJSON)

newtype RefreshToken = RefreshToken {RefreshToken -> Text
rtoken :: Text} deriving (Get RefreshToken
[RefreshToken] -> Put
RefreshToken -> Put
(RefreshToken -> Put)
-> Get RefreshToken
-> ([RefreshToken] -> Put)
-> Binary RefreshToken
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [RefreshToken] -> Put
$cputList :: [RefreshToken] -> Put
get :: Get RefreshToken
$cget :: Get RefreshToken
put :: RefreshToken -> Put
$cput :: RefreshToken -> Put
Binary, RefreshToken -> RefreshToken -> Bool
(RefreshToken -> RefreshToken -> Bool)
-> (RefreshToken -> RefreshToken -> Bool) -> Eq RefreshToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefreshToken -> RefreshToken -> Bool
$c/= :: RefreshToken -> RefreshToken -> Bool
== :: RefreshToken -> RefreshToken -> Bool
$c== :: RefreshToken -> RefreshToken -> Bool
Eq, Int -> RefreshToken -> ShowS
[RefreshToken] -> ShowS
RefreshToken -> String
(Int -> RefreshToken -> ShowS)
-> (RefreshToken -> String)
-> ([RefreshToken] -> ShowS)
-> Show RefreshToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RefreshToken] -> ShowS
$cshowList :: [RefreshToken] -> ShowS
show :: RefreshToken -> String
$cshow :: RefreshToken -> String
showsPrec :: Int -> RefreshToken -> ShowS
$cshowsPrec :: Int -> RefreshToken -> ShowS
Show, Value -> Parser [RefreshToken]
Value -> Parser RefreshToken
(Value -> Parser RefreshToken)
-> (Value -> Parser [RefreshToken]) -> FromJSON RefreshToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RefreshToken]
$cparseJSONList :: Value -> Parser [RefreshToken]
parseJSON :: Value -> Parser RefreshToken
$cparseJSON :: Value -> Parser RefreshToken
FromJSON, [RefreshToken] -> Encoding
[RefreshToken] -> Value
RefreshToken -> Encoding
RefreshToken -> Value
(RefreshToken -> Value)
-> (RefreshToken -> Encoding)
-> ([RefreshToken] -> Value)
-> ([RefreshToken] -> Encoding)
-> ToJSON RefreshToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RefreshToken] -> Encoding
$ctoEncodingList :: [RefreshToken] -> Encoding
toJSONList :: [RefreshToken] -> Value
$ctoJSONList :: [RefreshToken] -> Value
toEncoding :: RefreshToken -> Encoding
$ctoEncoding :: RefreshToken -> Encoding
toJSON :: RefreshToken -> Value
$ctoJSON :: RefreshToken -> Value
ToJSON)

newtype IdToken = IdToken {IdToken -> Text
idtoken :: Text} deriving (Get IdToken
[IdToken] -> Put
IdToken -> Put
(IdToken -> Put)
-> Get IdToken -> ([IdToken] -> Put) -> Binary IdToken
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [IdToken] -> Put
$cputList :: [IdToken] -> Put
get :: Get IdToken
$cget :: Get IdToken
put :: IdToken -> Put
$cput :: IdToken -> Put
Binary, IdToken -> IdToken -> Bool
(IdToken -> IdToken -> Bool)
-> (IdToken -> IdToken -> Bool) -> Eq IdToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdToken -> IdToken -> Bool
$c/= :: IdToken -> IdToken -> Bool
== :: IdToken -> IdToken -> Bool
$c== :: IdToken -> IdToken -> Bool
Eq, Int -> IdToken -> ShowS
[IdToken] -> ShowS
IdToken -> String
(Int -> IdToken -> ShowS)
-> (IdToken -> String) -> ([IdToken] -> ShowS) -> Show IdToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdToken] -> ShowS
$cshowList :: [IdToken] -> ShowS
show :: IdToken -> String
$cshow :: IdToken -> String
showsPrec :: Int -> IdToken -> ShowS
$cshowsPrec :: Int -> IdToken -> ShowS
Show, Value -> Parser [IdToken]
Value -> Parser IdToken
(Value -> Parser IdToken)
-> (Value -> Parser [IdToken]) -> FromJSON IdToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [IdToken]
$cparseJSONList :: Value -> Parser [IdToken]
parseJSON :: Value -> Parser IdToken
$cparseJSON :: Value -> Parser IdToken
FromJSON, [IdToken] -> Encoding
[IdToken] -> Value
IdToken -> Encoding
IdToken -> Value
(IdToken -> Value)
-> (IdToken -> Encoding)
-> ([IdToken] -> Value)
-> ([IdToken] -> Encoding)
-> ToJSON IdToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [IdToken] -> Encoding
$ctoEncodingList :: [IdToken] -> Encoding
toJSONList :: [IdToken] -> Value
$ctoJSONList :: [IdToken] -> Value
toEncoding :: IdToken -> Encoding
$ctoEncoding :: IdToken -> Encoding
toJSON :: IdToken -> Value
$ctoJSON :: IdToken -> Value
ToJSON)

newtype ExchangeToken = ExchangeToken {ExchangeToken -> Text
extoken :: Text} deriving (Int -> ExchangeToken -> ShowS
[ExchangeToken] -> ShowS
ExchangeToken -> String
(Int -> ExchangeToken -> ShowS)
-> (ExchangeToken -> String)
-> ([ExchangeToken] -> ShowS)
-> Show ExchangeToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExchangeToken] -> ShowS
$cshowList :: [ExchangeToken] -> ShowS
show :: ExchangeToken -> String
$cshow :: ExchangeToken -> String
showsPrec :: Int -> ExchangeToken -> ShowS
$cshowsPrec :: Int -> ExchangeToken -> ShowS
Show, Value -> Parser [ExchangeToken]
Value -> Parser ExchangeToken
(Value -> Parser ExchangeToken)
-> (Value -> Parser [ExchangeToken]) -> FromJSON ExchangeToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ExchangeToken]
$cparseJSONList :: Value -> Parser [ExchangeToken]
parseJSON :: Value -> Parser ExchangeToken
$cparseJSON :: Value -> Parser ExchangeToken
FromJSON, [ExchangeToken] -> Encoding
[ExchangeToken] -> Value
ExchangeToken -> Encoding
ExchangeToken -> Value
(ExchangeToken -> Value)
-> (ExchangeToken -> Encoding)
-> ([ExchangeToken] -> Value)
-> ([ExchangeToken] -> Encoding)
-> ToJSON ExchangeToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ExchangeToken] -> Encoding
$ctoEncodingList :: [ExchangeToken] -> Encoding
toJSONList :: [ExchangeToken] -> Value
$ctoJSONList :: [ExchangeToken] -> Value
toEncoding :: ExchangeToken -> Encoding
$ctoEncoding :: ExchangeToken -> Encoding
toJSON :: ExchangeToken -> Value
$ctoJSON :: ExchangeToken -> Value
ToJSON)

-- | The gained Access Token. Use @Data.Aeson.decode@ to
-- decode string to @AccessToken@.  The @refreshToken@ is
-- special in some cases,
-- e.g. <https://developers.google.com/accounts/docs/OAuth2>
data OAuth2Token = OAuth2Token
  { OAuth2Token -> AccessToken
accessToken :: AccessToken,
    OAuth2Token -> Maybe RefreshToken
refreshToken :: Maybe RefreshToken,
    OAuth2Token -> Maybe Int
expiresIn :: Maybe Int,
    OAuth2Token -> Maybe Text
tokenType :: Maybe Text,
    OAuth2Token -> Maybe IdToken
idToken :: Maybe IdToken
  }
  deriving (OAuth2Token -> OAuth2Token -> Bool
(OAuth2Token -> OAuth2Token -> Bool)
-> (OAuth2Token -> OAuth2Token -> Bool) -> Eq OAuth2Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2Token -> OAuth2Token -> Bool
$c/= :: OAuth2Token -> OAuth2Token -> Bool
== :: OAuth2Token -> OAuth2Token -> Bool
$c== :: OAuth2Token -> OAuth2Token -> Bool
Eq, Int -> OAuth2Token -> ShowS
[OAuth2Token] -> ShowS
OAuth2Token -> String
(Int -> OAuth2Token -> ShowS)
-> (OAuth2Token -> String)
-> ([OAuth2Token] -> ShowS)
-> Show OAuth2Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2Token] -> ShowS
$cshowList :: [OAuth2Token] -> ShowS
show :: OAuth2Token -> String
$cshow :: OAuth2Token -> String
showsPrec :: Int -> OAuth2Token -> ShowS
$cshowsPrec :: Int -> OAuth2Token -> ShowS
Show, (forall x. OAuth2Token -> Rep OAuth2Token x)
-> (forall x. Rep OAuth2Token x -> OAuth2Token)
-> Generic OAuth2Token
forall x. Rep OAuth2Token x -> OAuth2Token
forall x. OAuth2Token -> Rep OAuth2Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OAuth2Token x -> OAuth2Token
$cfrom :: forall x. OAuth2Token -> Rep OAuth2Token x
Generic)

instance Binary OAuth2Token

parseIntFlexible :: Value -> Parser Int
parseIntFlexible :: Value -> Parser Int
parseIntFlexible (String Text
s) = Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Parser Int) -> (String -> Int) -> String -> Parser Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read (String -> Parser Int) -> String -> Parser Int
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
s
parseIntFlexible Value
v = Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

-- | Parse JSON data into 'OAuth2Token'
instance FromJSON OAuth2Token where
  parseJSON :: Value -> Parser OAuth2Token
parseJSON = String
-> (Object -> Parser OAuth2Token) -> Value -> Parser OAuth2Token
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"OAuth2Token" ((Object -> Parser OAuth2Token) -> Value -> Parser OAuth2Token)
-> (Object -> Parser OAuth2Token) -> Value -> Parser OAuth2Token
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    AccessToken
-> Maybe RefreshToken
-> Maybe Int
-> Maybe Text
-> Maybe IdToken
-> OAuth2Token
OAuth2Token
      (AccessToken
 -> Maybe RefreshToken
 -> Maybe Int
 -> Maybe Text
 -> Maybe IdToken
 -> OAuth2Token)
-> Parser AccessToken
-> Parser
     (Maybe RefreshToken
      -> Maybe Int -> Maybe Text -> Maybe IdToken -> OAuth2Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser AccessToken
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"access_token"
      Parser
  (Maybe RefreshToken
   -> Maybe Int -> Maybe Text -> Maybe IdToken -> OAuth2Token)
-> Parser (Maybe RefreshToken)
-> Parser (Maybe Int -> Maybe Text -> Maybe IdToken -> OAuth2Token)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe RefreshToken)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refresh_token"
      Parser (Maybe Int -> Maybe Text -> Maybe IdToken -> OAuth2Token)
-> Parser (Maybe Int)
-> Parser (Maybe Text -> Maybe IdToken -> OAuth2Token)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser Int) -> Object -> Key -> Parser (Maybe Int)
forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe Value -> Parser Int
parseIntFlexible Object
v Key
"expires_in"
      Parser (Maybe Text -> Maybe IdToken -> OAuth2Token)
-> Parser (Maybe Text) -> Parser (Maybe IdToken -> OAuth2Token)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token_type"
      Parser (Maybe IdToken -> OAuth2Token)
-> Parser (Maybe IdToken) -> Parser OAuth2Token
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe IdToken)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id_token"

instance ToJSON OAuth2Token where
  toJSON :: OAuth2Token -> Value
toJSON = Options -> OAuth2Token -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = Char -> ShowS
camelTo2 Char
'_'}
  toEncoding :: OAuth2Token -> Encoding
toEncoding = Options -> OAuth2Token -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = Char -> ShowS
camelTo2 Char
'_'}

data OAuth2Error a = OAuth2Error
  { OAuth2Error a -> Either Text a
error :: Either Text a,
    OAuth2Error a -> Maybe Text
errorDescription :: Maybe Text,
    OAuth2Error a -> Maybe (URIRef Absolute)
errorUri :: Maybe (URIRef Absolute)
  }
  deriving (Int -> OAuth2Error a -> ShowS
[OAuth2Error a] -> ShowS
OAuth2Error a -> String
(Int -> OAuth2Error a -> ShowS)
-> (OAuth2Error a -> String)
-> ([OAuth2Error a] -> ShowS)
-> Show (OAuth2Error a)
forall a. Show a => Int -> OAuth2Error a -> ShowS
forall a. Show a => [OAuth2Error a] -> ShowS
forall a. Show a => OAuth2Error a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2Error a] -> ShowS
$cshowList :: forall a. Show a => [OAuth2Error a] -> ShowS
show :: OAuth2Error a -> String
$cshow :: forall a. Show a => OAuth2Error a -> String
showsPrec :: Int -> OAuth2Error a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> OAuth2Error a -> ShowS
Show, OAuth2Error a -> OAuth2Error a -> Bool
(OAuth2Error a -> OAuth2Error a -> Bool)
-> (OAuth2Error a -> OAuth2Error a -> Bool) -> Eq (OAuth2Error a)
forall a. Eq a => OAuth2Error a -> OAuth2Error a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2Error a -> OAuth2Error a -> Bool
$c/= :: forall a. Eq a => OAuth2Error a -> OAuth2Error a -> Bool
== :: OAuth2Error a -> OAuth2Error a -> Bool
$c== :: forall a. Eq a => OAuth2Error a -> OAuth2Error a -> Bool
Eq, (forall x. OAuth2Error a -> Rep (OAuth2Error a) x)
-> (forall x. Rep (OAuth2Error a) x -> OAuth2Error a)
-> Generic (OAuth2Error a)
forall x. Rep (OAuth2Error a) x -> OAuth2Error a
forall x. OAuth2Error a -> Rep (OAuth2Error a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (OAuth2Error a) x -> OAuth2Error a
forall a x. OAuth2Error a -> Rep (OAuth2Error a) x
$cto :: forall a x. Rep (OAuth2Error a) x -> OAuth2Error a
$cfrom :: forall a x. OAuth2Error a -> Rep (OAuth2Error a) x
Generic)

instance FromJSON err => FromJSON (OAuth2Error err) where
  parseJSON :: Value -> Parser (OAuth2Error err)
parseJSON (Object Object
a) =
    do
      Either Text err
err <- (Object
a Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error") Parser Value
-> (Value -> Parser (Either Text err)) -> Parser (Either Text err)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Value
str -> err -> Either Text err
forall a b. b -> Either a b
Right (err -> Either Text err) -> Parser err -> Parser (Either Text err)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser err
forall a. FromJSON a => Value -> Parser a
parseJSON Value
str Parser (Either Text err)
-> Parser (Either Text err) -> Parser (Either Text err)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Either Text err
forall a b. a -> Either a b
Left (Text -> Either Text err)
-> Parser Text -> Parser (Either Text err)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
str)
      Maybe Text
desc <- Object
a Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_description"
      Maybe (URIRef Absolute)
errorUri <- Object
a Object -> Key -> Parser (Maybe (URIRef Absolute))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_uri"
      OAuth2Error err -> Parser (OAuth2Error err)
forall (m :: * -> *) a. Monad m => a -> m a
return (OAuth2Error err -> Parser (OAuth2Error err))
-> OAuth2Error err -> Parser (OAuth2Error err)
forall a b. (a -> b) -> a -> b
$ Either Text err
-> Maybe Text -> Maybe (URIRef Absolute) -> OAuth2Error err
forall a.
Either Text a
-> Maybe Text -> Maybe (URIRef Absolute) -> OAuth2Error a
OAuth2Error Either Text err
err Maybe Text
desc Maybe (URIRef Absolute)
errorUri
  parseJSON Value
_ = String -> Parser (OAuth2Error err)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected an object"

instance ToJSON err => ToJSON (OAuth2Error err) where
  toJSON :: OAuth2Error err -> Value
toJSON = Options -> OAuth2Error err -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {constructorTagModifier :: ShowS
constructorTagModifier = Char -> ShowS
camelTo2 Char
'_', allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True}
  toEncoding :: OAuth2Error err -> Encoding
toEncoding = Options -> OAuth2Error err -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {constructorTagModifier :: ShowS
constructorTagModifier = Char -> ShowS
camelTo2 Char
'_', allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True}

parseOAuth2Error :: FromJSON err => BSL.ByteString -> OAuth2Error err
parseOAuth2Error :: ByteString -> OAuth2Error err
parseOAuth2Error ByteString
string =
  (String -> OAuth2Error err)
-> (OAuth2Error err -> OAuth2Error err)
-> Either String (OAuth2Error err)
-> OAuth2Error err
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> String -> OAuth2Error err
forall err. ByteString -> String -> OAuth2Error err
mkDecodeOAuth2Error ByteString
string) OAuth2Error err -> OAuth2Error err
forall a. a -> a
id (ByteString -> Either String (OAuth2Error err)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
string)

mkDecodeOAuth2Error :: BSL.ByteString -> String -> OAuth2Error err
mkDecodeOAuth2Error :: ByteString -> String -> OAuth2Error err
mkDecodeOAuth2Error ByteString
response String
err =
  Either Text err
-> Maybe Text -> Maybe (URIRef Absolute) -> OAuth2Error err
forall a.
Either Text a
-> Maybe Text -> Maybe (URIRef Absolute) -> OAuth2Error a
OAuth2Error
    (Text -> Either Text err
forall a b. a -> Either a b
Left Text
"Decode error")
    (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n Original Response:\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show (ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict ByteString
response))
    Maybe (URIRef Absolute)
forall a. Maybe a
Nothing

data APIAuthenticationMethod
  = -- | Provides in Authorization header
    AuthInRequestHeader
  | -- | Provides in request body
    AuthInRequestBody
  | -- | Provides in request query parameter
    AuthInRequestQuery
  deriving (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
(APIAuthenticationMethod -> APIAuthenticationMethod -> Bool)
-> (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool)
-> Eq APIAuthenticationMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c/= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
== :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c== :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
Eq, Eq APIAuthenticationMethod
Eq APIAuthenticationMethod
-> (APIAuthenticationMethod -> APIAuthenticationMethod -> Ordering)
-> (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool)
-> (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool)
-> (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool)
-> (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool)
-> (APIAuthenticationMethod
    -> APIAuthenticationMethod -> APIAuthenticationMethod)
-> (APIAuthenticationMethod
    -> APIAuthenticationMethod -> APIAuthenticationMethod)
-> Ord APIAuthenticationMethod
APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
APIAuthenticationMethod -> APIAuthenticationMethod -> Ordering
APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
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 :: APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
$cmin :: APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
max :: APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
$cmax :: APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
>= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c>= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
> :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c> :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
<= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c<= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
< :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c< :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
compare :: APIAuthenticationMethod -> APIAuthenticationMethod -> Ordering
$ccompare :: APIAuthenticationMethod -> APIAuthenticationMethod -> Ordering
$cp1Ord :: Eq APIAuthenticationMethod
Ord)

data ClientAuthenticationMethod
  = ClientSecretBasic
  | ClientSecretPost
  deriving (ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
(ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool)
-> (ClientAuthenticationMethod
    -> ClientAuthenticationMethod -> Bool)
-> Eq ClientAuthenticationMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
$c/= :: ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
== :: ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
$c== :: ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
Eq, Eq ClientAuthenticationMethod
Eq ClientAuthenticationMethod
-> (ClientAuthenticationMethod
    -> ClientAuthenticationMethod -> Ordering)
-> (ClientAuthenticationMethod
    -> ClientAuthenticationMethod -> Bool)
-> (ClientAuthenticationMethod
    -> ClientAuthenticationMethod -> Bool)
-> (ClientAuthenticationMethod
    -> ClientAuthenticationMethod -> Bool)
-> (ClientAuthenticationMethod
    -> ClientAuthenticationMethod -> Bool)
-> (ClientAuthenticationMethod
    -> ClientAuthenticationMethod -> ClientAuthenticationMethod)
-> (ClientAuthenticationMethod
    -> ClientAuthenticationMethod -> ClientAuthenticationMethod)
-> Ord ClientAuthenticationMethod
ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
ClientAuthenticationMethod
-> ClientAuthenticationMethod -> Ordering
ClientAuthenticationMethod
-> ClientAuthenticationMethod -> ClientAuthenticationMethod
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 :: ClientAuthenticationMethod
-> ClientAuthenticationMethod -> ClientAuthenticationMethod
$cmin :: ClientAuthenticationMethod
-> ClientAuthenticationMethod -> ClientAuthenticationMethod
max :: ClientAuthenticationMethod
-> ClientAuthenticationMethod -> ClientAuthenticationMethod
$cmax :: ClientAuthenticationMethod
-> ClientAuthenticationMethod -> ClientAuthenticationMethod
>= :: ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
$c>= :: ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
> :: ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
$c> :: ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
<= :: ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
$c<= :: ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
< :: ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
$c< :: ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
compare :: ClientAuthenticationMethod
-> ClientAuthenticationMethod -> Ordering
$ccompare :: ClientAuthenticationMethod
-> ClientAuthenticationMethod -> Ordering
$cp1Ord :: Eq ClientAuthenticationMethod
Ord)

--------------------------------------------------

-- * Types Synonym

--------------------------------------------------

-- | type synonym of post body content
type PostBody = [(BS.ByteString, BS.ByteString)]

type QueryParams = [(BS.ByteString, BS.ByteString)]

--------------------------------------------------

-- * Utilies

--------------------------------------------------

defaultRequestHeaders :: [(HT.HeaderName, BS.ByteString)]
defaultRequestHeaders :: [(HeaderName, ByteString)]
defaultRequestHeaders =
  [ (HeaderName
HT.hUserAgent, ByteString
"hoauth2"),
    (HeaderName
HT.hAccept, ByteString
"application/json")
  ]

appendQueryParams :: [(BS.ByteString, BS.ByteString)] -> URIRef a -> URIRef a
appendQueryParams :: [(ByteString, ByteString)] -> URIRef a -> URIRef a
appendQueryParams [(ByteString, ByteString)]
params =
  ASetter
  (URIRef a)
  (URIRef a)
  [(ByteString, ByteString)]
  [(ByteString, ByteString)]
-> ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> URIRef a
-> URIRef a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Query -> Identity Query) -> URIRef a -> Identity (URIRef a)
forall a. Lens' (URIRef a) Query
queryL ((Query -> Identity Query) -> URIRef a -> Identity (URIRef a))
-> (([(ByteString, ByteString)]
     -> Identity [(ByteString, ByteString)])
    -> Query -> Identity Query)
-> ASetter
     (URIRef a)
     (URIRef a)
     [(ByteString, ByteString)]
     [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(ByteString, ByteString)] -> Identity [(ByteString, ByteString)])
-> Query -> Identity Query
Lens' Query [(ByteString, ByteString)]
queryPairsL) ([(ByteString, ByteString)]
params [(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. [a] -> [a] -> [a]
++)

uriToRequest :: MonadThrow m => URI -> m Request
uriToRequest :: URIRef Absolute -> m Request
uriToRequest URIRef Absolute
auri = do
  Bool
ssl <- case Getting ByteString (URIRef Absolute) ByteString
-> URIRef Absolute -> ByteString
forall a s. Getting a s a -> s -> a
view ((Scheme -> Const ByteString Scheme)
-> URIRef Absolute -> Const ByteString (URIRef Absolute)
Lens' (URIRef Absolute) Scheme
uriSchemeL ((Scheme -> Const ByteString Scheme)
 -> URIRef Absolute -> Const ByteString (URIRef Absolute))
-> ((ByteString -> Const ByteString ByteString)
    -> Scheme -> Const ByteString Scheme)
-> Getting ByteString (URIRef Absolute) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const ByteString ByteString)
-> Scheme -> Const ByteString Scheme
Lens' Scheme ByteString
schemeBSL) URIRef Absolute
auri of
    ByteString
"http" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    ByteString
"https" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    ByteString
s -> HttpException -> m Bool
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (HttpException -> m Bool) -> HttpException -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> String -> HttpException
InvalidUrlException (URIRef Absolute -> String
forall a. Show a => a -> String
show URIRef Absolute
auri) (String
"Invalid scheme: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
s)
  let query :: [(ByteString, Maybe ByteString)]
query = ((ByteString, ByteString) -> (ByteString, Maybe ByteString))
-> [(ByteString, ByteString)] -> [(ByteString, Maybe ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Maybe ByteString)
-> (ByteString, ByteString) -> (ByteString, Maybe ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just) (Getting
  [(ByteString, ByteString)]
  (URIRef Absolute)
  [(ByteString, ByteString)]
-> URIRef Absolute -> [(ByteString, ByteString)]
forall a s. Getting a s a -> s -> a
view ((Query -> Const [(ByteString, ByteString)] Query)
-> URIRef Absolute
-> Const [(ByteString, ByteString)] (URIRef Absolute)
forall a. Lens' (URIRef a) Query
queryL ((Query -> Const [(ByteString, ByteString)] Query)
 -> URIRef Absolute
 -> Const [(ByteString, ByteString)] (URIRef Absolute))
-> (([(ByteString, ByteString)]
     -> Const [(ByteString, ByteString)] [(ByteString, ByteString)])
    -> Query -> Const [(ByteString, ByteString)] Query)
-> Getting
     [(ByteString, ByteString)]
     (URIRef Absolute)
     [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(ByteString, ByteString)]
 -> Const [(ByteString, ByteString)] [(ByteString, ByteString)])
-> Query -> Const [(ByteString, ByteString)] Query
Lens' Query [(ByteString, ByteString)]
queryPairsL) URIRef Absolute
auri)
      hostL :: (ByteString -> Const (First ByteString) ByteString)
-> URIRef a -> Const (First ByteString) (URIRef a)
hostL = (Maybe Authority -> Const (First ByteString) (Maybe Authority))
-> URIRef a -> Const (First ByteString) (URIRef a)
forall a. Lens' (URIRef a) (Maybe Authority)
authorityL ((Maybe Authority -> Const (First ByteString) (Maybe Authority))
 -> URIRef a -> Const (First ByteString) (URIRef a))
-> ((ByteString -> Const (First ByteString) ByteString)
    -> Maybe Authority -> Const (First ByteString) (Maybe Authority))
-> (ByteString -> Const (First ByteString) ByteString)
-> URIRef a
-> Const (First ByteString) (URIRef a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Authority -> Const (First ByteString) Authority)
-> Maybe Authority -> Const (First ByteString) (Maybe Authority)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just ((Authority -> Const (First ByteString) Authority)
 -> Maybe Authority -> Const (First ByteString) (Maybe Authority))
-> ((ByteString -> Const (First ByteString) ByteString)
    -> Authority -> Const (First ByteString) Authority)
-> (ByteString -> Const (First ByteString) ByteString)
-> Maybe Authority
-> Const (First ByteString) (Maybe Authority)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Host -> Const (First ByteString) Host)
-> Authority -> Const (First ByteString) Authority
Lens' Authority Host
authorityHostL ((Host -> Const (First ByteString) Host)
 -> Authority -> Const (First ByteString) Authority)
-> ((ByteString -> Const (First ByteString) ByteString)
    -> Host -> Const (First ByteString) Host)
-> (ByteString -> Const (First ByteString) ByteString)
-> Authority
-> Const (First ByteString) Authority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const (First ByteString) ByteString)
-> Host -> Const (First ByteString) Host
Lens' Host ByteString
hostBSL
      portL :: (Int -> Const (First Int) Int)
-> URIRef a -> Const (First Int) (URIRef a)
portL = (Maybe Authority -> Const (First Int) (Maybe Authority))
-> URIRef a -> Const (First Int) (URIRef a)
forall a. Lens' (URIRef a) (Maybe Authority)
authorityL ((Maybe Authority -> Const (First Int) (Maybe Authority))
 -> URIRef a -> Const (First Int) (URIRef a))
-> ((Int -> Const (First Int) Int)
    -> Maybe Authority -> Const (First Int) (Maybe Authority))
-> (Int -> Const (First Int) Int)
-> URIRef a
-> Const (First Int) (URIRef a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Authority -> Const (First Int) Authority)
-> Maybe Authority -> Const (First Int) (Maybe Authority)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just ((Authority -> Const (First Int) Authority)
 -> Maybe Authority -> Const (First Int) (Maybe Authority))
-> ((Int -> Const (First Int) Int)
    -> Authority -> Const (First Int) Authority)
-> (Int -> Const (First Int) Int)
-> Maybe Authority
-> Const (First Int) (Maybe Authority)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Port -> Const (First Int) (Maybe Port))
-> Authority -> Const (First Int) Authority
Lens' Authority (Maybe Port)
authorityPortL ((Maybe Port -> Const (First Int) (Maybe Port))
 -> Authority -> Const (First Int) Authority)
-> ((Int -> Const (First Int) Int)
    -> Maybe Port -> Const (First Int) (Maybe Port))
-> (Int -> Const (First Int) Int)
-> Authority
-> Const (First Int) Authority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Port -> Const (First Int) Port)
-> Maybe Port -> Const (First Int) (Maybe Port)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just ((Port -> Const (First Int) Port)
 -> Maybe Port -> Const (First Int) (Maybe Port))
-> ((Int -> Const (First Int) Int)
    -> Port -> Const (First Int) Port)
-> (Int -> Const (First Int) Int)
-> Maybe Port
-> Const (First Int) (Maybe Port)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const (First Int) Int) -> Port -> Const (First Int) Port
Lens' Port Int
portNumberL
      defaultPort :: Int
defaultPort = (if Bool
ssl then Int
443 else Int
80) :: Int

      req :: Request
req =
        [(ByteString, Maybe ByteString)] -> Request -> Request
setQueryString [(ByteString, Maybe ByteString)]
query (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$
          Request
defaultRequest
            { secure :: Bool
secure = Bool
ssl,
              path :: ByteString
path = Getting ByteString (URIRef Absolute) ByteString
-> URIRef Absolute -> ByteString
forall a s. Getting a s a -> s -> a
view Getting ByteString (URIRef Absolute) ByteString
forall a. Lens' (URIRef a) ByteString
pathL URIRef Absolute
auri
            }
      req2 :: Request
req2 = (ASetter Request Request ByteString ByteString
-> (ByteString -> ByteString) -> Request -> Request
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Request Request ByteString ByteString
Lens' Request ByteString
hostLens ((ByteString -> ByteString) -> Request -> Request)
-> (URIRef Absolute -> ByteString -> ByteString)
-> URIRef Absolute
-> Request
-> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> (ByteString -> ByteString -> ByteString)
-> Maybe ByteString
-> ByteString
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString -> ByteString
forall a. a -> a
id ByteString -> ByteString -> ByteString
forall a b. a -> b -> a
const (Maybe ByteString -> ByteString -> ByteString)
-> (URIRef Absolute -> Maybe ByteString)
-> URIRef Absolute
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First ByteString) (URIRef Absolute) ByteString
-> URIRef Absolute -> Maybe ByteString
forall a s. Getting (First a) s a -> s -> Maybe a
preview Getting (First ByteString) (URIRef Absolute) ByteString
forall a.
(ByteString -> Const (First ByteString) ByteString)
-> URIRef a -> Const (First ByteString) (URIRef a)
hostL) URIRef Absolute
auri Request
req
      req3 :: Request
req3 = (ASetter Request Request Int Int
-> (Int -> Int) -> Request -> Request
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Request Request Int Int
Lens' Request Int
portLens ((Int -> Int) -> Request -> Request)
-> (URIRef Absolute -> Int -> Int)
-> URIRef Absolute
-> Request
-> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a b. a -> b -> a
const (Int -> Int -> Int)
-> (Maybe Int -> Int) -> Maybe Int -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defaultPort) (Maybe Int -> Int -> Int)
-> (URIRef Absolute -> Maybe Int) -> URIRef Absolute -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Int) (URIRef Absolute) Int
-> URIRef Absolute -> Maybe Int
forall a s. Getting (First a) s a -> s -> Maybe a
preview Getting (First Int) (URIRef Absolute) Int
forall a.
(Int -> Const (First Int) Int)
-> URIRef a -> Const (First Int) (URIRef a)
portL) URIRef Absolute
auri Request
req2
  Request -> m Request
forall (m :: * -> *) a. Monad m => a -> m a
return Request
req3

requestToUri :: Request -> URI
requestToUri :: Request -> URIRef Absolute
requestToUri Request
req =
  Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URIRef Absolute
URI
    ( ByteString -> Scheme
Scheme
        ( if Request -> Bool
secure Request
req
            then ByteString
"https"
            else ByteString
"http"
        )
    )
    (Authority -> Maybe Authority
forall a. a -> Maybe a
Just (Maybe UserInfo -> Host -> Maybe Port -> Authority
Authority Maybe UserInfo
forall a. Maybe a
Nothing (ByteString -> Host
Host (ByteString -> Host) -> ByteString -> Host
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
host Request
req) (Port -> Maybe Port
forall a. a -> Maybe a
Just (Port -> Maybe Port) -> Port -> Maybe Port
forall a b. (a -> b) -> a -> b
$ Int -> Port
Port (Int -> Port) -> Int -> Port
forall a b. (a -> b) -> a -> b
$ Request -> Int
port Request
req)))
    (Request -> ByteString
path Request
req)
    ([(ByteString, ByteString)] -> Query
Query ([(ByteString, ByteString)] -> Query)
-> [(ByteString, ByteString)] -> Query
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, ByteString)]
H.parseSimpleQuery (ByteString -> [(ByteString, ByteString)])
-> ByteString -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
req)
    Maybe ByteString
forall a. Maybe a
Nothing

hostLens :: Lens' Request BS.ByteString
hostLens :: (ByteString -> f ByteString) -> Request -> f Request
hostLens ByteString -> f ByteString
f Request
req = ByteString -> f ByteString
f (Request -> ByteString
C.host Request
req) f ByteString -> (ByteString -> Request) -> f Request
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ByteString
h' -> Request
req {host :: ByteString
C.host = ByteString
h'}
{-# INLINE hostLens #-}

portLens :: Lens' Request Int
portLens :: (Int -> f Int) -> Request -> f Request
portLens Int -> f Int
f Request
req = Int -> f Int
f (Request -> Int
C.port Request
req) f Int -> (Int -> Request) -> f Request
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
p' -> Request
req {port :: Int
C.port = Int
p'}
{-# INLINE portLens #-}