{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

-- | 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
-- The core monad of this library. 'PixivT' maintains a pixiv login state,
-- and provides an environment to perform computations created by servant.
module Web.Pixiv.Types.PixivT
  ( -- * ClientT monad transformer
    ClientT (..),
    runClientT,
    mkDefaultClientEnv,

    -- * MonadPixiv class
    MonadPixiv (..),
    PixivState (..),

    -- * PixivT monad transformer
    PixivT (..),
    liftC,
    runPixivT,
    runPixivT',

    -- * Token
    TokenState (..),
    computeTokenState,

    -- * Utilities
    getAccessToken,
    getAccessTokenWithAccpetLanguage,
  )
where

import Control.Concurrent.MVar
import Control.Monad.Base (MonadBase)
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Function ((&))
import Data.Text (Text)
import Data.Time
import GHC.Generics (Generic)
import GHC.Show (showCommaSpace)
import Network.HTTP.Client (Manager)
import Network.HTTP.Client.TLS (newTlsManager)
import Servant.Client
import Servant.Client.Core
import Servant.Client.Internal.HttpClient
import Web.Pixiv.Auth

-- | Transformer version of 'ClientM', changing the base 'IO' to @m@.
newtype ClientT m a = ClientT
  { ClientT m a -> ReaderT ClientEnv (ExceptT ClientError m) a
unClientT :: ReaderT ClientEnv (ExceptT ClientError m) a
  }
  deriving newtype
    ( a -> ClientT m b -> ClientT m a
(a -> b) -> ClientT m a -> ClientT m b
(forall a b. (a -> b) -> ClientT m a -> ClientT m b)
-> (forall a b. a -> ClientT m b -> ClientT m a)
-> Functor (ClientT m)
forall a b. a -> ClientT m b -> ClientT m a
forall a b. (a -> b) -> ClientT m a -> ClientT m b
forall (m :: Type -> Type) a b.
Functor m =>
a -> ClientT m b -> ClientT m a
forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> ClientT m a -> ClientT m b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ClientT m b -> ClientT m a
$c<$ :: forall (m :: Type -> Type) a b.
Functor m =>
a -> ClientT m b -> ClientT m a
fmap :: (a -> b) -> ClientT m a -> ClientT m b
$cfmap :: forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> ClientT m a -> ClientT m b
Functor,
      Functor (ClientT m)
a -> ClientT m a
Functor (ClientT m)
-> (forall a. a -> ClientT m a)
-> (forall a b. ClientT m (a -> b) -> ClientT m a -> ClientT m b)
-> (forall a b c.
    (a -> b -> c) -> ClientT m a -> ClientT m b -> ClientT m c)
-> (forall a b. ClientT m a -> ClientT m b -> ClientT m b)
-> (forall a b. ClientT m a -> ClientT m b -> ClientT m a)
-> Applicative (ClientT m)
ClientT m a -> ClientT m b -> ClientT m b
ClientT m a -> ClientT m b -> ClientT m a
ClientT m (a -> b) -> ClientT m a -> ClientT m b
(a -> b -> c) -> ClientT m a -> ClientT m b -> ClientT m c
forall a. a -> ClientT m a
forall a b. ClientT m a -> ClientT m b -> ClientT m a
forall a b. ClientT m a -> ClientT m b -> ClientT m b
forall a b. ClientT m (a -> b) -> ClientT m a -> ClientT m b
forall a b c.
(a -> b -> c) -> ClientT m a -> ClientT m b -> ClientT m c
forall (m :: Type -> Type). Monad m => Functor (ClientT m)
forall (m :: Type -> Type) a. Monad m => a -> ClientT m a
forall (m :: Type -> Type) a b.
Monad m =>
ClientT m a -> ClientT m b -> ClientT m a
forall (m :: Type -> Type) a b.
Monad m =>
ClientT m a -> ClientT m b -> ClientT m b
forall (m :: Type -> Type) a b.
Monad m =>
ClientT m (a -> b) -> ClientT m a -> ClientT m b
forall (m :: Type -> Type) a b c.
Monad m =>
(a -> b -> c) -> ClientT m a -> ClientT m b -> ClientT m c
forall (f :: Type -> Type).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ClientT m a -> ClientT m b -> ClientT m a
$c<* :: forall (m :: Type -> Type) a b.
Monad m =>
ClientT m a -> ClientT m b -> ClientT m a
*> :: ClientT m a -> ClientT m b -> ClientT m b
$c*> :: forall (m :: Type -> Type) a b.
Monad m =>
ClientT m a -> ClientT m b -> ClientT m b
liftA2 :: (a -> b -> c) -> ClientT m a -> ClientT m b -> ClientT m c
$cliftA2 :: forall (m :: Type -> Type) a b c.
Monad m =>
(a -> b -> c) -> ClientT m a -> ClientT m b -> ClientT m c
<*> :: ClientT m (a -> b) -> ClientT m a -> ClientT m b
$c<*> :: forall (m :: Type -> Type) a b.
Monad m =>
ClientT m (a -> b) -> ClientT m a -> ClientT m b
pure :: a -> ClientT m a
$cpure :: forall (m :: Type -> Type) a. Monad m => a -> ClientT m a
$cp1Applicative :: forall (m :: Type -> Type). Monad m => Functor (ClientT m)
Applicative,
      Applicative (ClientT m)
a -> ClientT m a
Applicative (ClientT m)
-> (forall a b. ClientT m a -> (a -> ClientT m b) -> ClientT m b)
-> (forall a b. ClientT m a -> ClientT m b -> ClientT m b)
-> (forall a. a -> ClientT m a)
-> Monad (ClientT m)
ClientT m a -> (a -> ClientT m b) -> ClientT m b
ClientT m a -> ClientT m b -> ClientT m b
forall a. a -> ClientT m a
forall a b. ClientT m a -> ClientT m b -> ClientT m b
forall a b. ClientT m a -> (a -> ClientT m b) -> ClientT m b
forall (m :: Type -> Type). Monad m => Applicative (ClientT m)
forall (m :: Type -> Type) a. Monad m => a -> ClientT m a
forall (m :: Type -> Type) a b.
Monad m =>
ClientT m a -> ClientT m b -> ClientT m b
forall (m :: Type -> Type) a b.
Monad m =>
ClientT m a -> (a -> ClientT m b) -> ClientT m b
forall (m :: Type -> Type).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ClientT m a
$creturn :: forall (m :: Type -> Type) a. Monad m => a -> ClientT m a
>> :: ClientT m a -> ClientT m b -> ClientT m b
$c>> :: forall (m :: Type -> Type) a b.
Monad m =>
ClientT m a -> ClientT m b -> ClientT m b
>>= :: ClientT m a -> (a -> ClientT m b) -> ClientT m b
$c>>= :: forall (m :: Type -> Type) a b.
Monad m =>
ClientT m a -> (a -> ClientT m b) -> ClientT m b
$cp1Monad :: forall (m :: Type -> Type). Monad m => Applicative (ClientT m)
Monad,
      Monad (ClientT m)
Monad (ClientT m)
-> (forall a. IO a -> ClientT m a) -> MonadIO (ClientT m)
IO a -> ClientT m a
forall a. IO a -> ClientT m a
forall (m :: Type -> Type).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: Type -> Type). MonadIO m => Monad (ClientT m)
forall (m :: Type -> Type) a. MonadIO m => IO a -> ClientT m a
liftIO :: IO a -> ClientT m a
$cliftIO :: forall (m :: Type -> Type) a. MonadIO m => IO a -> ClientT m a
$cp1MonadIO :: forall (m :: Type -> Type). MonadIO m => Monad (ClientT m)
MonadIO,
      Monad (ClientT m)
e -> ClientT m a
Monad (ClientT m)
-> (forall e a. Exception e => e -> ClientT m a)
-> MonadThrow (ClientT m)
forall e a. Exception e => e -> ClientT m a
forall (m :: Type -> Type).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: Type -> Type). MonadThrow m => Monad (ClientT m)
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> ClientT m a
throwM :: e -> ClientT m a
$cthrowM :: forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> ClientT m a
$cp1MonadThrow :: forall (m :: Type -> Type). MonadThrow m => Monad (ClientT m)
MonadThrow,
      MonadThrow (ClientT m)
