{-# LANGUAGE TemplateHaskell #-}

-- | Copyright: (c) 2021 The closed eye of love
-- SPDX-License-Identifier: BSD-3-Clause
-- Maintainer: Poscat <poscat@mail.poscat.moe>, berberman <berberman@yandex.com>
-- Stability: alpha
-- Portability: portable
-- Authentication pixiv API. Users should not use logics in this module directly,
-- since "Web.Pixiv.Types.PixivT" takes over token management, providing user friendly operations.
module Web.Pixiv.Auth
  ( Token (..),
    Credential (..),
    OAuth2Token (..),
    OAuth2Error (..),
    OAuth2Result (..),
    Errors (..),
    auth,
    auth',
  )
where

import Control.Applicative ((<|>))
import Control.Exception.Base
import Crypto.Hash.MD5 (hash)
import Data.Aeson
import Data.Aeson.TH
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as C
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Time (defaultTimeLocale, formatTime, getCurrentTime)
import Network.HTTP.Client
import Network.HTTP.Client.MultipartFormData (PartM, formDataBody, partBS)
import Web.Pixiv.TH

clientId :: ByteString
clientId :: ByteString
clientId = ByteString
"MOBrBDS8blbauoSck0ZfDbtuzpyT"

clientSecret :: ByteString
clientSecret :: ByteString
clientSecret = ByteString
"lsACyCD94FhDUtGTXi3QzcFE2uU1hqtDaKeqrdwj"

hashSecret :: ByteString
hashSecret :: ByteString
hashSecret = ByteString
"28c1fdd170a5204386cb1313c7077b34f83e4aaf4aa829ce78c231e05b0bae2c"

-- | A wrapped 'Text' represents a token.
newtype Token = Token {Token -> Text
unToken :: Text}
  deriving stock (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, ReadPrec [Token]
ReadPrec Token
Int -> ReadS Token
ReadS [Token]
(Int -> ReadS Token)
-> ReadS [Token]
-> ReadPrec Token
-> ReadPrec [Token]
-> Read Token
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Token]
$creadListPrec :: ReadPrec [Token]
readPrec :: ReadPrec Token
$creadPrec :: ReadPrec Token
readList :: ReadS [Token]
$creadList :: ReadS [Token]
readsPrec :: Int -> ReadS Token
$creadsPrec :: Int -> ReadS Token
Read)

deriveJSON defaultOptions {unwrapUnaryRecords = True} ''Token

instance IsString Token where
  fromString :: String -> Token
fromString = Text -> Token
Token (Text -> Token) -> (String -> Text) -> String -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Authentication credentials for pixiv API.
--
-- Password authentication is no longer supported by pixiv.
-- You may consult <https://github.com/upbit/pixivpy/issues/158> to get the information of how to acquire refresh token.
-- Normally, users are supposed to create value of this data type and then pass it to 'Web.Pixiv.Types.PixivT.runPixivT'.
newtype Credential = RefreshToken
  { Credential -> Token
cr_refreshToken :: Token
  }
  deriving stock (Int -> Credential -> ShowS
[Credential] -> ShowS
Credential -> String
(Int -> Credential -> ShowS)
-> (Credential -> String)
-> ([Credential] -> ShowS)
-> Show Credential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Credential] -> ShowS
$cshowList :: [Credential] -> ShowS
show :: Credential -> String
$cshow :: Credential -> String
showsPrec :: Int -> Credential -> ShowS
$cshowsPrec :: Int -> Credential -> ShowS
Show, Credential -> Credential -> Bool
(Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool) -> Eq Credential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Credential -> Credential -> Bool
$c/= :: Credential -> Credential -> Bool
== :: Credential -> Credential -> Bool
$c== :: Credential -> Credential -> Bool
Eq)

mkAuthParts :: Applicative m => Credential -> [PartM m]
mkAuthParts :: Credential -> [PartM m]
mkAuthParts RefreshToken {Token
cr_refreshToken :: Token
cr_refreshToken :: Credential -> Token
..} =
  [ Text -> ByteString -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"grant_type" ByteString
"refresh_token",
    Text -> ByteString -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"refresh_token" (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (Token -> Text) -> Token -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Text
unToken (Token -> ByteString) -> Token -> ByteString
forall a b. (a -> b) -> a -> b
$ Token
cr_refreshToken)
  ]

