pixiv (empty) → 0.1.0

raw patch · 20 files changed

+2154/−0 lines, 20 filesdep +aesondep +basedep +base16-bytestring

Dependencies added: aeson, base, base16-bytestring, bytestring, cryptohash-md5, directory, exceptions, filepath, http-client, http-client-tls, lens, monad-control, mtl, pixiv, process, servant, servant-client, servant-client-core, template-haskell, temporary, text, time, transformers, transformers-base, zip-archive

Files

• CHANGELOG.md +5/−0
• LICENSE +11/−0
• README.md +68/−0
• pixiv.cabal +129/−0
• src/Web/Pixiv.hs +31/−0
• src/Web/Pixiv/API.hs +312/−0
• src/Web/Pixiv/API/Article.hs +13/−0
• src/Web/Pixiv/API/Illust.hs +26/−0
• src/Web/Pixiv/API/PixivEntry.hs +37/−0
• src/Web/Pixiv/API/Search.hs +28/−0
• src/Web/Pixiv/API/Trending.hs +27/−0
• src/Web/Pixiv/API/User.hs +50/−0
• src/Web/Pixiv/Auth.hs +162/−0
• src/Web/Pixiv/Download.hs +112/−0
• src/Web/Pixiv/TH.hs +110/−0
• src/Web/Pixiv/Types.hs +598/−0
• src/Web/Pixiv/Types/Lens.hs +48/−0
• src/Web/Pixiv/Types/PixivT.hs +257/−0
• src/Web/Pixiv/Utils.hs +82/−0
• test/Spec.hs +48/−0

@@ -0,0 +1,5 @@+# pixiv++## 0.1.0++Initial release

@@ -0,0 +1,11 @@+Copyright (c) 2021 The closed eye of love++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++   1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++   2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++   3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,68 @@+# pixiv++[![build](https://github.com/The-closed-eye-of-love/pixiv/workflows/build/badge.svg)](https://github.com/The-closed-eye-of-love/pixiv/actions)+[![nix](https://github.com/The-closed-eye-of-love/pixiv/workflows/nix/badge.svg)](https://github.com/The-closed-eye-of-love/pixiv/actions)+[![Hackage](https://img.shields.io/hackage/v/pixiv.svg?logo=haskell)](https://hackage.haskell.org/package/pixiv)+![Hackage-Deps](https://img.shields.io/hackage-deps/v/pixiv)+[![LICENSE](https://img.shields.io/github/license/The-closed-eye-of-love/pixiv)](LICENSE)++Haskell implementation of Pixiv API, based on [servant-client](https://hackage.haskell.org/package/servant-client).++## Usage++In most cases, it is enough to import only `Web.Pixiv`. If you want to use lenses to access and operate data types,+you should import `Web.Pixiv.Types.Lens` as well. Pixiv API requires authentication before being accessed, thus the `PixivT` monad transformer provides an user-friendly and thread-safe interface+to manage, and renew access token on demand, where you just need to give the username and password of your pixiv account.++### Example++Here is a simpe example:++```haskell+import Control.Lens ((^.))+import Control.Monad.IO.Class (liftIO)+import Web.Pixiv+import Web.Pixiv.Types.Lens++main :: IO ()+main = do+  let credential = Password "username" "password"+  result <- runPixivT' credential action+  case result of+    Left err -> print err+    Right x -> pure x++action :: PixivT IO ()+action = do+  -- gets the details of user <https://www.pixiv.net/users/16731>+  userDetail <- getUserDetail 16731+  liftIO $ print userDetail++  -- gets the details of illustration <https://www.pixiv.net/artworks/80132896>+  illustDetail <- getIllustDetail 80132896+  liftIO $ print illustDetail++  -- gets day ranking illustrations+  -- 1 means the first page of the results+  ranking <- getIllustRanking (Just Day) 1+  liftIO $ print ranking++  -- searches the user who has name "玉之けだま" then gets their first work+  -- (function 'head' is not total, just used for demonstration) +  targetUser <- head <$> searchUser "玉之けだま" Nothing 1+  firstWork <- head <$> getUserIllusts (targetUser ^. user . userId) (Just TypeIllust) 1+  liftIO $ print firstWork+```++As you can see, functions accessing Pixiv API are run in `PixivT IO` monad.+For more functionalities this library provides and relevant information about functions or data types, please refer to the documentation.  ++## Documentation++Documentation is available at [hackage (latest release)](https://hackage.haskell.org/package/pixiv)+and our [github pages (master)](https://the-closed-eye-of-love.github.io/pixiv/).++## Related projects++* [pixivpy](https://github.com/upbit/pixivpy)+* [Pixiv-Shaft](https://github.com/CeuiLiSA/Pixiv-Shaft)

@@ -0,0 +1,129 @@+cabal-version:   3.0+name:            pixiv+version:         0.1.0+synopsis:        Pixiv API binding based on servant-client+description:+  Pixiv API binding based on servant-client.+  See README for details.++category:        Web+license:         BSD-3-Clause+license-file:    LICENSE+author:          Poscat, berberman+maintainer:+  Poscat <poscat@mail.poscat.moe>, berberman <berberman@yandex.com>++copyright:       Copyright (c) The closed eye of love 2021+stability:       alpha+homepage:        https://github.com/The-closed-eye-of-love/pixiv+bug-reports:     https://github.com/The-closed-eye-of-love/pixiv/issues+extra-doc-files:+  CHANGELOG.md+  README.md++tested-with:+  GHC ==8.8.3 || ==8.8.4 || ==8.10.1 || ==8.10.2 || ==8.10.3++common common-attrs+  build-depends:+    , aeson            ^>=1.5.4+    , base             >=4.10    && <5+    , bytestring       ^>=0.10.12+    , http-client      ^>=0.6.4+    , http-client-tls  ^>=0.3.5++  default-language:   Haskell2010+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-uni-patterns+    -Wincomplete-record-updates++  if impl(ghc >=8.0)+    ghc-options: -Wredundant-constraints++  if impl(ghc >=8.2)+    ghc-options: -fhide-source-paths++  if impl(ghc >=8.4)+    ghc-options: -Wmissing-export-lists++  if impl(ghc >=8.8)+    ghc-options: -Wmissing-deriving-strategies++  default-extensions:+    NoStarIsType+    BangPatterns+    ConstraintKinds+    DataKinds+    DeriveAnyClass+    DeriveFunctor+    DeriveGeneric+    DerivingStrategies+    DerivingVia+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    KindSignatures+    LambdaCase+    OverloadedStrings+    RecordWildCards+    ScopedTypeVariables+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators+    ViewPatterns++library+  import:          common-attrs+  build-depends:+    , base16-bytestring    ^>=0.1.1+    , cryptohash-md5       ^>=0.11.100+    , directory            ^>=1.3.6+    , exceptions           ^>=0.10.4+    , filepath             ^>=1.4.2+    , lens                 ^>=4.19.2+    , monad-control        ^>=1.0.2+    , mtl                  ^>=2.2.2+    , process              ^>=1.6.9+    , servant              ^>=0.18.2+    , servant-client       ^>=0.18.2+    , servant-client-core  ^>=0.18.2+    , template-haskell+    , temporary            ^>=1.3+    , text                 ^>=1.2.3+    , time                 ^>=1.9.3+    , transformers         ^>=0.5.6+    , transformers-base    ^>=0.4.5+    , zip-archive          ^>=0.4.1++  exposed-modules:+    Web.Pixiv+    Web.Pixiv.API+    Web.Pixiv.Auth+    Web.Pixiv.Download+    Web.Pixiv.Types+    Web.Pixiv.Types.Lens+    Web.Pixiv.Types.PixivT+    Web.Pixiv.Utils++  other-modules:+    Web.Pixiv.API.Article+    Web.Pixiv.API.Illust+    Web.Pixiv.API.PixivEntry+    Web.Pixiv.API.Search+    Web.Pixiv.API.Trending+    Web.Pixiv.API.User+    Web.Pixiv.TH++  hs-source-dirs:  src++test-suite pixiv-test+  import:         common-attrs+  type:           exitcode-stdio-1.0+  build-depends:  pixiv+  hs-source-dirs: test+  main-is:        Spec.hs++source-repository head+  type:     git+  location: https://github.com/The-closed-eye-of-love/pixiv