MonadThrow (ClientT m)
-> (forall e a.
    Exception e =>
    ClientT m a -> (e -> ClientT m a) -> ClientT m a)
-> MonadCatch (ClientT m)
ClientT m a -> (e -> ClientT m a) -> ClientT m a
forall e a.
Exception e =>
ClientT m a -> (e -> ClientT m a) -> ClientT m a
forall (m :: Type -> Type).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: Type -> Type). MonadCatch m => MonadThrow (ClientT m)
forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
ClientT m a -> (e -> ClientT m a) -> ClientT m a
catch :: ClientT m a -> (e -> ClientT m a) -> ClientT m a
$ccatch :: forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
ClientT m a -> (e -> ClientT m a) -> ClientT m a
$cp1MonadCatch :: forall (m :: Type -> Type). MonadCatch m => MonadThrow (ClientT m)
MonadCatch,
      MonadReader ClientEnv,
      MonadError ClientError,
      MonadBase b,
      MonadBaseControl b
    )

instance MonadTrans ClientT where
  lift :: m a -> ClientT m a
lift = ReaderT ClientEnv (ExceptT ClientError m) a -> ClientT m a
forall (m :: Type -> Type) a.
ReaderT ClientEnv (ExceptT ClientError m) a -> ClientT m a
ClientT (ReaderT ClientEnv (ExceptT ClientError m) a -> ClientT m a)
-> (m a -> ReaderT ClientEnv (ExceptT ClientError m) a)
-> m a
-> ClientT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT ClientError m a
-> ReaderT ClientEnv (ExceptT ClientError m) a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT ClientError m a
 -> ReaderT ClientEnv (ExceptT ClientError m) a)