-- | Successful result.
data OAuth2Token = OAuth2Token
  { OAuth2Token -> Token
oa_accessToken :: Token,
    OAuth2Token -> Int
oa_expiresIn :: Int,
    OAuth2Token -> Token
oa_refreshToken :: Token
  }
  deriving stock (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, 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, ReadPrec [OAuth2Token]
ReadPrec OAuth2Token
Int -> ReadS OAuth2Token
ReadS [OAuth2Token]
(Int -> ReadS OAuth2Token)
-> ReadS [OAuth2Token]
-> ReadPrec OAuth2Token
-> ReadPrec [OAuth2Token]
-> Read OAuth2Token
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OAuth2Token]
$creadListPrec :: ReadPrec [OAuth2Token]
readPrec :: ReadPrec OAuth2Token
$creadPrec :: ReadPrec OAuth2Token
readList :: ReadS [OAuth2Token]
$creadList :: ReadS [OAuth2Token]
readsPrec :: Int -> ReadS OAuth2Token
$creadsPrec :: Int -> ReadS OAuth2Token
Read)

derivePixivJSON "oa_" ''OAuth2Token

-- | Authentication failure reasons.
data Errors
  = InvalidRequest
  | InvalidClient
  | InvalidGrant
  | UnauthorizedClient
  | UnsupportedGrantType
  | InvalidScope
  deriving stock (Int -> Errors -> ShowS
[Errors] -> ShowS
Errors -> String
(Int -> Errors -> ShowS)
-> (Errors -> String) -> ([Errors] -> ShowS) -> Show Errors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Errors] -> ShowS
$cshowList :: [Errors] -> ShowS
show :: Errors -> String
$cshow :: Errors -> String
showsPrec :: Int -> Errors -> ShowS
$cshowsPrec :: Int -> Errors -> ShowS
Show, Errors -> Errors -> Bool
(Errors -> Errors -> Bool)
-> (Errors -> Errors -> Bool) -> Eq Errors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Errors -> Errors -> Bool
$c/= :: Errors -> Errors -> Bool
== :: Errors -> Errors -> Bool
$c== :: Errors -> Errors -> Bool
Eq, Eq Errors
Eq Errors
-> (Errors -> Errors -> Ordering)
-> (Errors -> Errors -> Bool)
-> (Errors -> Errors -> Bool)
-> (Errors -> Errors -> Bool)
-> (Errors -> Errors -> Bool)
-> (Errors -> Errors -> Errors)
-> (Errors -> Errors -> Errors)
-> Ord Errors
Errors -> Errors -> Bool
Errors -> Errors -> Ordering
Errors -> Errors -> Errors
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 :: Errors -> Errors -> Errors
$cmin :: Errors -> Errors -> Errors
max :: Errors -> Errors -> Errors
$cmax :: Errors -> Errors -> Errors
>= :: Errors -> Errors -> Bool
$c>= :: Errors -> Errors -> Bool
> :: Errors -> Errors -> Bool
$c> :: Errors -> Errors -> Bool
<= :: Errors -> Errors -> Bool
$c<= :: Errors -> Errors -> Bool
< :: Errors -> Errors -> Bool
$c< :: Errors -> Errors -> Bool
compare :: Errors -> Errors -> Ordering
$ccompare :: Errors -> Errors -> Ordering
$cp1Ord :: Eq Errors
Ord, Int -> Errors
Errors -> Int
Errors -> [Errors]
Errors -> Errors
Errors -> Errors -> [Errors]
Errors -> Errors -> Errors -> [Errors]
(Errors -> Errors)
-> (Errors -> Errors)
-> (Int -> Errors)
-> (Errors -> Int)
-> (Errors -> [Errors])
-> (Errors -> Errors -> [Errors])
-> (Errors -> Errors -> [Errors])
-> (Errors -> Errors -> Errors -> [Errors])
-> Enum Errors
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Errors -> Errors -> Errors -> [Errors]
$cenumFromThenTo :: Errors -> Errors -> Errors -> [Errors]
enumFromTo :: Errors -> Errors -> [Errors]
$cenumFromTo :: Errors -> Errors -> [Errors]
enumFromThen :: Errors -> Errors -> [Errors]
$cenumFromThen :: Errors -> Errors -> [Errors]
enumFrom :: Errors -> [Errors]
$cenumFrom :: Errors -> [Errors]
fromEnum :: Errors -> Int
$cfromEnum :: Errors -> Int
toEnum :: Int -> Errors
$ctoEnum :: Int -> Errors
pred :: Errors -> Errors
$cpred :: Errors -> Errors
succ :: Errors -> Errors
$csucc :: Errors -> Errors
Enum, ReadPrec [Errors]
ReadPrec Errors
Int -> ReadS Errors
ReadS [Errors]
(Int -> ReadS Errors)
-> ReadS [Errors]
-> ReadPrec Errors
-> ReadPrec [Errors]
-> Read Errors
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Errors]
$creadListPrec :: ReadPrec [Errors]
readPrec :: ReadPrec Errors
$creadPrec :: ReadPrec Errors
readList :: ReadS [Errors]
$creadList :: ReadS [Errors]
readsPrec :: Int -> ReadS Errors
$creadsPrec :: Int -> ReadS Errors
Read)

deriveEnumJSON' ''Errors