@@ -0,0 +1,31 @@+-- | 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+-- Example usage:+--+-- @+-- import Web.Pixiv+--+-- main :: IO ()+-- main = do+--   let credential = Password "username" "password"+--   illust <- runPixivT' credential $ getIllustDetail 70479649+--   print illust+-- @+-- This will print illustration information of <https://www.pixiv.net/artworks/70479649>.+-- +-- More information is available on [README](https://github.com/The-closed-eye-of-love/pixiv).+module Web.Pixiv+  ( module Web.Pixiv.API,+    module Web.Pixiv.Types,+    module Web.Pixiv.Types.PixivT,+    Credential (Password),+  )+where++import Web.Pixiv.API+import Web.Pixiv.Auth+import Web.Pixiv.Types+import Web.Pixiv.Types.PixivT

@@ -0,0 +1,312 @@+-- | 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+-- Functions to access pixiv api. They are supposed to be run in "Web.Pixiv.Types.PixivT".+--+-- You may notice that except 'getUserBookmarks', many of functions take a @page@ as input.+-- This is because each query contains 30 entries (except 'Web.Pixiv.API.getSpotlightArticles''s , which containes 10), i.e. you should pass @2@ if you want items ranged from 31 to 60.+module Web.Pixiv.API+  ( -- * Trending+    getTrendingTags,+    getRecommendedIllusts,+    getRecommendedMangas,++    -- * Illust+    getIllustDetail,+    getIllustComments,+    getIllustRelated,+    getIllustRanking,+    getIllustFollow,+    getIllustNew,+    getUgoiraMetadata,++    -- * Search+    searchIllust,+    searchUser,++    -- * User+    getUserDetail,+    getUserIllusts,+    getUserFollowing,+    getUserFollower,+    getUserMypixiv,+    getUserBookmarks,++    -- * Article+    getSpotlightArticles,+  )+where++import Control.Lens+import Data.Coerce (coerce)+import Data.Proxy+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Read (decimal)+import Servant.Client.Core+import Web.Pixiv.API.Article+import Web.Pixiv.API.Illust+import Web.Pixiv.API.PixivEntry (pageToOffset)+import Web.Pixiv.API.Search+import Web.Pixiv.API.Trending+import Web.Pixiv.API.User+import Web.Pixiv.Types+import Web.Pixiv.Types.PixivT++-----------------------------------------------------------------------------++-- | Gets trending tags.+getTrendingTags ::+  MonadPixiv m =>+  -- | includes translated tag results+  Maybe Bool ->+  m [TrendingTag]+getTrendingTags includeTranslatedTagResults = do+  p <- getAccessTokenWithAccpetLanguage+  tags <- clientIn (Proxy @GetTrendingTags) Proxy p includeTranslatedTagResults+  pure $ coerce tags++-- | Gets recommended illustrations of the account which is used for login.+getRecommendedIllusts ::+  MonadPixiv m =>+  -- | includes privacy policy+  Maybe Bool ->+  -- | includes translated tag results+  Maybe Bool ->+  m [Illust]+getRecommendedIllusts includePrivacyPolicy includeTranslatedTagResults = do+  p <- getAccessTokenWithAccpetLanguage+  illusts <- clientIn (Proxy @GetRecommendedIllusts) Proxy p includePrivacyPolicy includeTranslatedTagResults+  pure $ unNextUrl illusts++-- | Gets recommended mangas of the account which is used for login.+getRecommendedMangas :: MonadPixiv m => Maybe Bool -> Maybe Bool -> m [Illust]+getRecommendedMangas includePrivacyPolicy includeTranslatedTagResults = do+  p <- getAccessTokenWithAccpetLanguage+  illusts <- clientIn (Proxy @GetRecommendedMangas) Proxy p includePrivacyPolicy includeTranslatedTagResults+  pure $ unNextUrl illusts++-----------------------------------------------------------------------------++-- | Gets the details of a illustration.+getIllustDetail ::+  MonadPixiv m =>+  -- | illust id+  Int ->+  m Illust+getIllustDetail illustId = do+  p <- getAccessTokenWithAccpetLanguage+  detail <- clientIn (Proxy @GetIllustDetail) Proxy p illustId+  pure $ coerce detail++-- | Gets the comments of a illustration.+getIllustComments ::+  MonadPixiv m =>+  -- | illust id+  Int ->+  -- | page+  Int ->+  m Comments+getIllustComments illustId (pageToOffset 30 -> offset) = do+  p <- getAccessTokenWithAccpetLanguage+  clientIn (Proxy @GetIllustComments) Proxy p illustId offset++-- | Gets related illustrations.+getIllustRelated ::+  MonadPixiv m =>+  -- | illust id+  Int ->+  -- | page+  Int ->+  m [Illust]+getIllustRelated illustId (pageToOffset 30 -> offset) = do+  p <- getAccessTokenWithAccpetLanguage+  illusts <- clientIn (Proxy @GetIllustRelated) Proxy p illustId offset+  pure $ unNextUrl illusts++-- | Gets ranking illustrations.+getIllustRanking ::+  MonadPixiv m =>+  -- | rank mode+  Maybe RankMode ->+  -- | page+  Int ->+  m [Illust]+getIllustRanking mode (pageToOffset 30 -> offset) = do+  p <- getAccessTokenWithAccpetLanguage+  illusts <- clientIn (Proxy @GetIllustRanking) Proxy p mode offset+  pure $ unNextUrl illusts++-- | Gets illustrations of artists which the login account follows.+getIllustFollow ::+  MonadPixiv m =>+  -- | restrict+  Publicity ->+  -- | page+  Int ->+  m [Illust]+getIllustFollow restrict (pageToOffset 30 -> offset) = do+  p <- getAccessTokenWithAccpetLanguage+  illusts <- clientIn (Proxy @GetIllustFollow) Proxy p restrict offset+  pure $ unNextUrl illusts++-- | Gets the newest illustrations.+getIllustNew ::+  MonadPixiv m =>+  -- | page+  Int ->+  m [Illust]+getIllustNew (pageToOffset 30 -> offset) = do+  p <- getAccessTokenWithAccpetLanguage+  illusts <- clientIn (Proxy @GetIllustNew) Proxy p offset+  pure $ unNextUrl illusts++-- | Gets the metadata of a ugoira+getUgoiraMetadata ::+  MonadPixiv m =>+  -- | illust id+  Int ->+  m UgoiraMetadata+getUgoiraMetadata illustId = do+  p <- getAccessTokenWithAccpetLanguage+  ug <- clientIn (Proxy @GetUgoiraMetadata) Proxy p illustId+  pure $ coerce ug++-----------------------------------------------------------------------------++-- | Searches an illustration.+searchIllust ::+  MonadPixiv m =>+  -- | search target+  SearchTarget ->+  -- | word+  Text ->+  -- | includes translated tag+  Maybe Bool ->+  -- | sorting method+  Maybe SortingMethod ->+  -- | duration+  Maybe Duration ->+  -- | page+  Int ->+  m [Illust]+searchIllust searchTarget searchWord includeTranslatedTag sortingMethod duration (pageToOffset 30 -> offset) = do+  p <- getAccessTokenWithAccpetLanguage+  illusts <- clientIn (Proxy @SearchIllust) Proxy p searchTarget searchWord includeTranslatedTag sortingMethod duration offset+  pure $ unNextUrl illusts++-- | Searches an user.+searchUser ::+  MonadPixiv m =>+  -- | word+  Text ->+  -- | sorting method+  Maybe SortingMethod ->+  -- | page+  Int ->+  m [UserPreview]+searchUser searchWord sortingMethod (pageToOffset 30 -> offset) = do+  p <- getAccessTokenWithAccpetLanguage+  ups <- clientIn (Proxy @SearchUser) Proxy p searchWord sortingMethod offset+  pure $ unNextUrl ups++-----------------------------------------------------------------------------++-- | Gets the details of an user.+getUserDetail ::+  MonadPixiv m =>+  -- | user id+  Int ->+  m UserDetail+getUserDetail userId = do+  p <- getAccessTokenWithAccpetLanguage+  clientIn (Proxy @GetUserDetail) Proxy p userId++-- | Gets illustrations submitted by a specific user.+getUserIllusts ::+  MonadPixiv m =>+  -- | user id+  Int ->+  -- | illust type+  Maybe IllustType ->+  -- | page+  Int ->+  m [Illust]+getUserIllusts userId illustType (pageToOffset 30 -> offset) = do+  p <- getAccessTokenWithAccpetLanguage+  illusts <- clientIn (Proxy @GetUserIllusts) Proxy p userId illustType offset+  pure $ unNextUrl illusts++-- |  Gets the following of an user.+getUserFollowing ::+  MonadPixiv m =>+  -- | user id+  Int ->+  -- | restrict+  Publicity ->+  -- | page+  Int ->+  m [UserPreview]+getUserFollowing userId restrict (pageToOffset 30 -> offset) = do+  p <- getAccessTokenWithAccpetLanguage+  ups <- clientIn (Proxy @GetUserFollowing) Proxy p userId restrict offset+  pure $ unNextUrl ups++-- | Gets the followers of an user.+getUserFollower ::+  MonadPixiv m =>+  -- | user id+  Int ->+  -- | page+  Int ->+  m [UserPreview]+getUserFollower userId (pageToOffset 30 -> offset) = do+  p <- getAccessTokenWithAccpetLanguage+  ups <- clientIn (Proxy @GetUserFollower) Proxy p userId offset+  pure $ unNextUrl ups++-- | Gets @mypixiv@ of an user.+getUserMypixiv ::+  MonadPixiv m =>+  -- | user id+  Int ->+  -- | page+  Int ->+  m [UserPreview]+getUserMypixiv userId (pageToOffset 30 -> offset) = do+  p <- getAccessTokenWithAccpetLanguage+  ups <- clientIn (Proxy @GetUserMypixiv) Proxy p userId offset+  pure $ unNextUrl ups++-- | Gets illustrations collected by a specific user.+-- Returns the a list of illustrations and result and an integer for paging.+getUserBookmarks ::+  MonadPixiv m =>+  -- | user id+  Int ->+  -- | restrict+  Publicity ->+  -- | the last illust id of this query+  Maybe Int ->+  m ([Illust], Maybe Int)+getUserBookmarks userId restrict maxBookmarkId = do+  p <- getAccessTokenWithAccpetLanguage+  illusts <- clientIn (Proxy @GetUserBookmarks) Proxy p userId restrict maxBookmarkId+  pure (unNextUrl illusts, getNextUrl illusts >>= ((^? _Right . _1) . decimal . T.takeWhileEnd (/= '=')))++-----------------------------------------------------------------------------++-- | Gets spotlight articles+getSpotlightArticles ::+  MonadPixiv m =>+  -- | category+  Maybe Text ->+  -- | page+  Int ->+  m [SpotlightArticle]+getSpotlightArticles category (pageToOffset 10 -> offset) = do+  p <- getAccessTokenWithAccpetLanguage+  articles <- clientIn (Proxy @GetSpotlightArticles) Proxy p category offset+  pure $ unNextUrl articles

@@ -0,0 +1,13 @@+{-# OPTIONS_HADDOCK hide, prune #-}++module Web.Pixiv.API.Article+  ( module Web.Pixiv.API.Article,+  )+where++import Data.Text (Text)+import Servant.API+import Web.Pixiv.API.PixivEntry+import Web.Pixiv.Types++type GetSpotlightArticles = PixivEntry :> "v1" :> "spotlight" :> "articles" :> QueryParam "category" Text :> OffsetParam :> Get '[JSON] SpotlightArticles

@@ -0,0 +1,26 @@+{-# OPTIONS_HADDOCK hide, prune #-}++module Web.Pixiv.API.Illust+  ( module Web.Pixiv.API.Illust,+  )+where++import Servant.API+import Web.Pixiv.API.PixivEntry+import Web.Pixiv.Types++type IllustIdParam = QueryParam' '[Required, Strict] "illust_id" Int++type GetIllustDetail = PixivEntry :> "v1" :> "illust" :> "detail" :> IllustIdParam :> Get '[JSON] IllustWrapper++type GetIllustComments = PixivEntry :> "v1" :> "illust" :> "comments" :> IllustIdParam :> OffsetParam :> Get '[JSON] Comments++type GetIllustRelated = PixivEntry :> "v2" :> "illust" :> "related" :> IllustIdParam :> OffsetParam :> Get '[JSON] Illusts++type GetIllustRanking = PixivEntry :> "v1" :> "illust" :> "ranking" :> QueryParam "mode" RankMode :> OffsetParam :> Get '[JSON] Illusts++type GetIllustFollow = PixivEntry :> "v1" :> "illust" :> "follow" :> RestrictParam :> OffsetParam :> Get '[JSON] Illusts++type GetIllustNew = PixivEntry :> "v1" :> "illust" :> "new" :> OffsetParam :> Get '[JSON] Illusts++type GetUgoiraMetadata = PixivEntry :> "v1" :> "ugoira" :> "metadata" :> IllustIdParam :> Get '[JSON] UgoiraMetadataWrapper

@@ -0,0 +1,37 @@+{-# OPTIONS_HADDOCK hide, prune #-}++module Web.Pixiv.API.PixivEntry+  ( module Web.Pixiv.API.PixivEntry,+  )+where++import Data.Function ((&))+import Data.Proxy (Proxy (Proxy))+import Data.Text (Text)+import Servant.API (QueryParam, QueryParam', Required, Strict, type (:>))+import Servant.Client.Core (HasClient (..), addHeader, appendToQueryString)+import Web.Pixiv.Auth (Token (..))+import Web.Pixiv.Types (Publicity)++data PixivEntry++instance HasClient m api => HasClient m (PixivEntry :> api) where+  type Client m (PixivEntry :> api) = (Token, Maybe Text) -> Client m api+  clientWithRoute pm Proxy req = \(unToken -> token, mLanguage) ->+    clientWithRoute pm (Proxy @api) $+      req+        & addHeader @Text "User-Agent" "PixivAndroidApp/5.0.175 (Android 6.0; PixivHaskell)"+        & addHeader @Text "Authorization" ("Bearer " <> token)+        & appendToQueryString "filter" (Just "for_android")+        & maybe id (addHeader @Text "Accept-Language") mLanguage+  hoistClientMonad pm Proxy f m p =+    hoistClientMonad pm (Proxy @api) f (m p)++type OffsetParam = QueryParam "offset" Int++pageToOffset :: Int -> Int -> Maybe Int+pageToOffset perPage x+  | x > 1 = Just $ (x - 1) * perPage+  | otherwise = Nothing++type RestrictParam = QueryParam' '[Strict, Required] "restrict" Publicity

@@ -0,0 +1,28 @@+{-# OPTIONS_HADDOCK hide, prune #-}++module Web.Pixiv.API.Search+  ( module Web.Pixiv.API.Search,+  )+where++import Data.Text (Text)+import Servant.API+import Web.Pixiv.API.PixivEntry+import Web.Pixiv.Types++type SearchIllust =+  PixivEntry :> "v1" :> "search" :> "illust"+    :> QueryParam' '[Required, Strict] "search_target" SearchTarget+    :> QueryParam' '[Required, Strict] "word" Text+    :> QueryParam "include_translated_tag_results" Bool+    :> QueryParam "sort" SortingMethod+    :> QueryParam "duration" Duration+    :> OffsetParam+    :> Get '[JSON] Illusts++type SearchUser =+  PixivEntry :> "v1" :> "search" :> "user"+    :> QueryParam' '[Required, Strict] "word" Text+    :> QueryParam "sort" SortingMethod+    :> OffsetParam+    :> Get '[JSON] UserPreviews

@@ -0,0 +1,27 @@+{-# OPTIONS_HADDOCK hide, prune #-}++module Web.Pixiv.API.Trending+  ( module Web.Pixiv.API.Trending,+  )+where++import Servant.API+import Web.Pixiv.API.PixivEntry+import Web.Pixiv.Types++type GetTrendingTags =+  PixivEntry :> "v1" :> "trending-tags" :> "illust"+    :> QueryParam "include_translated_tag_results" Bool+    :> Get '[JSON] TrendingTags++type GetRecommendedIllusts =+  PixivEntry :> "v1" :> "illust" :> "recommended"+    :> QueryParam "include_privacy_policy" Bool+    :> QueryParam "include_ranking_illusts" Bool+    :> Get '[JSON] Illusts++type GetRecommendedMangas =+  PixivEntry :> "v1" :> "manga" :> "recommended"+    :> QueryParam "include_privacy_policy" Bool+    :> QueryParam "include_ranking_illusts" Bool+    :> Get '[JSON] Illusts

@@ -0,0 +1,50 @@+{-# OPTIONS_HADDOCK hide, prune #-}++module Web.Pixiv.API.User+  ( module Web.Pixiv.API.User,+  )+where++import Servant.API+import Web.Pixiv.API.PixivEntry+import Web.Pixiv.Types++type UserIdParam = QueryParam' '[Required, Strict] "user_id" Int++type GetUserDetail =+  PixivEntry :> "v1" :> "user" :> "detail"+    :> UserIdParam+    :> Get '[JSON] UserDetail++type GetUserIllusts =+  PixivEntry :> "v1" :> "user" :> "illusts"+    :> UserIdParam+    :> QueryParam "type" IllustType+    :> OffsetParam+    :> Get '[JSON] Illusts++type GetUserFollowing =+  PixivEntry :> "v1" :> "user" :> "following"+    :> UserIdParam+    :> RestrictParam+    :> OffsetParam+    :> Get '[JSON] UserPreviews++type GetUserFollower =+  PixivEntry :> "v1" :> "user" :> "follower"+    :> UserIdParam+    :> OffsetParam+    :> Get '[JSON] UserPreviews++type GetUserMypixiv =+  PixivEntry :> "v1" :> "user" :> "mypixiv"+    :> UserIdParam+    :> OffsetParam+    :> Get '[JSON] UserPreviews++type GetUserBookmarks =+  PixivEntry :> "v1" :> "user" :> "bookmarks" :> "illust"+    :> UserIdParam+    :> RestrictParam+    :> QueryParam "max_bookmark_id" Int+    :> Get '[JSON] Illusts

@@ -0,0 +1,162 @@+{-# 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 = "MOBrBDS8blbauoSck0ZfDbtuzpyT"++clientSecret :: ByteString+clientSecret = "lsACyCD94FhDUtGTXi3QzcFE2uU1hqtDaKeqrdwj"++hashSecret :: ByteString+hashSecret = "28c1fdd170a5204386cb1313c7077b34f83e4aaf4aa829ce78c231e05b0bae2c"++-- | A wrapped 'Text' represents a token.+newtype Token = Token {unToken :: Text}+  deriving stock (Show, Eq, Read)++deriveJSON defaultOptions {unwrapUnaryRecords = True} ''Token++instance IsString Token where+  fromString = Token . T.pack++-- | Authentication credentials for pixiv API.+--+-- Normally, users are supposed to create value of this data type using 'Password' constructor,+-- then pass it to 'Web.Pixiv.Types.PixivT.runPixivT'.+data Credential+  = Password+      { username :: ByteString,+        password :: ByteString+      }+  | RefreshToken+      { cr_refreshToken :: Token+      }+  deriving stock (Show, Eq)++mkAuthParts :: Applicative m => Credential -> [PartM m]+mkAuthParts Password {..} =+  [ partBS "grant_type" "password",+    partBS "username" username,+    partBS "password" password+  ]+mkAuthParts RefreshToken {..} =+  [ partBS "grant_type" "refresh_token",+    partBS "refresh_token" (encodeUtf8 . unToken $ cr_refreshToken)+  ]++-- | Successful result.+data OAuth2Token = OAuth2Token+  { oa_accessToken :: Token,+    oa_expiresIn :: Int,+    oa_refreshToken :: Token+  }+  deriving stock (Show, Eq, Read)++derivePixivJSON "oa_" ''OAuth2Token++-- | Authentication failure reasions.+data Errors+  = InvalidRequest+  | InvalidClient+  | InvalidGrant+  | UnauthorizedClient+  | UnsupportedGrantType+  | InvalidScope+  deriving stock (Show, Eq, Ord, Enum, Read)++deriveEnumJSON' ''Errors++-- | Failed result.+data OAuth2Error = OAuth2Error+  { oa_error :: Errors,+    oa_message :: Text+  }+  deriving stock (Show, Eq, Read)+  deriving anyclass (Exception)++instance FromJSON OAuth2Error where+  parseJSON = withObject "oauth2 response" $ \o -> do+    oa_error <- o .: "error"+    errors <- o .: "errors"+    oa_message <- flip (withObject "errors") errors $ \o' -> do+      system <- o' .: "system"+      flip (withObject "system") system $ \o'' -> do+        o'' .: "message"+    pure OAuth2Error {..}++-- | Authentication result.+data OAuth2Result+  = AuthSuccess OAuth2Token+  | AuthFailure OAuth2Error+  deriving stock (Show, Eq)++instance FromJSON OAuth2Result where+  parseJSON v =+    AuthSuccess <$> parseJSON v <|> AuthFailure <$> parseJSON v++-- | Given a credential, performs a authentication request.+auth :: Manager -> Credential -> IO OAuth2Result+auth manager credential = do+  let authUrl = "https://oauth.secure.pixiv.net/auth/token"+  initReq <- parseRequest authUrl+  utcT <- getCurrentTime+  let clientTime = C.pack $ formatTime defaultTimeLocale "%Y-%m-%dT%H:%I:%S+00:00" utcT+      clientHash = B16.encode $ hash $ clientTime <> hashSecret+      headers =+        [ ("User-Agent", "PixivAndroidApp/5.0.64 (Android 6.0)"),+          ("X-Client-Time", clientTime),+          ("X-Client-Hash", clientHash)+        ]+      req = initReq {requestHeaders = headers}+      parts =+        [ partBS "client_id" clientId,+          partBS "client_secret" clientSecret,+          partBS "get_secure_url" "1"+        ]+          ++ mkAuthParts credential+  finalReq <- formDataBody parts req+  resp <- httpLbs finalReq manager+  let body = responseBody resp+  maybe (fail "impossible: unable to parse response") pure (decode body)++-- | Like 'auth', but immediately throws 'OAuth2Error' if auth failed.+auth' :: Manager -> Credential -> IO OAuth2Token+auth' manager credential =+  auth manager credential >>= \case+    AuthSuccess t -> pure t+    AuthFailure err -> throwIO err

@@ -0,0 +1,112 @@+-- | 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+-- A set of utilities for downloading pixiv things.+module Web.Pixiv.Download+  ( -- * DownloadM monad+    DownloadM,+    liftMaybe,+    liftToPixivT,+    runDownloadM,++    -- * Download actions+    downloadPixiv,+    downloadSingleIllust,+    downloadUgoiraToMP4,+  )+where++import Control.Lens+import Control.Monad.Reader+import Control.Monad.Trans.Maybe+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import Network.HTTP.Client+import System.FilePath ((</>))+import System.IO.Temp (getCanonicalTemporaryDirectory, withTempDirectory)+import System.Process+import Web.Pixiv.Types+import Web.Pixiv.Types.Lens+import Web.Pixiv.Types.PixivT+import Web.Pixiv.Utils++-- | 'DownloadM' monad is a synonym for 'IO' computation wrapped in 'Manager' environment,+-- which may exit without producing value, indicating the download failed.+type DownloadM = MaybeT (ReaderT Manager IO)++-- | Lifts a pure 'Maybe' value to 'DownloadM'.+liftMaybe :: Maybe a -> DownloadM a+liftMaybe x = MaybeT . liftIO $ pure x++-- | Executes the download computation in 'IO'.+runDownloadM :: Manager -> DownloadM a -> IO (Maybe a)+runDownloadM manager m = runMaybeT m & flip runReaderT manager++-- | Lifts a download computation to 'PixivT'.+--+-- 'DownloadM' needs 'Manager' to perform the download, which can be provided by 'TokenState'.+liftToPixivT :: (MonadIO m) => DownloadM a -> PixivT m (Maybe a)+liftToPixivT m = do+  PixivState {tokenState = TokenState {..}} <- readPixivState+  liftIO $ runDownloadM manager m++-- | Downloads something in 'DownloadM', given url.+downloadPixiv :: Text -> DownloadM LBS.ByteString+downloadPixiv url = do+  let addReferer r = r {requestHeaders = [("Referer", "https://app-api.pixiv.net/")]}+  manager <- ask+  req <- addReferer <$> (parseRequest . T.unpack $ url)+  resp <- liftIO $ httpLbs req manager+  pure $ responseBody resp++-- | Downloads a single page illust.+--+-- Chooses the first one if the illust has many pages,+-- preferring high quality images. Returns `Nothing` if can't find any image url.+downloadSingleIllust :: Illust -> DownloadM LBS.ByteString+downloadSingleIllust i = do+  url <- liftMaybe $ extractImageUrlsFromIllust i ^? _head+  downloadPixiv url++-- | Downloads 'UgoiraFrame's, then converts it to MP4 calling external @ffmpeg@.+downloadUgoiraToMP4 ::+  -- | Information of ugoira to download+  UgoiraMetadata ->+  -- | Path to @ffmpeg@+  Maybe FilePath ->+  DownloadM (String, LBS.ByteString)+downloadUgoiraToMP4 meta (fromMaybe "ffmpeg" -> ffmpeg) = do+  let ffconcat = ugoiraMetadataToFFConcat meta+  bs0 <- downloadPixiv $ meta ^. zipUrls . zipMedium+  systmp <- liftIO getCanonicalTemporaryDirectory+  liftIO $+    withTempDirectory systmp "ugoira" $ \temp -> do+      unzipArchive temp bs0+      let concatFilePath = temp </> "concat"+          convertProcess =+            ( proc+                ffmpeg+                [ "-y",+                  "-i",+                  "concat",+                  "-c:v",+                  "libx264",+                  "-vf",+                  "pad=ceil(iw/2)*2:ceil(ih/2)*2",+                  "-pix_fmt",+                  "yuv420p",+                  "-lossless",+                  "1",+                  "ugoira.mp4"+                ]+            )+              { cwd = Just temp+              }+      BS.writeFile concatFilePath ffconcat+      (_code, _stdout, stderr) <- readCreateProcessWithExitCode convertProcess ""+      (stderr,) <$> LBS.readFile (temp </> "ugoira.mp4")

@@ -0,0 +1,110 @@+{-# 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+-- This module provides some TH functions to create instances+-- of 'FromJSON', 'ToJSON', and 'ToHttpApiData'.+-- You can find usages in "Web.Pixiv.Types" and "Web.Pixiv.Auth".+module Web.Pixiv.TH+  ( derivePixivJSON,+    derivePixivJSON',+    deriveEnumJSON,+    deriveEnumJSON',+    deriveEnumToHttpApiData,+    deriveEnumToHttpApiData',+    ToHttpApiData (..),+    FromJSON (..),+    ToJSON (..),+  )+where++import Data.Aeson (FromJSON (..), ToJSON (..), camelTo2)+import Data.Aeson.TH+import Data.List (stripPrefix)+import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import Language.Haskell.TH+import Servant.API (ToHttpApiData (..))++-----------------------------------------------------------------------------++-- | Creates instances of 'FromJSON' and 'ToJSON',+-- stripping @_@ and @prefix@ from field labels (making sure result is non-empty),+-- then converting into snake case.+derivePixivJSON :: String -> Name -> DecsQ+derivePixivJSON prefix =+  deriveJSON+    defaultOptions+      { fieldLabelModifier = modifyFieldName prefix+      }++-- | Like 'derivePixivJSON' but does not strip prefix.+derivePixivJSON' :: Name -> DecsQ+derivePixivJSON' = derivePixivJSON ""++-----------------------------------------------------------------------------++-- | Creates instances of 'FromJSON' and 'ToJSON',+-- stripping @prefix@ from constructor tags then converting+-- into snake case.+deriveEnumJSON :: String -> Name -> DecsQ+deriveEnumJSON prefix =+  deriveJSON+    defaultOptions+      { constructorTagModifier = modifyConsturctorName prefix+      }++-- | Like 'deriveEnumJSON' but does not strip prefix.+deriveEnumJSON' :: Name -> DecsQ+deriveEnumJSON' = deriveEnumJSON ""++-----------------------------------------------------------------------------++-- | Creates instance of 'ToHttpApiData' for a enum-like data type+-- which contains only plain normal constructors.+--+-- Constructor tags will be stripped @prefix@, then converted into snake case.+deriveEnumToHttpApiData :: String -> Name -> DecsQ+deriveEnumToHttpApiData prefix name =+  reify name >>= \case+    TyConI dec -> case dec of+      (DataD _ _dataName [] _ cons _) -> do+        let conNames = [n | (NormalC n []) <- cons]+        if length cons /= length conNames+          then error "Data type is not simply an enum"+          else do+            let clauses =+                  [ clause+                      [conP n []]+                      (normalB [|T.pack $ modifyConsturctorName prefix n'|])+                      []+                    | n <- conNames,+                      let n' = nameBase n+                  ]+            func <- funD (mkName "toQueryParam") clauses+            pure [InstanceD Nothing [] (ConT ''ToHttpApiData `AppT` ConT name) [func]]+      _ -> error "Unsupported data declaration"+    _ -> error "Not a plain type constructor"++-- | Like 'deriveEnumToHttpApiData' but does not strip prefix.+deriveEnumToHttpApiData' :: Name -> DecsQ+deriveEnumToHttpApiData' = deriveEnumToHttpApiData ""++-----------------------------------------------------------------------------++camel2Snake :: String -> String+camel2Snake = camelTo2 '_'++modifyFieldName :: String -> String -> String+modifyFieldName prefix s = camel2Snake $ case stripPrefix prefix s' of+  Nothing -> s'+  Just "" -> s'+  Just x -> x+  where+    s' = fromMaybe s (stripPrefix "_" s)++modifyConsturctorName :: String -> String -> String+modifyConsturctorName prefix = camel2Snake . (fromMaybe <*> stripPrefix prefix)

@@ -0,0 +1,598 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# 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+-- Data types used in API. This module enables [DuplicateRecordFields](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DuplicateRecordFields),+-- so please consider using "Web.Pixiv.Types.Lens" to access fields smoothly.+module Web.Pixiv.Types+  ( -- * ImageUrl+    ImageUrl,+    ImageUrls (..),+    OriginalImageUrl (..),++    -- * Tag+    Tag (..),+    TrendingTag (..),+    TrendingTags (..),++    -- * Illustration+    Series (..),+    IllustType (..),+    MetaPage (..),+    Illust (..),+    Illusts (..),+    IllustWrapper (..),++    -- * User+    User (..),+    UserProfile (..),+    Publicity (..),+    ProfilePublicity (..),+    Workspace (..),+    UserDetail (..),+    UserPreview (..),+    UserPreviews (..),++    -- * Comment+    Comment (..),+    Comments (..),++    -- * NextUrl+    NextUrlLess,+    HasNextUrl (..),++    -- * Ugoria+    UgoiraFrame (..),+    ZipUrls (..),+    UgoiraMetadata (..),+    UgoiraMetadataWrapper (..),++    -- * Article+    SpotlightArticle (..),+    SpotlightArticles (..),++    -- * Http+    RankMode (..),+    SearchTarget (..),+    SortingMethod (..),+    Duration (..),+  )+where++import qualified Data.Aeson as A+import Data.Text (Text)+import Data.Time (UTCTime)+import Web.Pixiv.TH++-- | Undecorate @next_url@ of a type.+--+-- @next_url@ is returned by some APIs for paging.+type family NextUrlLess a++-- | Class to get or unwrap @next_url@.+class HasNextUrl a where+  unNextUrl :: a -> NextUrlLess a+  getNextUrl :: a -> Maybe Text++-----------------------------------------------------------------------------++-- | Image urls are represented in 'Text'.+type ImageUrl = Text++-- | An object contains image urls.+--+-- * Example in 'Illust' or 'MetaPage':+--   @+--     "image_urls": {+--       "square_medium": "...",+--       "medium": "...",+--       "large": "..."+--     }+--   @+-- * Example in 'User':+--   @+--     "profile_image_urls": {+--       "medium": "..."+--     }+--   @+data ImageUrls = ImageUrls+  { _squareMedium :: Maybe ImageUrl,+    _medium :: Maybe ImageUrl,+    _large :: Maybe ImageUrl,+    _original :: Maybe ImageUrl+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''ImageUrls++-----------------------------------------------------------------------------++-- | An object contains a single image url.+--+-- In 'Illust':+--   @+--     "meta_single_page": {+--       "original_image_url": "..."+--     }+--   @+newtype OriginalImageUrl = OriginalImageUrl+  { _originalImageUrl :: Maybe ImageUrl+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''OriginalImageUrl++-----------------------------------------------------------------------------++-- | A tag.+--+-- Example:+-- @+--   {+--     "name": "...",+--     "translated_name": null+--   }+-- @+data Tag = Tag+  { _name :: Text,+    _translatedName :: Maybe Text+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''Tag++-----------------------------------------------------------------------------++-- | Type of illustration.+--+-- In pixiv API, all of illustrations, mangas, and ugoiras are represented in 'Illust' data type.+-- So they can be distinguished by 'IllustType'.+data IllustType = TypeIllust | TypeManga | TypeUgoira+  deriving stock (Eq, Ord, Enum, Show, Read)++deriveEnumJSON "Type" ''IllustType+deriveEnumToHttpApiData "Type" ''IllustType++-----------------------------------------------------------------------------++-- | Manga series.+data Series = Series+  { _seriesId :: Int,+    _title :: Text+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON "series" ''Series++-----------------------------------------------------------------------------++-- | A page of 'Illust' containing 'ImageUrls'.+newtype MetaPage = MetaPage+  { _imageUrls :: ImageUrls+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''MetaPage++-----------------------------------------------------------------------------++-- | User data type.+data User = User+  { _userId :: Int,+    _name :: Text,+    _account :: Text,+    _profileImageUrls :: ImageUrls,+    _comment :: Maybe Text,+    -- | For login account.+    _isFollowed :: Maybe Bool+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON "user" ''User++-----------------------------------------------------------------------------++-- | Illustraion data type.+--+-- See 'IllustType'.+data Illust = Illust+  { _illustId :: Int,+    _title :: Text,+    _illustType :: IllustType,+    _imageUrls :: ImageUrls,+    _caption :: Text,+    _restrict :: Int,+    _user :: User,+    _tags :: [Tag],+    _tools :: [Text],+    _createDate :: UTCTime,+    _pageCount :: Int,+    _width :: Int,+    _height :: Int,+    _sanityLevel :: Int,+    _xRestrict :: Int,+    -- | Only manga may have this field.+    _series :: Maybe Series,+    -- | Only single page illustration has this field.+    _metaSinglePage :: Maybe OriginalImageUrl,+    -- | Only multi page illustration has this field.+    _metaPages :: [MetaPage],+    _totalView :: Int,+    _totalBookmarks :: Int,+    -- | For login account.+    _isBookmarked :: Bool,+    _visible :: Bool,+    _isMuted :: Bool,+    _totalComments :: Maybe Int+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON "illust" ''Illust++-----------------------------------------------------------------------------++-- | A trending tag.+--+-- Don't confuse with 'Tag'. 'TrendingTag' contains 'Illust',+-- and the textual name of the tag is called @tag@, instead of @name@ in 'Tag'.+data TrendingTag = TrendingTag+  { -- This is ugly, not consistent with normal 'Tag'+    _trendTag :: Text,+    _translatedName :: Maybe Text,+    _illust :: Illust+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON "trend" ''TrendingTag++-----------------------------------------------------------------------------++-- | A wrapper of 'TrendingTag's for JSON deserialization.+newtype TrendingTags = TrendingTags+  { _trend_tags :: [TrendingTag]+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''TrendingTags++-----------------------------------------------------------------------------++-- | Response of API which returns illustrations.+data Illusts = Illusts+  { _illusts :: [Illust],+    _nextUrl :: Maybe Text+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''Illusts++type instance NextUrlLess Illusts = [Illust]++instance HasNextUrl Illusts where+  unNextUrl Illusts {..} = _illusts+  getNextUrl Illusts {..} = _nextUrl++-----------------------------------------------------------------------------++-- | A wrapper of 'Illust' for JSON deserialization.+newtype IllustWrapper = IllustWrapper+  { _illust :: Illust+  }+  deriving stock (Show, Eq, Read)++derivePixivJSON' ''IllustWrapper++-----------------------------------------------------------------------------++-- | UserProfile data type.+--+-- Not sure if all fields are covered, and maybe some fields should be optional.+data UserProfile = UserProfile+  { _webpage :: Maybe Text,+    _gender :: Text,+    _birth :: Text,+    _birthDay :: Text,+    _birthYear :: Int,+    _region :: Text,+    _addressId :: Int,+    _countryCode :: Text,+    _job :: Text,+    _jobId :: Int,+    _totalFollowUsers :: Int,+    _totalMypixivUsers :: Int,+    _totalIllusts :: Int,+    _totalManga :: Int,+    _totalIllustBookmarksPublic :: Int,+    _totalIllustSeries :: Int,+    _totalNovelSeries :: Int,+    _backgroundImageUrl :: Maybe ImageUrl,+    _twitterAccount :: Text,+    _twitterUrl :: Maybe Text,+    _pawooUrl :: Maybe Text,+    _isPreminum :: Maybe Bool,+    _isUsingCustomProfileImage :: Bool+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''UserProfile++-----------------------------------------------------------------------------++-- | Publicity data type.+--+-- The value @public@ or @private@ are present in 'ProfilePublicity'.+-- This type is also used in @restrict@ query param.+data Publicity+  = Public+  | Private+  | -- | May not be available in @restrict@ query param+    Mypixiv+  deriving stock (Eq, Ord, Enum, Show, Read)++deriveEnumJSON' ''Publicity+deriveEnumToHttpApiData' ''Publicity++-----------------------------------------------------------------------------++-- | Profile publicity of a user.+--+-- Not sure if all fields are covered, and maybe some fields should be optional.+data ProfilePublicity = ProfilePublicity+  { _gender :: Publicity,+    _region :: Publicity,+    _birthDay :: Publicity,+    _birthYear :: Publicity,+    _job :: Publicity,+    _pawoo :: Bool+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''ProfilePublicity++-----------------------------------------------------------------------------++-- | Workspace information of a user.+-- Not sure if all fields are covered, and maybe some fields should be optional.+data Workspace = Workspace+  { _pc :: Text,+    _monitor :: Text,+    _tool :: Text,+    _scanner :: Text,+    _tablet :: Text,+    _mouse :: Text,+    _printer :: Text,+    _desktop :: Text,+    _music :: Text,+    _desk :: Text,+    _chair :: Text,+    _comment :: Text,+    _workspaceImageUrl :: Maybe Text+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''Workspace++-----------------------------------------------------------------------------++-- | Details of a user.+data UserDetail = UserDetail+  { _user :: User,+    _profile :: UserProfile,+    _profilePublicity :: ProfilePublicity,+    _workspace :: Workspace+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''UserDetail++-----------------------------------------------------------------------------++-- | A preview of user information.+--+-- Except 'Web.Pixiv.API.getUserDetail', other API involving users return this data type.+data UserPreview = UserPreview+  { _user :: User,+    _illusts :: [Illust],+    -- | Novels are not supported currently.+    _novels :: A.Value,+    _isMuted :: Bool+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''UserPreview++-----------------------------------------------------------------------------++-- | Response of API which returns user previews.+data UserPreviews = UserPreviews+  { _userPreviews :: [UserPreview],+    _nextUrl :: Maybe Text+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''UserPreviews++type instance NextUrlLess UserPreviews = [UserPreview]++instance HasNextUrl UserPreviews where+  unNextUrl UserPreviews {..} = _userPreviews+  getNextUrl UserPreviews {..} = _nextUrl++-----------------------------------------------------------------------------++-- | A comment.+data Comment = Comment+  { _commentId :: Int,+    _comment :: Text,+    _date :: UTCTime,+    _user :: User,+    -- TODO+    _parentComment :: Maybe A.Value+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON "comment" ''Comment++-----------------------------------------------------------------------------++-- | Response of API which returns comments.+data Comments = Comments+  { _totalComments :: Int,+    _comments :: [Comment],+    _nextUrl :: Maybe Text+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''Comments++type instance NextUrlLess Comments = [Comment]++instance HasNextUrl Comments where+  unNextUrl Comments {..} = _comments+  getNextUrl Comments {..} = _nextUrl++-----------------------------------------------------------------------------++-- | A ugoira frame.+data UgoiraFrame = UgoiraFrame+  { -- | File name.+    _ugoiraFile :: Text,+    -- | Duration of this frame (in millisecond).+    _ugoiraDelay :: Int+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON "ugoira" ''UgoiraFrame++-----------------------------------------------------------------------------++-- | A wrapper of ugoira zip file url.+newtype ZipUrls = ZipUrls+  { _zipMedium :: Text+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON "zip" ''ZipUrls++-----------------------------------------------------------------------------++-- | Ugoira is a frame animation, whose common information is represented in 'Illust'.+-- This metadata contains a link to download the zip archive, which compresses frames of the ugoira;+-- and 'UgoiraFrame's to represents metadata of each frame.+-- Using 'Web.Pixiv.API.getUgoiraMetadata' can obtain value of this type.+-- See 'Web.Pixiv.Utils.ugoiraMetadataToFFConcat' and 'Web.Pixiv.Download.downloadUgoiraToMP4'.+data UgoiraMetadata = UgoiraMetadata+  { _zipUrls :: ZipUrls,+    _frames :: [UgoiraFrame]+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''UgoiraMetadata++-----------------------------------------------------------------------------++-- | A wrapper of 'UgoiraMetadata' for JSON deserialization.+newtype UgoiraMetadataWrapper = UgoiraMetadataWrapper+  { _ugoiraMetadata :: UgoiraMetadata+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''UgoiraMetadataWrapper++-----------------------------------------------------------------------------++-- | Spotlight article.+data SpotlightArticle = SpotlightArticle+  { _saId :: Int,+    _title :: Text,+    _pureTitle :: Text,+    _thumbnail :: Text,+    _articleUrl :: Text,+    _publishDate :: UTCTime,+    _category :: Text,+    _subcategoryLabel :: Text+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''SpotlightArticle++-----------------------------------------------------------------------------++-- | Response of API which returns spotlight articles.+data SpotlightArticles = SpotlightArticles+  { _spotlightArticles :: [SpotlightArticle],+    _nextUrl :: Maybe Text+  }+  deriving stock (Eq, Show, Read)++derivePixivJSON' ''SpotlightArticles++type instance NextUrlLess SpotlightArticles = [SpotlightArticle]++instance HasNextUrl SpotlightArticles where+  unNextUrl SpotlightArticles {..} = _spotlightArticles+  getNextUrl SpotlightArticles {..} = _nextUrl++-----------------------------------------------------------------------------++-- | Rank mode query parm.+--+-- See 'Web.Pixiv.API.getIllustRanking'+data RankMode+  = Day+  | DayR18+  | DayMale+  | DayMaleR18+  | DayFemale+  | DayFemaleR18+  | Week+  | WeekR18+  | WeekR18G+  | Month+  | WeekOriginal+  | WeekRookie+  | DayManga+  deriving stock (Show, Eq, Ord, Enum, Read)++deriveEnumToHttpApiData' ''RankMode++-----------------------------------------------------------------------------++-- | Sorting method query parm.+--+-- See 'Web.Pixiv.API.searchIllust' and 'Web.Pixiv.API.searchUser'.+data SortingMethod+  = DateDesc+  | DateAsc+  deriving stock (Show, Eq, Ord, Enum, Read)++deriveEnumToHttpApiData' ''SortingMethod++-----------------------------------------------------------------------------++-- | Duration query parm.+--+-- See 'Web.Pixiv.API.searchIllust'.+data Duration+  = WithinLastDay+  | WithinLastMonth+  | WithinLastYear+  deriving stock (Show, Eq, Ord, Read)++deriveEnumToHttpApiData' ''Duration++-----------------------------------------------------------------------------++-- | Search target query parm.+--+-- See 'Web.Pixiv.API.searchIllust'.+data SearchTarget = ExactMatchForTags | PartialMatchForTags | TitleAndCaption+  deriving stock (Show, Eq, Ord, Enum, Read)++deriveEnumToHttpApiData' ''SearchTarget++-----------------------------------------------------------------------------

@@ -0,0 +1,48 @@+{-# 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+-- Lenses of "Web.Pixiv.Types".+module Web.Pixiv.Types.Lens+  ( module Web.Pixiv.Types.Lens,+  )+where++import Control.Lens.TH+import Web.Pixiv.Types++-----------------------------------------------------------------------------+makeFieldsNoPrefix ''ImageUrls+makeFieldsNoPrefix ''OriginalImageUrl++-----------------------------------------------------------------------------+makeFieldsNoPrefix ''Tag++-----------------------------------------------------------------------------+makeFieldsNoPrefix ''Series+makeFieldsNoPrefix ''Illust+makeFieldsNoPrefix ''MetaPage++-----------------------------------------------------------------------------+makeFieldsNoPrefix ''User+makeFieldsNoPrefix ''UserProfile+makeFieldsNoPrefix ''ProfilePublicity+makeFieldsNoPrefix ''Workspace+makeFieldsNoPrefix ''UserDetail++-----------------------------------------------------------------------------+makeFieldsNoPrefix ''TrendingTag++-----------------------------------------------------------------------------+makeFieldsNoPrefix ''Comment++-----------------------------------------------------------------------------+makeFieldsNoPrefix ''UserPreview++-----------------------------------------------------------------------------+makeFieldsNoPrefix ''UgoiraFrame+makeFieldsNoPrefix ''ZipUrls+makeFieldsNoPrefix ''UgoiraMetadata

@@ -0,0 +1,257 @@+{-# 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+  { unClientT :: ReaderT ClientEnv (ExceptT ClientError m) a+  }+  deriving newtype+    ( Functor,+      Applicative,+      Monad,+      MonadIO,+      MonadThrow,+      MonadCatch,+      MonadReader ClientEnv,+      MonadError ClientError,+      MonadBase b,+      MonadBaseControl b+    )++instance MonadTrans ClientT where+  lift = ClientT . lift . lift++-- | Executes a computation in the client monad.+runClientT :: ClientEnv -> ClientT m a -> m (Either ClientError a)+runClientT env m =+  m+    & unClientT+    & flip runReaderT env+    & runExceptT++instance MonadIO m => RunClient (ClientT m) where+  throwClientError = throwError+  runRequestAcceptStatus status req = do+    env <- ask+    let m = performRequest status req+    res <- liftIO $ runClientM m env+    liftEither res++-- | Given 'Manager', creates a 'ClientEnv' using <https://app-api.pixiv.net> as base url.+mkDefaultClientEnv :: Manager -> IO ClientEnv+mkDefaultClientEnv manager = do+  baseUrl <- parseBaseUrl "https://app-api.pixiv.net"+  pure $ mkClientEnv manager baseUrl++-- | Pixiv auth state.+data TokenState = TokenState+  { -- | Token to access pixiv api.+    accessToken :: Token,+    -- | Token to obtain new 'accessToken' without giving username and password.+    refreshToken :: Token,+    -- | Time stamp when 'accessToken' becomes invalid.+    expirationTime :: UTCTime,+    manager :: Manager+  }+  deriving stock (Generic)++instance Show TokenState where+  showsPrec d TokenState {..} =+    showParen (d >= 11) $+      showString "TokenState {"+        . showString "accessToken = "+        . shows accessToken+        . showCommaSpace+        . showString "refreshToken = "+        . shows refreshToken+        . showCommaSpace+        . showString "expirationTime = "+        . shows expirationTime+        . showString "}"++-- | State stored in 'MonadPixiv'.+data PixivState = PixivState+  { tokenState :: TokenState,+    acceptLanguage :: Maybe Text+  }+  deriving stock (Generic, Show)++-- | A thread safe implementation of 'MonadPixiv'.+newtype PixivT m a = PixivT+  { unPixivT :: ReaderT (MVar PixivState) (ClientT m) a+  }+  deriving newtype+    ( Functor,+      Applicative,+      Monad,+      MonadIO,+      MonadThrow,+      MonadCatch,+      MonadReader (MVar PixivState),+      MonadError ClientError+    )+  deriving stock (Generic)++instance MonadTrans PixivT where+  lift = PixivT . lift . 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 = PixivT . lift++instance MonadIO m => RunClient (PixivT m) where+  throwClientError = throwError+  runRequestAcceptStatus status req =+    liftC $ runRequestAcceptStatus status 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 = lift takePixivState+  putPixivState = lift . putPixivState+  readPixivState = lift readPixivState++instance MonadIO m => MonadPixiv (PixivT m) where+  takePixivState = ask >>= liftIO . takeMVar+  putPixivState s = do+    ref <- ask+    liftIO $ putMVar ref s+  readPixivState = ask >>= liftIO . readMVar++-- | Interprets the 'PixivT' effect, with a supplied 'Manager'.+runPixivT :: MonadIO m => Manager -> Credential -> PixivT m a -> m (Either ClientError a)+runPixivT manager credential m = do+  t <- liftIO getCurrentTime+  s <- liftIO $ computeTokenState manager credential t+  clientEnv <- liftIO $ mkDefaultClientEnv manager+  ref <- liftIO . newMVar $ PixivState s Nothing+  m+    & unPixivT+    & flip runReaderT ref+    & runClientT clientEnv++-- | Like 'runPixivT', but creates a new 'Manager' everytime.+runPixivT' :: MonadIO m => Credential -> PixivT m a -> m (Either ClientError a)+runPixivT' credential m = do+  manager <- liftIO newTlsManager+  runPixivT manager credential 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 time = do+  OAuth2Token {..} <- liftIO $ auth' manager credential+  let offset = oa_expiresIn `div` 5 * 4+      diff = secondsToNominalDiffTime $ toEnum offset+      accessToken = oa_accessToken+      refreshToken = oa_refreshToken+      expirationTime = addUTCTime diff time+  pure TokenState {..}++-- | Retrieves the 'accessToken' from pixiv monad.+--+-- If the token is overdue, it will call 'computeTokenState' to refresh.+getAccessToken :: MonadPixiv m => m Token+getAccessToken = do+  s@PixivState {tokenState = TokenState {..}} <- takePixivState+  t <- liftIO getCurrentTime+  if t < expirationTime+    then do+      putPixivState s+      pure accessToken+    else do+      let credential = RefreshToken refreshToken+      ts <- liftIO $ computeTokenState manager credential t+      putPixivState s {tokenState = ts}+      pure accessToken++-- | Retrieves the 'acceptLanguage' from pixiv monad.+getAccpetLanguage :: MonadPixiv m => m (Maybe Text)+getAccpetLanguage = acceptLanguage <$> readPixivState++-- | Retrieves the 'accessToken' and 'acceptLanguage' in one go.+getAccessTokenWithAccpetLanguage :: MonadPixiv m => m (Token, Maybe Text)+getAccessTokenWithAccpetLanguage = (,) <$> getAccessToken <*> getAccpetLanguage

@@ -0,0 +1,82 @@+-- | 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+-- Miscellaneous utilities.+module Web.Pixiv.Utils+  ( isSinglePageIllust,+    extractHighestQualityImageUrl,+    extractImageUrlsFromIllust,+    unzipArchive,+    ugoiraMetadataToFFConcat,+  )+where++import qualified Codec.Archive.Zip as Zip+import Control.Applicative ((<|>))+import Control.Lens+import Control.Monad (join)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)+import Numeric (showFFloat)+import Web.Pixiv.Types+import Web.Pixiv.Types.Lens++-----------------------------------------------------------------------------++-- | Judges if an illustration has only one image.+isSinglePageIllust :: Illust -> Bool+isSinglePageIllust i = null $ i ^. metaPages++-- | Extracts the url of the highest quality image.+extractHighestQualityImageUrl :: ImageUrls -> Maybe Text+extractHighestQualityImageUrl x =+  x ^. original+    <|> x ^. large+    <|> x ^. medium+    <|> x ^. squareMedium++-- | Extracts all urls from an illustration, using 'extractHighestQualityImageUrl'.+extractImageUrlsFromIllust :: Illust -> [Text]+extractImageUrlsFromIllust i+  | isSinglePageIllust i = (single <|> (multi ^? _head)) ^.. each+  | otherwise = multi+  where+    single = join $ (i ^. metaSinglePage) & each %~ (^. originalImageUrl)+    multi = (i ^. metaPages ^.. each . imageUrls <&> extractHighestQualityImageUrl) ^.. each . _Just++-----------------------------------------------------------------------------++-- | Unzip a zip archive represented in 'LBS.ByteString' to a directory.+unzipArchive ::+  -- | destination directory+  FilePath ->+  -- | zip archive+  LBS.ByteString ->+  IO ()+unzipArchive dir bs = do+  let archive = Zip.toArchive bs+      option = [Zip.OptDestination dir]+  Zip.extractFilesFromArchive option archive++-- | Generates ffconcat meta file of an ugoira.+ugoiraMetadataToFFConcat :: UgoiraMetadata -> BS.ByteString+ugoiraMetadataToFFConcat meta =+  encodeUtf8 . T.unlines $+    "ffconcat version 1.0" :+      [ T.unlines+          [ "file " <> frame ^. ugoiraFile,+            "duration "+              <> T.pack+                ( frame ^. ugoiraDelay+                    & fromIntegral+                    & (/ 1000)+                    & flip (showFFloat @Double Nothing) ""+                )+          ]+        | frame <- meta ^. frames+      ]

@@ -0,0 +1,48 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Main (main) where++import Data.Aeson+import qualified Data.ByteString.Lazy as LBS+import Network.HTTP.Client.TLS (newTlsManager)+import Web.Pixiv.Download+import Web.Pixiv.Types++main :: IO ()+main = do+  testDecode @Comments "test/illust_comments.json"+  testDecode @Illusts "test/illust_related.json"+  testDecode @UserDetail "test/user_detail.json"+  testDecode @Illusts "test/user_illusts.json"+  testDecode @TrendingTags "test/trending_tags.json"+  testDecode @Illusts "test/search_illust.json"+  testDecode @UserPreviews "test/user_follower.json"+  testDecode @UserPreviews "test/user_following.json"+  testDecode @UserPreviews "test/user_mypixiv.json"++  manager <- newTlsManager++  pillust <- eitherDecodeFileStrict @IllustWrapper "test/illust_detail.json"+  case pillust of+    Left err -> fail err+    Right IllustWrapper {..} -> do+      mresult <- runDownloadM manager $ downloadSingleIllust _illust+      case mresult of+        Just result -> LBS.writeFile "temp.jpg" result >> putStrLn "Write jpg"+        _ -> fail "Failed to download"+  pmetadata <- eitherDecodeFileStrict @UgoiraMetadataWrapper "test/ugoira_metadata.json"+  case pmetadata of+    Left err -> fail err+    Right UgoiraMetadataWrapper {..} -> do+      mresult <- runDownloadM manager $ downloadUgoiraToMP4 _ugoiraMetadata Nothing+      case mresult of+        Just (stderr, result) -> do+          putStrLn stderr+          LBS.writeFile "temp.mp4" result >> putStrLn "Write mp4"+        _ -> fail "Failed to download"++testDecode :: forall v. (FromJSON v) => FilePath -> IO ()+testDecode path =+  eitherDecodeFileStrict @v path >>= \case+    Left err -> fail err+    Right _ -> putStrLn "Pass"