-> (m a -> ExceptT ClientError m a)
-> m a
-> ReaderT ClientEnv (ExceptT ClientError m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ExceptT ClientError m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Executes a computation in the client monad.
runClientT :: ClientEnv -> ClientT m a -> m (Either ClientError a)
runClientT :: ClientEnv -> ClientT m a -> m (Either ClientError a)
runClientT ClientEnv
env ClientT m a
m =
  ClientT m a
m
    ClientT m a
-> (ClientT m a -> ReaderT ClientEnv (ExceptT ClientError m) a)
-> ReaderT ClientEnv (ExceptT ClientError m) a
forall a b. a -> (a -> b) -> b
& ClientT m a -> ReaderT ClientEnv (ExceptT ClientError m) a
forall (m :: Type -> Type) a.
ClientT m a -> ReaderT ClientEnv (ExceptT ClientError m) a
unClientT
    ReaderT ClientEnv (ExceptT ClientError m) a
-> (ReaderT ClientEnv (ExceptT ClientError m) a
    -> ExceptT ClientError m a)
-> ExceptT ClientError m a
forall a b. a -> (a -> b) -> b
& (ReaderT ClientEnv (ExceptT ClientError m) a
 -> ClientEnv -> ExceptT ClientError m a)
-> ClientEnv
-> ReaderT ClientEnv (ExceptT ClientError m) a
-> ExceptT ClientError m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT ClientEnv (ExceptT ClientError m) a
-> ClientEnv -> ExceptT ClientError m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT ClientEnv
env
    ExceptT ClientError m a
-> (ExceptT ClientError m a -> m (Either ClientError a))
-> m (Either ClientError a)
forall a b. a -> (a -> b) -> b
& ExceptT ClientError m a -> m (Either ClientError a)
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT

instance MonadIO m => RunClient (ClientT m) where
  throwClientError :: ClientError -> ClientT m a
throwClientError = ClientError -> ClientT m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError
  runRequestAcceptStatus :: Maybe [Status] -> Request -> ClientT m Response
runRequestAcceptStatus Maybe [Status]
status Request
req = do
    ClientEnv
env <- ClientT m ClientEnv
forall r (m :: Type -> Type). MonadReader r m => m r
ask
    let m :: ClientM Response
m = Maybe [Status] -> Request -> ClientM Response
performRequest Maybe [Status]
status Request
req
    Either ClientError Response
res <- IO (Either ClientError Response)
-> ClientT m (Either ClientError Response)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either ClientError Response)
 -> ClientT m (Either ClientError Response))
-> IO (Either ClientError Response)
-> ClientT m (Either ClientError Response)
forall a b. (a -> b) -> a -> b
$ ClientM Response -> ClientEnv -> IO (Either ClientError Response)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM Response
m ClientEnv
env
    Either ClientError Response -> ClientT m Response
forall e (m :: Type -> Type) a. MonadError e m => Either e a -> m a
liftEither Either ClientError Response
res

-- | Given 'Manager', creates a 'ClientEnv' using <https://app-api.pixiv.net> as base url.
mkDefaultClientEnv :: Manager -> IO ClientEnv
mkDefaultClientEnv :: Manager -> IO ClientEnv
mkDefaultClientEnv Manager
manager = do
  BaseUrl
baseUrl <- String -> IO BaseUrl
forall (m :: Type -> Type). MonadThrow m => String -> m BaseUrl
parseBaseUrl String
"https://app-api.pixiv.net"
  ClientEnv -> IO ClientEnv
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ClientEnv -> IO ClientEnv) -> ClientEnv -> IO ClientEnv
forall a b. (a -> b) -> a -> b
$ Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
manager BaseUrl
baseUrl

-- | Pixiv auth state.
data TokenState = TokenState
  { -- | Token to access pixiv api.
    TokenState -> Token
accessToken :: Token,
    -- | Token to obtain new 'accessToken' without giving username and password.
    TokenState -> Token
refreshToken :: Token,
    -- | Time stamp when 'accessToken' becomes invalid.
    TokenState -> UTCTime
expirationTime :: UTCTime,
    TokenState -> Manager
manager :: Manager
  }
  deriving stock ((forall x. TokenState -> Rep TokenState x)
-> (forall x. Rep TokenState x -> TokenState) -> Generic TokenState
forall x. Rep TokenState x -> TokenState
forall x. TokenState -> Rep TokenState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenState x -> TokenState
$cfrom :: forall x. TokenState -> Rep TokenState x
Generic)

instance Show TokenState where
  showsPrec :: Int -> TokenState -> ShowS