-- | Failed result.
data OAuth2Error = OAuth2Error
  { OAuth2Error -> Errors
oa_error :: Errors,
    OAuth2Error -> Text
oa_message :: Text
  }
  deriving stock (Int -> OAuth2Error -> ShowS
[OAuth2Error] -> ShowS
OAuth2Error -> String
(Int -> OAuth2Error -> ShowS)
-> (OAuth2Error -> String)
-> ([OAuth2Error] -> ShowS)
-> Show OAuth2Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2Error] -> ShowS
$cshowList :: [OAuth2Error] -> ShowS
show :: OAuth2Error -> String
$cshow :: OAuth2Error -> String
showsPrec :: Int -> OAuth2Error -> ShowS
$cshowsPrec :: Int -> OAuth2Error -> ShowS
Show, OAuth2Error -> OAuth2Error -> Bool
(OAuth2Error -> OAuth2Error -> Bool)
-> (OAuth2Error -> OAuth2Error -> Bool) -> Eq OAuth2Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2Error -> OAuth2Error -> Bool
$c/= :: OAuth2Error -> OAuth2Error -> Bool
== :: OAuth2Error -> OAuth2Error -> Bool
$c== :: OAuth2Error -> OAuth2Error -> Bool
Eq, ReadPrec [OAuth2Error]
ReadPrec OAuth2Error
Int -> ReadS OAuth2Error
ReadS [OAuth2Error]
(Int -> ReadS OAuth2Error)
-> ReadS [OAuth2Error]
-> ReadPrec OAuth2Error
-> ReadPrec [OAuth2Error]
-> Read OAuth2Error
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OAuth2Error]
$creadListPrec :: ReadPrec [OAuth2Error]
readPrec :: ReadPrec OAuth2Error
$creadPrec :: ReadPrec OAuth2Error
readList :: ReadS [OAuth2Error]
$creadList :: ReadS [OAuth2Error]
readsPrec :: Int -> ReadS OAuth2Error
$creadsPrec :: Int -> ReadS OAuth2Error
Read)
  deriving anyclass (Show OAuth2Error
Typeable OAuth2Error
Typeable OAuth2Error
-> Show OAuth2Error
-> (OAuth2Error -> SomeException)
-> (SomeException -> Maybe OAuth2Error)
-> (OAuth2Error -> String)
-> Exception OAuth2Error
SomeException -> Maybe OAuth2Error
OAuth2Error -> String
OAuth2Error -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: OAuth2Error -> String
$cdisplayException :: OAuth2Error -> String
fromException :: SomeException -> Maybe OAuth2Error
$cfromException :: SomeException -> Maybe OAuth2Error
toException :: OAuth2Error -> SomeException
$ctoException :: OAuth2Error -> SomeException
$cp2Exception :: Show OAuth2Error
$cp1Exception :: Typeable OAuth2Error
Exception)

instance FromJSON OAuth2Error where
  parseJSON :: Value -> Parser OAuth2Error
parseJSON = String
-> (Object -> Parser OAuth2Error) -> Value -> Parser OAuth2Error
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"oauth2 response" ((Object -> Parser OAuth2Error) -> Value -> Parser OAuth2Error)
-> (Object -> Parser OAuth2Error) -> Value -> Parser OAuth2Error
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Errors
oa_error <- Object
o Object -> Key -> Parser Errors
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"
    Value
errors <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"errors"
    Text
oa_message <- ((Object -> Parser Text) -> Value -> Parser Text)
-> Value -> (Object -> Parser Text) -> Parser Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> (Object -> Parser Text) -> Value -> Parser Text
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"errors") Value
errors ((Object -> Parser Text) -> Parser Text)
-> (Object -> Parser Text) -> Parser Text
forall a b. (a -> b) -> a -> b
$ \Object
o' -> do
      Value
system <- Object
o' Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"system"
      ((Object -> Parser Text) -> Value -> Parser Text)
-> Value -> (Object -> Parser Text) -> Parser Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> (Object -> Parser Text) -> Value -> Parser Text
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"system") Value
system ((Object -> Parser Text) -> Parser Text)
-> (Object -> Parser Text) -> Parser Text
forall a b. (a -> b) -> a -> b
$ \Object
o'' -> do
        Object
o'' Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
    OAuth2Error -> Parser OAuth2Error
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure OAuth2Error :: Errors -> Text -> OAuth2Error
OAuth2Error {Text
Errors
oa_message :: Text
oa_error :: Errors
oa_message :: Text
oa_error :: Errors
..}