showsPrec Int
d TokenState {UTCTime
Manager
Token
manager :: Manager
expirationTime :: UTCTime
refreshToken :: Token
accessToken :: Token
manager :: TokenState -> Manager
expirationTime :: TokenState -> UTCTime
refreshToken :: TokenState -> Token
accessToken :: TokenState -> Token
..} =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"TokenState {"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"accessToken = "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ShowS
forall a. Show a => a -> ShowS
shows Token
accessToken
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showCommaSpace
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"refreshToken = "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ShowS
forall a. Show a => a -> ShowS
shows Token
refreshToken
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showCommaSpace
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"expirationTime = "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> ShowS
forall a. Show a => a -> ShowS
shows UTCTime
expirationTime
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"}"

-- | State stored in 'MonadPixiv'.
data PixivState = PixivState
  { PixivState -> TokenState
tokenState :: TokenState,
    PixivState -> Maybe Text
acceptLanguage :: Maybe Text
  }
  deriving stock ((forall x. PixivState -> Rep PixivState x)
-> (forall x. Rep PixivState x -> PixivState) -> Generic PixivState
forall x. Rep PixivState x -> PixivState
forall x. PixivState -> Rep PixivState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PixivState x -> PixivState
$cfrom :: forall x. PixivState -> Rep PixivState x
Generic, Int -> PixivState -> ShowS
[PixivState] -> ShowS
PixivState -> String
(Int -> PixivState -> ShowS)
-> (PixivState -> String)
-> ([PixivState] -> ShowS)
-> Show PixivState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PixivState] -> ShowS
$cshowList :: [PixivState] -> ShowS
show :: PixivState -> String
$cshow :: PixivState -> String
showsPrec :: Int -> PixivState -> ShowS
$cshowsPrec :: Int -> PixivState -> ShowS
Show)

-- | A thread safe implementation of 'MonadPixiv'.
newtype PixivT m a = PixivT
  { PixivT m a -> ReaderT (MVar PixivState) (ClientT m) a
unPixivT :: ReaderT (MVar PixivState) (ClientT m) a
  }
  deriving newtype
    ( a -> PixivT m b -> PixivT m a
(a -> b) -> PixivT m a -> PixivT m b
(forall a b. (a -> b) -> PixivT m a -> PixivT m b)
-> (forall a b. a -> PixivT m b -> PixivT m a)
-> Functor (PixivT m)
forall a b. a -> PixivT m b -> PixivT m a
forall a b. (a -> b) -> PixivT m a -> PixivT m b
forall (m :: Type -> Type) a b.
Functor m =>
a -> PixivT m b -> PixivT m a
forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> PixivT m a -> PixivT m b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PixivT m b -> PixivT m a
$c<$ :: forall (m :: Type -> Type) a b.
Functor m =>
a -> PixivT m b -> PixivT m a
fmap :: (a -> b) -> PixivT m a -> PixivT m b
$cfmap :: forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> PixivT m a -> PixivT m b
Functor,
      Functor (PixivT m)
a -> PixivT m a
Functor (PixivT m)
-> (forall a. a -> PixivT m a)
-> (forall a b. PixivT m (a -> b) -> PixivT m a -> PixivT m b)
-> (forall a b c.
    (a -> b -> c) -> PixivT m a -> PixivT m b -> PixivT m c)
-> (forall a b. PixivT m a -> PixivT m b -> PixivT m b)
-> (forall a b. PixivT m a -> PixivT m b -> PixivT m a)
-> Applicative (PixivT m)
PixivT m a -> PixivT m b -> PixivT m b
PixivT m a -> PixivT m b -> PixivT m a
PixivT m (a -> b) -> PixivT m a -> PixivT m b
(a -> b -> c) -> PixivT m a -> PixivT m b -> PixivT m c
forall a. a -> PixivT m a
forall a b. PixivT m a -> PixivT m b -> PixivT m a
forall a b. PixivT m a -> PixivT m b -> PixivT m b
forall a b. PixivT m (a -> b) -> PixivT m a -> PixivT m b
forall a b c.
(a -> b -> c) -> PixivT m a -> PixivT m b -> PixivT m c
forall (m :: Type -> Type). Monad m => Functor (PixivT m)
forall (m :: Type -> Type) a. Monad m => a -> PixivT m a
forall (m :: Type -> Type) a b.
Monad m =>
PixivT m a -> PixivT m b -> PixivT m a
forall (m :: Type -> Type) a b.
Monad m =>
PixivT m a -> PixivT m b -> PixivT m b
forall (m :: Type -> Type) a b.
Monad m =>
PixivT m (a -> b) -> PixivT m a -> PixivT m b
forall (m :: Type -> Type) a b c.
Monad m =>
(a -> b -> c) -> PixivT m a -> PixivT m b -> PixivT m c
forall (f :: Type -> Type).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: PixivT m a -> PixivT m b -> PixivT m a
$c<* :: forall (m :: Type -> Type) a b.
Monad m =>
PixivT m a -> PixivT m b -> PixivT m a
*> :: PixivT m a -> PixivT m b -> PixivT m b
$c*> :: forall (m :: Type -> Type) a b.
Monad m =>
PixivT m a -> PixivT m b -> PixivT m b
liftA2 :: (a -> b -> c) -> PixivT m a -> PixivT m b -> PixivT m c
$cliftA2 :: forall (m :: Type -> Type) a b c.
Monad m =>
(a -> b -> c) -> PixivT m a -> PixivT m b -> PixivT m c
<*> :: PixivT m (a -> b) -> PixivT m a -> PixivT m b
$c<*> :: forall (m :: Type -> Type) a b.
Monad m =>
PixivT m (a -> b) -> PixivT m a -> PixivT m b
pure :: a -> PixivT m a
$cpure :: forall (m :: Type -> Type) a. Monad m => a -> PixivT m a
$cp1Applicative :: forall (m :: Type -> Type). Monad m => Functor (PixivT m)
Applicative,
      Applicative (PixivT m)
a -> PixivT m a
Applicative (PixivT m)
-> (forall a b. PixivT m a -> (a -> PixivT m b) -> PixivT m b)
-> (forall a b. PixivT m a -> PixivT m b -> PixivT m b)
-> (forall a. a -> PixivT m a)
-> Monad (PixivT m)
PixivT m a -> (a -> PixivT m b) -> PixivT m b
PixivT m a -> PixivT m b -> PixivT m b
forall a. a -> PixivT m a
forall a b. PixivT m a -> PixivT m b -> PixivT m b
forall a b. PixivT m a -> (a -> PixivT m b) -> PixivT m b
forall (m :: Type -> Type). Monad m => Applicative (PixivT m)
forall (m :: Type -> Type) a. Monad m => a -> PixivT m a
forall (m :: Type -> Type) a b.
Monad m =>
PixivT m a -> PixivT m b -> PixivT m b
forall (m :: Type -> Type) a b.
Monad m =>
PixivT m a -> (a -> PixivT m b) -> PixivT m b
forall (m :: Type -> Type).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> PixivT m a
$creturn :: forall (m :: Type -> Type) a. Monad m => a -> PixivT m a
>> :: PixivT m a -> PixivT m b -> PixivT m b
$c>> :: forall (m :: Type -> Type) a b.
Monad m =>
PixivT m a -> PixivT m b -> PixivT m b
>>= :: PixivT m a -> (a -> PixivT m b) -> PixivT m b
$c>>= :: forall (m :: Type -> Type) a b.
Monad m =>
PixivT m a -> (a -> PixivT m b) -> PixivT m b
$cp1Monad :: forall (m :: Type -> Type). Monad m => Applicative (PixivT m)
Monad,
      Monad (PixivT m)
Monad (PixivT m)
-> (forall a. IO a -> PixivT m a) -> MonadIO (PixivT m)
IO a -> PixivT m a
forall a. IO a -> PixivT m a
forall (m :: Type -> Type).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: Type -> Type). MonadIO m => Monad (PixivT m)
forall (m :: Type -> Type) a. MonadIO m => IO a -> PixivT m a
liftIO :: IO a -> PixivT m a
$cliftIO :: forall (m :: Type -> Type) a. MonadIO m => IO a -> PixivT m a
$cp1MonadIO :: forall (m :: Type -> Type). MonadIO m => Monad (PixivT m)
MonadIO,
      Monad (PixivT m)