-- | Authentication result.
data OAuth2Result
  = AuthSuccess OAuth2Token
  | AuthFailure OAuth2Error
  deriving stock (Int -> OAuth2Result -> ShowS
[OAuth2Result] -> ShowS
OAuth2Result -> String
(Int -> OAuth2Result -> ShowS)
-> (OAuth2Result -> String)
-> ([OAuth2Result] -> ShowS)
-> Show OAuth2Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OAuth2Result] -> ShowS
$cshowList :: [OAuth2Result] -> ShowS
show :: OAuth2Result -> String
$cshow :: OAuth2Result -> String
showsPrec :: Int -> OAuth2Result -> ShowS
$cshowsPrec :: Int -> OAuth2Result -> ShowS
Show, OAuth2Result -> OAuth2Result -> Bool
(OAuth2Result -> OAuth2Result -> Bool)
-> (OAuth2Result -> OAuth2Result -> Bool) -> Eq OAuth2Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OAuth2Result -> OAuth2Result -> Bool
$c/= :: OAuth2Result -> OAuth2Result -> Bool
== :: OAuth2Result -> OAuth2Result -> Bool
$c== :: OAuth2Result -> OAuth2Result -> Bool
Eq)

instance FromJSON OAuth2Result where
  parseJSON :: Value -> Parser OAuth2Result
parseJSON Value
v =
    OAuth2Token -> OAuth2Result
AuthSuccess (OAuth2Token -> OAuth2Result)
-> Parser OAuth2Token -> Parser OAuth2Result
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OAuth2Token
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser OAuth2Result -> Parser OAuth2Result -> Parser OAuth2Result
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> OAuth2Error -> OAuth2Result
AuthFailure (OAuth2Error -> OAuth2Result)
-> Parser OAuth2Error -> Parser OAuth2Result
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OAuth2Error
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

-- | Given a credential, performs a authentication request.
auth :: Manager -> Credential -> IO OAuth2Result
auth :: Manager -> Credential -> IO OAuth2Result
auth Manager
manager Credential
credential = do
  let authUrl :: String
authUrl = String
"https://oauth.secure.pixiv.net/auth/token"
  Request
initReq <- String -> IO Request
forall (m :: Type -> Type). MonadThrow m => String -> m Request
parseRequest String
authUrl
  UTCTime
utcT <- IO UTCTime
getCurrentTime
  let clientTime :: ByteString
clientTime = String -> ByteString
C.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y-%m-%dT%H:%I:%S+00:00" UTCTime
utcT
      clientHash :: ByteString
clientHash = ByteString -> ByteString
B16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
clientTime ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
hashSecret
      headers :: [(HeaderName, ByteString)]
headers =
        [ (HeaderName
"User-Agent", ByteString
"PixivAndroidApp/5.0.64 (Android 6.0)"),
          (HeaderName
"X-Client-Time", ByteString
clientTime),
          (HeaderName
"X-Client-Hash", ByteString
clientHash)
        ]
      req :: Request
req = Request
initReq {requestHeaders :: [(HeaderName, ByteString)]
requestHeaders = [(HeaderName, ByteString)]
headers}
      parts :: [PartM IO]
parts =
        [ Text -> ByteString -> PartM IO
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"client_id" ByteString
clientId,
          Text -> ByteString -> PartM IO
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"client_secret" ByteString
clientSecret,
          Text -> ByteString -> PartM IO
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"get_secure_url" ByteString
"1"
        ]
          [PartM IO] -> [PartM IO] -> [PartM IO]
forall a. [a] -> [a] -> [a]
++ Credential -> [PartM IO]
forall (m :: Type -> Type).
Applicative m =>
Credential -> [PartM m]
mkAuthParts Credential
credential
  Request
finalReq <- [PartM IO] -> Request -> IO Request
forall (m :: Type -> Type).
MonadIO m =>
[PartM IO] -> Request -> m Request
formDataBody [PartM IO]
parts Request
req
  Response ByteString
resp <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
finalReq Manager
manager
  let body :: ByteString
body = Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp
  IO OAuth2Result
-> (OAuth2Result -> IO OAuth2Result)
-> Maybe OAuth2Result
-> IO OAuth2Result
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO OAuth2Result
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"impossible: unable to parse response") OAuth2Result -> IO OAuth2Result
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ByteString -> Maybe OAuth2Result
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
body)

-- | Like 'auth', but immediately throws 'OAuth2Error' if auth failed.
auth' :: Manager -> Credential -> IO OAuth2Token
auth' :: Manager -> Credential -> IO OAuth2Token
auth' Manager
manager Credential
credential =
  Manager -> Credential -> IO OAuth2Result
auth Manager
manager Credential
credential IO OAuth2Result
-> (OAuth2Result -> IO OAuth2Token) -> IO OAuth2Token
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    AuthSuccess OAuth2Token
t -> OAuth2Token -> IO OAuth2Token
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure OAuth2Token
t
    AuthFailure OAuth2Error
err -> OAuth2Error -> IO OAuth2Token
forall e a. Exception e => e -> IO a
throwIO OAuth2Error
err