e -> PixivT m a
Monad (PixivT m)
-> (forall e a. Exception e => e -> PixivT m a)
-> MonadThrow (PixivT m)
forall e a. Exception e => e -> PixivT m a
forall (m :: Type -> Type).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: Type -> Type). MonadThrow m => Monad (PixivT m)
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> PixivT m a
throwM :: e -> PixivT m a
$cthrowM :: forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> PixivT m a
$cp1MonadThrow :: forall (m :: Type -> Type). MonadThrow m => Monad (PixivT m)
MonadThrow,
      MonadThrow (PixivT m)
MonadThrow (PixivT m)
-> (forall e a.
    Exception e =>
    PixivT m a -> (e -> PixivT m a) -> PixivT m a)
-> MonadCatch (PixivT m)
PixivT m a -> (e -> PixivT m a) -> PixivT m a
forall e a.
Exception e =>
PixivT m a -> (e -> PixivT m a) -> PixivT m a
forall (m :: Type -> Type).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: Type -> Type). MonadCatch m => MonadThrow (PixivT m)
forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
PixivT m a -> (e -> PixivT m a) -> PixivT m a
catch :: PixivT m a -> (e -> PixivT m a) -> PixivT m a
$ccatch :: forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
PixivT m a -> (e -> PixivT m a) -> PixivT m a
$cp1MonadCatch :: forall (m :: Type -> Type). MonadCatch m => MonadThrow (PixivT m)
MonadCatch,
      MonadReader (MVar PixivState),
      MonadError ClientError
    )
  deriving stock ((forall x. PixivT m a -> Rep (PixivT m a) x)
-> (forall x. Rep (PixivT m a) x -> PixivT m a)
-> Generic (PixivT m a)
forall x. Rep (PixivT m a) x -> PixivT m a
forall x. PixivT m a -> Rep (PixivT m a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: Type -> Type) a x. Rep (PixivT m a) x -> PixivT m a
forall (m :: Type -> Type) a x. PixivT m a -> Rep (PixivT m a) x
$cto :: forall (m :: Type -> Type) a x. Rep (PixivT m a) x -> PixivT m a
$cfrom :: forall (m :: Type -> Type) a x. PixivT m a -> Rep (PixivT m a) x
Generic)

instance MonadTrans PixivT where
  lift :: m a -> PixivT m a
lift = ReaderT (MVar PixivState) (ClientT m) a -> PixivT m a
forall (m :: Type -> Type) a.
ReaderT (MVar PixivState) (ClientT m) a -> PixivT m a
PixivT (ReaderT (MVar PixivState) (ClientT m) a -> PixivT m a)
-> (m a -> ReaderT (MVar PixivState) (ClientT m) a)
-> m a
-> PixivT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientT m a -> ReaderT (MVar PixivState) (ClientT m) a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ClientT m a -> ReaderT (MVar PixivState) (ClientT m) a)
-> (m a -> ClientT m a)
-> m a
-> ReaderT (MVar PixivState) (ClientT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ClientT m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

deriving newtype instance MonadBase IO m => MonadBase IO (PixivT m)

deriving newtype instance MonadBaseControl IO m => MonadBaseControl IO (PixivT m)

-- | Lifts a computation in 'ClientT' to 'PixivT'.
liftC :: Monad m => ClientT m a -> PixivT m a
liftC :: ClientT m a -> PixivT m a
liftC = ReaderT (MVar PixivState) (ClientT m) a -> PixivT m a
forall (m :: Type -> Type) a.
ReaderT (MVar PixivState) (ClientT m) a -> PixivT m a
PixivT (ReaderT (MVar PixivState) (ClientT m) a -> PixivT m a)
-> (ClientT m a -> ReaderT (MVar PixivState) (ClientT m) a)
-> ClientT m a
-> PixivT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientT m a -> ReaderT (MVar PixivState) (ClientT m) a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MonadIO m => RunClient (PixivT m) where
  throwClientError :: ClientError -> PixivT m a
throwClientError = ClientError -> PixivT m a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError
  runRequestAcceptStatus :: Maybe [Status] -> Request -> PixivT m Response
runRequestAcceptStatus Maybe [Status]
status Request
req =
    ClientT m Response -> PixivT m Response
forall (m :: Type -> Type) a. Monad m => ClientT m a -> PixivT m a
liftC (ClientT m Response -> PixivT m Response)
-> ClientT m Response -> PixivT m Response
forall a b. (a -> b) -> a -> b
$ Maybe [Status] -> Request -> ClientT m Response
forall (m :: Type -> Type).
RunClient m =>
Maybe [Status] -> Request -> m Response
runRequestAcceptStatus Maybe [Status]
status Request
req

-- | The mtl-style class of pixiv monad.
class (RunClient m, MonadIO m) => MonadPixiv m where
  -- | Reads the stored 'PixivState', when used in a multithreaded setting, this should block
  -- all other thread from reading the 'PixivState' until 'putPixivState' is called.
  takePixivState :: m PixivState

  -- | Writes a new 'PixivState'.
  putPixivState :: PixivState -> m ()

  -- | Reads the stored 'PixivState', without blocking other threads which want to read this state.
  --
  -- Don't confuse with 'takePixivState', please refer to 'readMVar'.
  readPixivState :: m PixivState

instance
  {-# OVERLAPPABLE #-}
  ( MonadPixiv m,
    MonadTrans f,
    MonadIO (f m),
    RunClient (f m)
  ) =>
  MonadPixiv (f m)
  where
  takePixivState :: f m PixivState
takePixivState = m PixivState -> f m PixivState
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PixivState
forall (m :: Type -> Type). MonadPixiv m => m PixivState
takePixivState
  putPixivState :: PixivState -> f m ()
putPixivState = m () -> f m ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> f m ()) -> (PixivState -> m ()) -> PixivState -> f m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixivState -> m ()
forall (m :: Type -> Type). MonadPixiv m => PixivState -> m ()
putPixivState
  readPixivState :: f m PixivState
readPixivState = m PixivState -> f m PixivState
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PixivState
forall (m :: Type -> Type). MonadPixiv m => m PixivState
readPixivState

instance MonadIO m => MonadPixiv (PixivT m) where
  takePixivState :: PixivT m PixivState
takePixivState = PixivT m (MVar PixivState)
forall r (m :: Type -> Type). MonadReader r m => m r
ask PixivT m (MVar PixivState)
-> (MVar PixivState -> PixivT m PixivState) -> PixivT m PixivState
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO PixivState -> PixivT m PixivState
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO PixivState -> PixivT m PixivState)
-> (MVar PixivState -> IO PixivState)
-> MVar PixivState
-> PixivT m PixivState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar PixivState -> IO PixivState
forall a. MVar a -> IO a
takeMVar
  putPixivState :: PixivState -> PixivT m ()
putPixivState PixivState
s = do
    MVar PixivState
ref <- PixivT m (MVar PixivState)
forall r (m :: Type -> Type). MonadReader r m => m r
ask
    IO () -> PixivT m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> PixivT m ()) -> IO () -> PixivT m ()
forall a b. (a -> b) -> a -> b
$ MVar PixivState -> PixivState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar PixivState
ref PixivState
s
  readPixivState :: PixivT m PixivState
readPixivState = PixivT m (MVar PixivState)
forall r (m :: Type -> Type). MonadReader r m => m r
ask PixivT m (MVar PixivState)
-> (MVar PixivState -> PixivT m PixivState) -> PixivT m PixivState
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO PixivState -> PixivT m PixivState
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO PixivState -> PixivT m PixivState)
-> (MVar PixivState -> IO PixivState)
-> MVar PixivState
-> PixivT m PixivState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar PixivState -> IO PixivState
forall a. MVar a -> IO a
readMVar

-- | Interprets the 'PixivT' effect, with a supplied 'Manager'.
runPixivT :: MonadIO m => Manager -> Credential -> PixivT m a -> m (Either ClientError a)
runPixivT :: Manager -> Credential -> PixivT m a -> m (Either ClientError a)
runPixivT Manager
manager Credential
credential PixivT m a
m = do
  UTCTime
t <- IO UTCTime -> m UTCTime
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  TokenState
s <- IO TokenState -> m TokenState
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO TokenState -> m TokenState) -> IO TokenState -> m TokenState
forall a b. (a -> b) -> a -> b
$ Manager -> Credential -> UTCTime -> IO TokenState
computeTokenState Manager
manager Credential
credential UTCTime
t
  ClientEnv
clientEnv <- IO ClientEnv -> m ClientEnv
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO ClientEnv -> m ClientEnv) -> IO ClientEnv -> m ClientEnv
forall a b. (a -> b) -> a -> b
$ Manager -> IO ClientEnv
mkDefaultClientEnv Manager
manager
  MVar PixivState
ref <- IO (MVar PixivState) -> m (MVar PixivState)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MVar PixivState) -> m (MVar PixivState))
-> (PixivState -> IO (MVar PixivState))
-> PixivState
-> m (MVar PixivState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixivState -> IO (MVar PixivState)
forall a. a -> IO (MVar a)
newMVar (PixivState -> m (MVar PixivState))
-> PixivState -> m (MVar PixivState)
forall a b. (a -> b) -> a -> b
$ TokenState -> Maybe Text -> PixivState
PixivState TokenState
s Maybe Text
forall a. Maybe a
Nothing
  PixivT m a
m
    PixivT m a
-> (PixivT m a -> ReaderT (MVar PixivState) (ClientT m) a)
-> ReaderT (MVar PixivState) (ClientT m) a
forall a b. a -> (a -> b) -> b
& PixivT m a -> ReaderT (MVar PixivState) (ClientT m) a
forall (m :: Type -> Type) a.
PixivT m a -> ReaderT (MVar PixivState) (ClientT m) a
unPixivT
    ReaderT (MVar PixivState) (ClientT m) a
-> (ReaderT (MVar PixivState) (ClientT m) a -> ClientT m a)
-> ClientT m a
forall a b. a -> (a -> b) -> b
& (ReaderT (MVar PixivState) (ClientT m) a
 -> MVar PixivState -> ClientT m a)
-> MVar PixivState
-> ReaderT (MVar PixivState) (ClientT m) a
-> ClientT m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (MVar PixivState) (ClientT m) a
-> MVar PixivState -> ClientT m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT MVar PixivState
ref
    ClientT m a
-> (ClientT m a -> m (Either ClientError a))
-> m (Either ClientError a)
forall a b. a -> (a -> b) -> b
& ClientEnv -> ClientT m a -> m (Either ClientError a)
forall (m :: Type -> Type) a.
ClientEnv -> ClientT m a -> m (Either ClientError a)
runClientT ClientEnv
clientEnv

-- | Like 'runPixivT', but creates a new 'Manager' everytime.
runPixivT' :: MonadIO m => Credential -> PixivT m a -> m (Either ClientError a)
runPixivT' :: Credential -> PixivT m a -> m (Either ClientError a)
runPixivT' Credential
credential PixivT m a
m = do
  Manager
manager <- IO Manager -> m Manager
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO Manager
forall (m :: Type -> Type). MonadIO m => m Manager
newTlsManager
  Manager -> Credential -> PixivT m a -> m (Either ClientError a)
forall (m :: Type -> Type) a.
MonadIO m =>
Manager -> Credential -> PixivT m a -> m (Either ClientError a)
runPixivT Manager
manager Credential
credential PixivT m a
m

-- | Computes the 'TokenState'.
--
-- This function calls 'auth'' to perform authentication.
computeTokenState ::
  Manager ->
  -- | Could be username with password or 'refreshToken'.
  Credential ->
  -- | Current time.
  UTCTime ->
  IO TokenState
computeTokenState :: Manager -> Credential -> UTCTime -> IO TokenState
computeTokenState Manager
manager Credential
credential UTCTime
time = do
  OAuth2Token {Int
Token
oa_refreshToken :: OAuth2Token -> Token
oa_expiresIn :: OAuth2Token -> Int
oa_accessToken :: OAuth2Token -> Token
oa_refreshToken :: Token
oa_expiresIn :: Int
oa_accessToken :: Token
..} <- IO OAuth2Token -> IO OAuth2Token
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO OAuth2Token -> IO OAuth2Token)
-> IO OAuth2Token -> IO OAuth2Token
forall a b. (a -> b) -> a -> b
$ Manager -> Credential -> IO OAuth2Token
auth' Manager
manager Credential
credential
  let offset :: Int
offset = Int
oa_expiresIn Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
      diff :: NominalDiffTime
diff = Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime) -> Pico -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Int -> Pico
forall a. Enum a => Int -> a
toEnum Int
offset
      accessToken :: Token
accessToken = Token
oa_accessToken
      refreshToken :: Token
refreshToken = Token
oa_refreshToken
      expirationTime :: UTCTime
expirationTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
diff UTCTime
time
  TokenState -> IO TokenState
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TokenState :: Token -> Token -> UTCTime -> Manager -> TokenState
TokenState {UTCTime
Manager
Token
expirationTime :: UTCTime
refreshToken :: Token
accessToken :: Token
manager :: Manager
manager :: Manager
expirationTime :: UTCTime
refreshToken :: Token
accessToken :: Token
..}

-- | Retrieves the 'accessToken' from pixiv monad.
--
-- If the token is overdue, it will call 'computeTokenState' to refresh.
getAccessToken :: MonadPixiv m => m Token
getAccessToken :: m Token
getAccessToken = do
  s :: PixivState
s@PixivState {tokenState :: PixivState -> TokenState
tokenState = TokenState {UTCTime
Manager
Token
manager :: Manager
expirationTime :: UTCTime
refreshToken :: Token
accessToken :: Token
manager :: TokenState -> Manager
expirationTime :: TokenState -> UTCTime
refreshToken :: TokenState -> Token
accessToken :: TokenState -> Token
..}} <- m PixivState
forall (m :: Type -> Type). MonadPixiv m => m PixivState
takePixivState
  UTCTime
t <- IO UTCTime -> m UTCTime
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  if UTCTime
t UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
expirationTime
    then do
      PixivState -> m ()
forall (m :: Type -> Type). MonadPixiv m => PixivState -> m ()
putPixivState PixivState
s
      Token -> m Token
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Token
accessToken
    else do
      let credential :: Credential
credential = Token -> Credential
RefreshToken Token
refreshToken
      TokenState
ts <- IO TokenState -> m TokenState
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO TokenState -> m TokenState) -> IO TokenState -> m TokenState
forall a b. (a -> b) -> a -> b
$ Manager -> Credential -> UTCTime -> IO TokenState
computeTokenState Manager
manager Credential
credential UTCTime
t
      PixivState -> m ()
forall (m :: Type -> Type). MonadPixiv m => PixivState -> m ()
putPixivState PixivState
s {tokenState :: TokenState
tokenState = TokenState
ts}
      Token -> m Token
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Token
accessToken

-- | Retrieves the 'acceptLanguage' from pixiv monad.
getAccpetLanguage :: MonadPixiv m => m (Maybe Text)
getAccpetLanguage :: m (Maybe Text)
getAccpetLanguage = PixivState -> Maybe Text
acceptLanguage (PixivState -> Maybe Text) -> m PixivState -> m (Maybe Text)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m PixivState
forall (m :: Type -> Type). MonadPixiv m => m PixivState
readPixivState

-- | Retrieves the 'accessToken' and 'acceptLanguage' in one go.
getAccessTokenWithAccpetLanguage :: MonadPixiv m => m (Token, Maybe Text)
getAccessTokenWithAccpetLanguage :: m (Token, Maybe Text)
getAccessTokenWithAccpetLanguage = (,) (Token -> Maybe Text -> (Token, Maybe Text))
-> m Token -> m (Maybe Text -> (Token, Maybe Text))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m Token
forall (m :: Type -> Type). MonadPixiv m => m Token
getAccessToken m (Maybe Text -> (Token, Maybe Text))
-> m (Maybe Text) -> m (Token, Maybe Text)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> m (Maybe Text)
forall (m :: Type -> Type). MonadPixiv m => m (Maybe Text)
getAccpetLanguage