packages feed

exh (empty) → 0.1.0

raw patch · 20 files changed

+1436/−0 lines, 20 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, conduit, containers, exceptions, exh, hspec, html-conduit, http-client, http-client-tls, http-conduit, lens, megaparsec, monad-control, monad-time, mtl, quickjs-hs, retry, text, time, transformers, transformers-base, xml-conduit, xml-lens

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# exh++## 0.1.0++Initial release
+ LICENSE view
@@ -0,0 +1,11 @@+Copyright (c) 2021 Poscat++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.
+ README.md view
@@ -0,0 +1,1 @@+# exh
+ exh.cabal view
@@ -0,0 +1,113 @@+cabal-version:   3.0+name:            exh+version:         0.1.0+synopsis:        A library for crawling exhentai+description:+  A library for crawling exhentai, with the support of streaming++category:        Web+license:         BSD-3-Clause+license-file:    LICENSE+author:          Poscat+maintainer:      Poscat <poscat@mail.poscat.moe>+copyright:       Copyright (c) Poscat 2021+stability:       alpha+homepage:        https://github.com/poscat0x04/exh+bug-reports:     https://github.com/poscat0x04/exh/issues+extra-doc-files:+  CHANGELOG.md+  README.md++common common-attrs+  build-depends:+    , aeson              ^>=1.5.4+    , base               >=4.10    && <5+    , bytestring         >=0.10.12 && <0.12+    , conduit            ^>=1.3.4+    , containers         ^>=0.6.2+    , exceptions         ^>=0.10.4+    , html-conduit       ^>=1.3.2+    , http-client        >=0.6.4   && <0.8+    , http-client-tls    ^>=0.3.5+    , http-conduit       ^>=2.3.7+    , lens               ^>=4.19+    , megaparsec         ^>=9.0+    , monad-control      ^>=1.0.2+    , monad-time         ^>=0.3+    , mtl                ^>=2.2+    , quickjs-hs         ^>=0.1.2.4+    , retry              ^>=0.8.1+    , text               ^>=1.2.3+    , time               >=1.9.3   && <1.12+    , transformers       ^>=0.5.6+    , transformers-base  ^>=0.4.5+    , xml-conduit        >=1.8.0   && <1.10+    , xml-lens           >=0.2     && <0.4++  default-language:   Haskell2010+  default-extensions:+    NoStarIsType+    BangPatterns+    ConstraintKinds+    DataKinds+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    DuplicateRecordFields+    EmptyCase+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    InstanceSigs+    KindSignatures+    LambdaCase+    MultiWayIf+    OverloadedStrings+    PartialTypeSignatures+    PatternSynonyms+    RecordWildCards+    ScopedTypeVariables+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators+    UnicodeSyntax+    ViewPatterns++library+  import:          common-attrs+  build-depends:+  exposed-modules:+    Web.Exhentai+    Web.Exhentai.API.Archiver+    Web.Exhentai.API.Auth+    Web.Exhentai.API.Gallery+    Web.Exhentai.API.MPV+    Web.Exhentai.API.Search+    Web.Exhentai.API.Watched+    Web.Exhentai.Errors+    Web.Exhentai.Parsing.Gallery+    Web.Exhentai.Parsing.Image+    Web.Exhentai.Parsing.MPV+    Web.Exhentai.Parsing.Search+    Web.Exhentai.Types+    Web.Exhentai.Types.CookieT+    Web.Exhentai.Utils++  other-modules:+  hs-source-dirs:  src++test-suite exh-test+  import:         common-attrs+  type:           exitcode-stdio-1.0+  build-depends:+    , exh+    , hspec++  hs-source-dirs: test+  main-is:        Spec.hs++source-repository head+  type:     git+  location: https://github.com/poscat0x04/exh
+ src/Web/Exhentai.hs view
@@ -0,0 +1,27 @@+module Web.Exhentai+  ( -- ** Authentication+    module Au,++    -- ** Getting information about galleries+    module G,++    -- ** Fetching images from galleries+    module M,++    -- ** Searching galleries+    module S,++    -- ** Getting popular and watched galleries+    module W,++    -- ** Fetching archives+    module Ar,+  )+where++import Web.Exhentai.API.Archiver as Ar+import Web.Exhentai.API.Auth as Au+import Web.Exhentai.API.Gallery as G+import Web.Exhentai.API.MPV as M+import Web.Exhentai.API.Search as S+import Web.Exhentai.API.Watched as W
+ src/Web/Exhentai/API/Archiver.hs view
@@ -0,0 +1,68 @@+module Web.Exhentai.API.Archiver+  ( streamOriginal,+    streamResampled,+  )+where++import Conduit+import Control.Lens (Traversal')+import Control.Monad.Catch+import Control.Monad.Cont+import Data.ByteString (ByteString)+import Data.Text (Text, unpack)+import Network.HTTP.Client.Conduit+import Network.HTTP.Client.MultipartFormData+import Text.XML.Lens+import Web.Exhentai.Errors+import Web.Exhentai.Types.CookieT+import Web.Exhentai.Utils+import Prelude hiding (id)++downloadLink :: Traversal' Element Text+downloadLink = id "db" ... id "continue" ... attr "href"++originalParts :: [Part]+originalParts =+  [ partBS "dltype" "org",+    partBS "dlcheck" "Download Original Archive"+  ]+{-# INLINE originalParts #-}++resampledParts :: [Part]+resampledParts =+  [ partBS "dltype" "res",+    partBS "dlcheck" "Download Resample Archive"+  ]+{-# INLINE resampledParts #-}++streamWith :: (MonadHttpState m, MonadIO n) => [Part] -> Text -> ContT r m (Response (ConduitT i ByteString n ()))+streamWith parts url = ContT $ \k -> do+  initReq <- formRequest $ unpack url+  req <- formDataBody parts initReq+  d <- htmlRequest req+  case d ^?: downloadLink of+    Nothing -> throwM $ XMLParseFailure url+    Just l -> do+      newReq <- formRequest $ unpack l+      let req' = setQueryString [("start", Just "1")] newReq+      retryWhenTimeout $+        bracket+          (respOpen req')+          respClose+          k++-- | Download an origian archive from an archiver url as a stream+streamOriginal ::+  (MonadHttpState m, MonadIO n) =>+  -- | Archiver url, usually the 'archiverLink` field+  Text ->+  ContT r m (Response (ConduitT i ByteString n ()))+streamOriginal = streamWith originalParts++-- | Download an resampled archive from an archiver url as a stream+streamResampled ::+  (MonadHttpState m, MonadIO n) =>+  -- | Archiver url, usually the 'archiverLink` field+  Text ->+  ContT r m (Response (ConduitT i ByteString n ()))+streamResampled = streamWith resampledParts
+ src/Web/Exhentai/API/Auth.hs view
@@ -0,0 +1,44 @@+module Web.Exhentai.API.Auth+  ( Credential (..),+    auth,+  )+where++import Data.ByteString (ByteString)+import Network.HTTP.Client.Conduit+import Network.HTTP.Client.MultipartFormData+import Web.Exhentai.Types.CookieT++data Credential = Credential+  { username :: ByteString,+    password :: ByteString+  }+  deriving (Show, Eq)++-- | Authenticates and loads user preferences.+-- This should be called before any other functions are called+auth :: MonadHttpState m => Credential -> m ()+auth Credential {..} = do+  initReq <- formRequest "POST https://forums.e-hentai.org/index.php"+  let parts =+        [ partBS "CookieDate" "1",+          partBS "b" "d",+          partBS "bt" "1-6",+          partBS "UserName" username,+          partBS "PassWord" password,+          partBS "ipb_login_submit" "Login!"+        ]+  let req =+        setQueryString+          [ ("act", Just "Login"),+            ("CODE", Just "01")+          ]+          initReq+  finalReq <- attachFormData parts req+  modifyingJar finalReq+  req2 <- formRequest "https://exhentai.org"+  modifyingJar req2+  req3 <- formRequest "https://exhentai.org/uconfig.php"+  modifyingJar req3+  req4 <- formRequest "https://exhentai.org/mytags"+  modifyingJar req4
+ src/Web/Exhentai/API/Gallery.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE StrictData #-}++module Web.Exhentai.API.Gallery+  ( GalleryInfo (..),+    Visibility (..),+    fetchGalleryInfo,+    parseGallery,+  )+where++import Control.Lens ((^..), (^?))+import Control.Monad+import Control.Monad.Catch+import Data.Coerce+import Data.Text (Text, strip)+import Data.Time+import GHC.Generics+import Text.XML+import Text.XML.Lens+import Web.Exhentai.Errors+import qualified Web.Exhentai.Parsing.Gallery as G+import Web.Exhentai.Types+import Web.Exhentai.Types.CookieT+import Web.Exhentai.Utils+import Prelude hiding (length)+import qualified Prelude as P++-- | Information about a gallery+data GalleryInfo = GalleryInfo+  { title :: {-# UNPACK #-} Text,+    previewLink :: {-# UNPACK #-} Text,+    category :: GalleryCat,+    jaTitle :: {-# UNPACK #-} Text,+    uploader :: {-# UNPACK #-} Text,+    rating :: {-# UNPACK #-} Float,+    ratingCount :: {-# UNPACK #-} Int,+    favoriteCount :: {-# UNPACK #-} Int,+    tags :: [(G.TagCategory, [Text])],+    uploadTime :: {-# UNPACK #-} UTCTime,+    newer :: Maybe Gallery,+    parent :: Maybe Gallery,+    visibility :: Visibility,+    language :: {-# UNPACK #-} Text,+    length :: {-# UNPACK #-} Int,+    archiverLink :: {-# UNPACK #-} Text+  }+  deriving (Show, Eq, Generic)++data Visibility+  = Visible+  | Replaced+  | Expunged+  | Unknown {-# UNPACK #-} Text+  deriving (Show, Eq, Generic)++readVisibility :: Text -> Visibility+readVisibility "Yes" = Visible+readVisibility "No (Replaced)" = Replaced+readVisibility "No (Expunged)" = Expunged+readVisibility v = Unknown v++-- | Extract all gallery informations from a document+parseGallery :: Document -> Maybe GalleryInfo+parseGallery d = do+  title <- d ^?: G.enTitle+  previewLink <- d ^?: G.previewStr >>= parsePreviewLink+  jaTitle <- d ^?: G.jaTitle+  category <- d ^?: G.category+  uploader <- d ^?: G.uploader+  (coerce -> rating) <- d ^?: G.averageRating+  ratingCount <- d ^?: G.ratingCount+  (coerce -> archiverLink) <- d ^?: G.archiverLink+  let newer = d ^?: G.newer+  case d ^..: G.metaValues of+    (time : parn : vis : lang : _ : len : fav : _) -> do+      uploadTime <- time ^? lower . _Content >>= parseUploadTime+      let parent = parn ^? lower . _Element . attr "href" . _GalleryLink+      (readVisibility -> visibility) <- vis ^? lower . _Content+      (strip -> language) <- lang ^? lower . _Content+      (coerce -> length) <- len ^? lower . _Content >>= parseGalleryLength+      let cats = d ^..: G.tagCategory+      let tags' = map (^.. G.tags) $ d ^..: G.tagsByCategory+      guard $ P.length cats == P.length tags'+      let tags = zip cats tags'+      (coerce -> favoriteCount) <- fav ^? lower . _Content >>= parseFavoriteCount+      pure GalleryInfo {..}+    _ -> Nothing++-- | Fetch a gallery's 'GalleryInfo'+fetchGalleryInfo :: MonadHttpState m => Gallery -> m GalleryInfo+fetchGalleryInfo g = do+  let url = toGalleryLink g+  d <- htmlRequest' url+  case parseGallery d of+    Nothing -> throwM $ XMLParseFailure url+    Just info -> pure info
+ src/Web/Exhentai/API/MPV.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}++module Web.Exhentai.API.MPV+  ( DispatchRequest (..),+    DispatchResult (..),+    Vars (..),+    Server (..),+    Dim (..),+    fetchMpv,+    toRequests,+    imageDispatch,+    fetchImage,+    fetchImage',+  )+where++import Conduit+import Control.Applicative+import Control.Lens ((^.))+import Control.Monad.Catch+import Control.Monad.Trans.Cont+import Data.Aeson+import Data.ByteString (ByteString)+import Data.Text (Text, unpack)+import GHC.Generics+import Network.HTTP.Client.Conduit+import Text.XML+import Web.Exhentai.Errors+import Web.Exhentai.Parsing.MPV+import Web.Exhentai.Types+import Web.Exhentai.Types.CookieT+import Web.Exhentai.Utils++data Server+  = HAtH Int+  | Other Text+  deriving (Show, Eq, Generic)++instance FromJSON Server where+  parseJSON v =+    HAtH <$> parseJSON v <|> Other <$> parseJSON v++instance ToJSON Server where+  toJSON (HAtH i) = toJSON i+  toJSON (Other t) = toJSON t++newtype Dim = Dim Int+  deriving newtype (Show, Eq)++instance FromJSON Dim where+  parseJSON v = Dim <$> str <|> Dim <$> int+    where+      str = read <$> parseJSON v+      int = parseJSON v++data DispatchResult = DispatchResult+  { -- | A piece of text describing the dimensions and the size of this image+    dimension :: Text,+    -- | The path part of the url pointing to the original image+    origImgPath :: Text,+    -- | The path part of the url that searches for the gallery containing this image+    searchPath :: Text,+    -- | The path part of the non-mpv page that displays this image+    galleryPath :: Text,+    width :: Dim,+    height :: Dim,+    -- | The full url to this image+    imgLink :: Text,+    -- | The server that serves this image+    server :: Server+  }+  deriving (Show, Eq, Generic)++instance FromJSON DispatchResult where+  parseJSON = withObject "imagedispatch result" $ \o ->+    DispatchResult+      <$> o .: "d"+      <*> o .: "lf"+      <*> o .: "ls"+      <*> o .: "lo"+      <*> o .: "xres"+      <*> o .: "yres"+      <*> o .: "i"+      <*> o .: "s"++data DispatchRequest = DispatchRequest+  { galleryId :: Int,+    page :: Int,+    imgKey :: Text,+    mpvKey :: Text,+    exclude :: Maybe Server+  }+  deriving (Show, Eq, Generic)++instance ToJSON DispatchRequest where+  toJSON DispatchRequest {..} = object l+    where+      exc = maybe [] (\s -> ["nl" .= s]) exclude+      l =+        exc+          ++ [ "method" .= ("imagedispatch" :: Text),+               "gid" .= galleryId,+               "page" .= page,+               "imgkey" .= imgKey,+               "mpvkey" .= mpvKey+             ]++-- | Generate a list of requests from a 'Vars'+toRequests :: Vars -> [DispatchRequest]+toRequests Vars {..} = zipWith formReq [1 ..] imageList+  where+    formReq i MpvImage {..} =+      DispatchRequest+        { galleryId = gid,+          page = i,+          imgKey = key,+          exclude = Nothing,+          mpvKey = mpvkey+        }++-- | Fetch the 'Vars' from a Gallery's mpv page+fetchMpv :: (MonadHttpState m, MonadIO m) => Gallery -> m Vars+fetchMpv g = htmlRequest' (toMpvLink g) >>= parseMpv++parseMpv :: (MonadIO m, MonadThrow m) => Document -> m Vars+parseMpv doc = do+  let script = doc ^. allScripts+  res <- liftIO $ extractEnv script+  case res of+    Error e -> throwM $ ExtractionFailure e+    Success vars -> pure vars++-- | Calls the API to dispatch a image request to a H@H server+imageDispatch :: MonadHttpState m => DispatchRequest -> m DispatchResult+imageDispatch dreq = do+  initReq <- formRequest "https://exhentai.org/api.php"+  let req = initReq {method = "POST", requestBody = RequestBodyLBS $ encode dreq}+  r <- jsonRequest req+  case r of+    Left e -> throwM $ JSONParseFailure e+    Right res -> pure res++-- | Fetch an image with a 'DispatchRequest'+fetchImage :: (MonadHttpState m, MonadIO n) => DispatchRequest -> ContT r m (Response (ConduitT i ByteString n ()))+fetchImage dreq = ContT $ \k -> bracket (fetchImage' dreq) respClose k++-- | Like 'fetchImage', but the user is responsible of closing the response+fetchImage' :: (MonadHttpState m, MonadIO n) => DispatchRequest -> m (Response (ConduitT i ByteString n ()))+fetchImage' dreq = do+  res <- imageDispatch dreq+  req <- formRequest $ unpack $ imgLink res+  openWithJar req `catch` \(_ :: HttpException) -> do+    res' <- imageDispatch $ dreq {exclude = Just $ server res}+    req' <- formRequest $ unpack $ imgLink res'+    openWithJar req' `catch` \(_ :: HttpException) -> do+      req'' <- formRequest $ unpack $ "https://exhentai.org/" <> origImgPath res+      openWithJar req''
+ src/Web/Exhentai/API/Search.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE StrictData #-}++module Web.Exhentai.API.Search+  ( SearchQuery (..),+    SearchResult (..),+    search,+    searchRecur,+    fetchSearchPage,+    fetchSearchPage',+  )+where++import Conduit+import Control.Lens ((...))+import Control.Lens.Fold+import Control.Monad+import Data.Set (Set, (\\))+import Data.String+import Data.Text (Text, unpack)+import Data.Text.Encoding (encodeUtf8)+import GHC.Generics+import Network.HTTP.Client.Conduit+import Text.XML+import Web.Exhentai.Parsing.Search+import Web.Exhentai.Types+import Web.Exhentai.Types.CookieT+import Web.Exhentai.Utils+import Prelude hiding (last)++data SearchQuery = SearchQuery+  { categories :: Maybe (Set GalleryCat),+    searchString :: {-# UNPACK #-} Text+  }+  deriving (Show, Eq, Generic)++queryArgCat :: Set GalleryCat -> Int+queryArgCat s = toBitField $ allGalleryCats \\ s++data SearchResult = SearchResult+  { galleries :: [Gallery],+    prevPage :: Maybe Text,+    nextPage :: Maybe Text+  }+  deriving (Show, Eq, Generic)++parseSearchPage :: Document -> SearchResult+parseSearchPage d =+  let galleries = d ^..: galleryPreviewElement . galleryLink+      fld :: Fold Document Element+      fld = body ... pagesElem+      prevPage = do+        first <- firstOf fld d+        first ^? linkOf+      nextPage = do+        last <- lastOf fld d+        last ^? linkOf+   in SearchResult {..}++-- | Fetch a search page using a 'Request'+fetchSearchPage' :: MonadHttpState m => Request -> m SearchResult+fetchSearchPage' req = do+  d <- htmlRequest req+  pure $ parseSearchPage d++-- | Fetch a search page using its url+fetchSearchPage :: MonadHttpState m => Text -> m SearchResult+fetchSearchPage = fetchSearchPage' <=< formRequest . unpack++-- | Search a search query+search :: MonadHttpState m => SearchQuery -> m SearchResult+search SearchQuery {..} = do+  let catQ = maybe [] (\c -> [("f_cats", Just $ fromString $ show $ queryArgCat c)]) categories+  initReq <- formRequest "https://exhentai.org"+  let req =+        setQueryString+          ( catQ+              ++ [ ("f_search", Just $ encodeUtf8 searchString)+                 ]+          )+          initReq+  fetchSearchPage' req++-- | Iterate through all the Galleries asosciated with a search query, putting them in a stream+searchRecur :: forall m i. MonadHttpState m => SearchQuery -> ConduitT i Gallery m ()+searchRecur q = do+  SearchResult {..} <- lift $ search q+  yieldMany galleries+  case nextPage of+    Nothing -> pure ()+    Just url -> searchRecur' url+  where+    searchRecur' :: Text -> ConduitT i Gallery m ()+    searchRecur' url = do+      SearchResult {..} <- lift $ fetchSearchPage url+      yieldMany galleries+      case nextPage of+        Nothing -> pure ()+        Just url' -> searchRecur' url'
+ src/Web/Exhentai/API/Watched.hs view
@@ -0,0 +1,22 @@+module Web.Exhentai.API.Watched+  ( fetchWatched,+    fetchPopular,+  )+where++import Web.Exhentai.Parsing.Search+import Web.Exhentai.Types+import Web.Exhentai.Types.CookieT+import Web.Exhentai.Utils++-- | Fetch the list of watched galleries+fetchWatched :: MonadHttpState m => m [Gallery]+fetchWatched = do+  d <- htmlRequest' "https://exhentai.org/watched"+  pure $ d ^..: galleryPreviewElement . galleryLink++-- | Fetch the list of popular galleries+fetchPopular :: MonadHttpState m => m [Gallery]+fetchPopular = do+  d <- htmlRequest' "https://exhentai.org/popular"+  pure $ d ^..: galleryPreviewElement . galleryLink
+ src/Web/Exhentai/Errors.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE StrictData #-}++module Web.Exhentai.Errors where++import Control.Exception+import Data.Text (Text)++data ExhentaiError+  = JSONParseFailure String+  | XMLParseFailure Text+  | ExtractionFailure String+  deriving (Show, Eq)+  deriving (Exception)
+ src/Web/Exhentai/Parsing/Gallery.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE RankNTypes #-}++module Web.Exhentai.Parsing.Gallery where++import Control.Lens+import Data.Text (Text, pack)+import Text.XML hiding (readFile)+import Text.XML.Lens+import Web.Exhentai.Types+  ( AverageRating,+    Gallery,+    GalleryCat,+    PopUpLink,+    _AverageRating,+    _GalleryCat,+    _GalleryLink,+    _PopUpLink,+  )+import Web.Exhentai.Utils+import Prelude hiding (div, id, readFile)++data TagCategory+  = Language+  | Parody+  | Character+  | Group+  | Artist+  | Male+  | Female+  | Misc+  deriving (Show, Eq, Enum)++readTagCat :: Text -> Maybe TagCategory+readTagCat "language:" = Just Language+readTagCat "parody:" = Just Parody+readTagCat "character:" = Just Character+readTagCat "group:" = Just Group+readTagCat "artist:" = Just Artist+readTagCat "male:" = Just Male+readTagCat "female:" = Just Female+readTagCat "misc:" = Just Misc+readTagCat _ = Nothing++_TagCategory :: Prism' Text TagCategory+_TagCategory = prism' (pack . show) readTagCat++meta :: Traversal' Element Element+meta = div . cl "gm"++title :: Traversal' Element Element+title = meta ... div . id "gd2"++enTitle :: Traversal' Element Text+enTitle = title ... h1 . id "gn" . lower . _Content++jaTitle :: Traversal' Element Text+jaTitle = title ... h1 . id "gj" . lower . _Content++mainMeta :: Traversal' Element Element+mainMeta = meta ... div . id "gmid"++mainMetaL :: Traversal' Element Element+mainMetaL = mainMeta ... div . id "gd3"++mainMetaM :: Traversal' Element Element+mainMetaM = mainMeta ... div . id "gd4"++mainMetaR :: Traversal' Element Element+mainMetaR = mainMeta ... div . id "gd5"++previewStr :: Traversal' Element Text+previewStr = meta ... id "gleft" ... id "gd1" ... attr "style"++category :: Traversal' Element GalleryCat+category = mainMetaL ... div . id "gdc" ... div . lower . _Content . _GalleryCat++uploader :: Traversal' Element Text+uploader = mainMetaL ... div . id "gdn" ... a . lower . _Content++metaPath :: Traversal' Element Element+metaPath = mainMetaL ... div . id "gdd" ... table ... tr++metaKeys :: Traversal' Element Text+metaKeys = metaPath ... cl "gdt1" . lower . _Content++metaValues :: Traversal' Element Element+metaValues = metaPath ... cl "gdt2"++parent :: Traversal' Element Gallery+parent = lower . _Element . attr "href" . _GalleryLink++ratingCount :: Traversal' Element Int+ratingCount =+  mainMetaL ... id "gdr" ... table ... tr ... id "grt3" ... lower . _Content . viaShowRead++averageRating :: Traversal' Element AverageRating+averageRating =+  mainMetaL ... id "gdr" ... table ... tr ... id "rating_label" . lower . _Content . _AverageRating++tagList :: Traversal' Element Element+tagList = mainMetaM ... div . id "taglist" ... table ... tr++tagCategory :: Traversal' Element TagCategory+tagCategory = tagList ... td . cl "tc" . lower . _Content . _TagCategory++tagsByCategory :: Traversal' Element Element+tagsByCategory = tagList ... td . withoutAttribute "class"++tags :: Traversal' Element Text+tags = td ... div ... a . lower . _Content++archiverLink :: Traversal' Element PopUpLink+archiverLink = mainMetaR ... cl "g2 gsp" ... attr "onclick" . _PopUpLink++torrentLink :: Traversal' Element PopUpLink+torrentLink = mainMetaR ... cl "g2" ... attr "onclick" . _PopUpLink++imagePages :: Traversal' Element Text+imagePages = div . id "gdt" ... cl "gdtl" ... a . attr "href"++newer :: Traversal' Element Gallery+newer = div . id "gnd" ... a . attr "href" . _GalleryLink
+ src/Web/Exhentai/Parsing/Image.hs view
@@ -0,0 +1,13 @@+module Web.Exhentai.Parsing.Image where++import Control.Lens+import Data.Text (Text)+import Text.XML.Lens+import Web.Exhentai.Utils+import Prelude hiding (id)++imageSrc :: Traversal' Element Text+imageSrc = id "i1" ... id "i3" ... a ... img . attr "src"++nextPage :: Traversal' Element Text+nextPage = id "i1" ... id "i3" ... a . attr "href"
+ src/Web/Exhentai/Parsing/MPV.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE StrictData #-}++module Web.Exhentai.Parsing.MPV where++import Control.Lens+import Data.Aeson+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import GHC.Generics+import Quickjs+import Text.XML.Lens+import Web.Exhentai.Utils++allScripts :: Traversal' Document Text+allScripts = body ... scripts . lower . _Content++data MpvImage = MpvImage+  { name :: {-# UNPACK #-} Text,+    key :: {-# UNPACK #-} Text,+    thumbnail :: {-# UNPACK #-} Text+  }+  deriving (Show, Eq, Generic)++instance FromJSON MpvImage where+  parseJSON = withObject "mpv image" $ \o ->+    MpvImage+      <$> o .: "n"+      <*> o .: "k"+      <*> o .: "t"++-- | All the variables defined in the scripts that came with the MPV+data Vars = Vars+  { gid :: {-# UNPACK #-} Int,+    mpvkey :: {-# UNPACK #-} Text,+    apiUrl :: {-# UNPACK #-} Text,+    pageCount :: {-# UNPACK #-} Int,+    imageList :: [MpvImage]+  }+  deriving (Show, Eq, Generic)++extractEnv :: Text -> IO (Result Vars)+extractEnv script = quickjs $ do+  eval_ $ encodeUtf8 script+  gid' <- eval "gid"+  mpvkey' <- eval "mpvkey"+  imageList' <- eval "imagelist"+  apiUrl' <- eval "api_url"+  pageCount' <- eval "pagecount"+  pure $ do+    gid <- fromJSON gid'+    mpvkey <- fromJSON mpvkey'+    imageList <- fromJSON imageList'+    apiUrl <- fromJSON apiUrl'+    pageCount <- fromJSON pageCount'+    pure Vars {..}
+ src/Web/Exhentai/Parsing/Search.hs view
@@ -0,0 +1,32 @@+module Web.Exhentai.Parsing.Search where++import Control.Lens+import Data.Text (Text)+import Text.XML.Lens+import Web.Exhentai.Types+import Web.Exhentai.Utils+import Prelude hiding (div)++pages :: Traversal' Element Int+pages = pagesElem ... a . lower . _Content . viaShowRead++pagesElem :: Traversal' Element Element+pagesElem = cl "ido" ... div ... cl "ptt" ... tr ... td++linkOf :: Traversal' Element Text+linkOf = lower . _Element . attr "href"++galleryPreviewElement :: Traversal' Element Element+galleryPreviewElement = cl "ido" ... div ... cl "itg glte" ... tr++previewImage :: Traversal' Element Text+previewImage = tr ... cl "gl1e" ... div ... a ... img . attr "src"++title :: Traversal' Element Text+title = tr ... cl "gl1e" ... div ... a ... img . attr "title"++galleryLink :: Traversal' Element Gallery+galleryLink = tr ... cl "gl1e" ... div ... a . attr "href" . _GalleryLink++galleryLength :: Traversal' Element GalleryLength+galleryLength = tr ... cl "gl2e" ... div ... cl "gl3e" ... lower . _Content . _GalleryLength
+ src/Web/Exhentai/Types.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Web.Exhentai.Types where++import Control.Lens+import Data.Set (Set, fromList, toList)+import Data.Text (Text, pack)+import Data.Void+import Text.Megaparsec+  ( MonadParsec (notFollowedBy, takeWhile1P),+    Parsec,+    anySingle,+    chunk,+    many,+    optional,+    parseMaybe,+    single,+    takeRest,+  )+import Text.Megaparsec.Char.Lexer++type Parser = Parsec Void Text++data GalleryCat+  = Misc+  | Doujinshi+  | Manga+  | ArtistCG+  | GameCG+  | ImageSet+  | Cosplay+  | AsianPorn+  | NonH+  | Western+  | Private+  deriving (Show, Eq, Ord, Enum, Bounded)++allGalleryCats :: Set GalleryCat+allGalleryCats = fromList [Misc .. Private]++toBitField :: Set GalleryCat -> Int+toBitField = sum . map ((2 ^) . fromEnum) . toList++showCat :: GalleryCat -> Text+showCat Doujinshi = "Doujinshi"+showCat Manga = "Manga"+showCat ArtistCG = "Artist CG"+showCat GameCG = "Game CG"+showCat NonH = "Non-H"+showCat ImageSet = "Image Set"+showCat Western = "Western"+showCat Cosplay = "Cosplay"+showCat Misc = "Misc"+showCat Private = "Private"+showCat AsianPorn = "Asian Porn"++readCat :: Text -> Maybe GalleryCat+readCat "Doujinshi" = Just Doujinshi+readCat "Manga" = Just Manga+readCat "Artist CG" = Just ArtistCG+readCat "Game CG" = Just GameCG+readCat "Non-H" = Just NonH+readCat "Image Set" = Just ImageSet+readCat "Western" = Just Western+readCat "Cosplay" = Just Cosplay+readCat "Misc" = Just Misc+readCat "Private" = Just Private+readCat "Asian Porn" = Just AsianPorn+readCat _ = Nothing++_GalleryCat :: Prism' Text GalleryCat+_GalleryCat = prism' showCat readCat++newtype PopUpLink = PopUpLink {unLink :: Text}+  deriving newtype (Show, Eq)++_PopUpLink :: Prism' Text PopUpLink+_PopUpLink = prism' unLink parsePopUpLink++parsePopUpLink :: Text -> Maybe PopUpLink+parsePopUpLink = parseMaybe archiverLink+  where+    archiverLink :: Parser PopUpLink+    archiverLink = do+      _ <- chunk "return popUp('"+      url <- takeWhile1P Nothing (/= '\'')+      _ <- takeRest+      pure $ PopUpLink url++newtype AverageRating = AverageRating {unRating :: Float}+  deriving newtype (Show, Eq)++_AverageRating :: Prism' Text AverageRating+_AverageRating = prism' (pack . show . unRating) parseAverageRating++parseAverageRating :: Text -> Maybe AverageRating+parseAverageRating = parseMaybe averageRating+  where+    averageRating :: Parser AverageRating+    averageRating = do+      _ <- chunk "Average: "+      AverageRating <$> float++newtype GalleryLength = GalleryLength {unGalleryLength :: Int}+  deriving newtype (Show, Eq)++_GalleryLength :: Prism' Text GalleryLength+_GalleryLength = prism' (pack . show . unGalleryLength) parseGalleryLength++parseGalleryLength :: Text -> Maybe GalleryLength+parseGalleryLength = parseMaybe galleryLength+  where+    galleryLength :: Parser GalleryLength+    galleryLength = do+      d <- decimal+      _ <- chunk " pages"+      pure $ GalleryLength d++newtype FavoriteCount = FavoriteCount {unFavoriteCount :: Int}+  deriving newtype (Show, Eq)++parseFavoriteCount :: Text -> Maybe FavoriteCount+parseFavoriteCount = parseMaybe favoriteCount+  where+    favoriteCount :: Parser FavoriteCount+    favoriteCount = do+      d <- decimal+      _ <- chunk " times"+      pure $ FavoriteCount d++data Gallery = Gallery+  { galleryId :: {-# UNPACK #-} !Int,+    token :: {-# UNPACK #-} !Text+  }+  deriving (Show, Eq)++_GalleryLink :: Prism' Text Gallery+_GalleryLink = prism' toGalleryLink parseGalleryLink++toGalleryLink :: Gallery -> Text+toGalleryLink Gallery {..} = "https://exhentai.org/g/" <> pack (show galleryId) <> "/" <> token <> "/"++toMpvLink :: Gallery -> Text+toMpvLink Gallery {..} = "https://exhentai.org/mpv/" <> pack (show galleryId) <> "/" <> token <> "/"++parseGalleryLink :: Text -> Maybe Gallery+parseGalleryLink = parseMaybe galleryLink+  where+    galleryLink :: Parser Gallery+    galleryLink = do+      _ <- chunk "https://exhentai.org/g/"+      galleryId <- decimal+      _ <- single '/'+      token <- takeWhile1P Nothing (/= '/')+      _ <- optional $ single '/'+      pure Gallery {..}++parsePreviewLink :: Text -> Maybe Text+parsePreviewLink = parseMaybe previewLink+  where+    previewLink :: Parser Text+    previewLink = do+      _ <- many $ do+        notFollowedBy urlOpening+        anySingle+      _ <- urlOpening+      url <- takeWhile1P Nothing (/= ')')+      _ <- takeRest+      pure url+    urlOpening :: Parser Text+    urlOpening = chunk "url("
+ src/Web/Exhentai/Types/CookieT.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UndecidableInstances #-}++module Web.Exhentai.Types.CookieT where++import Conduit+import Control.Concurrent+import Control.Monad.Base+import Control.Monad.Catch+import Control.Monad.Except+import Control.Monad.Reader+import Control.Monad.Time+import Control.Monad.Trans.Control+import Control.Retry+import Data.ByteString (ByteString)+import Data.Function ((&))+import GHC.Generics+import Network.HTTP.Client.Conduit+import Network.HTTP.Client.MultipartFormData+import Network.HTTP.Client.TLS++newtype Policy = Policy RetryPolicy++class (Monad m, MonadCatch m, MonadThrow m) => MonadHttp m where+  getRetryPolicy :: m Policy+  formRequest :: String -> m Request+  attachFormData :: [Part] -> Request -> m Request+  respOpen :: MonadIO n => Request -> m (Response (ConduitT i ByteString n ()))+  respClose :: Response body -> m ()+  reqNoBody :: Request -> m (Response ())++class (MonadMask m, MonadTime m, MonadHttp m, MonadIO m) => MonadHttpState m where+  takeCookieJar :: m CookieJar+  readCookieJar :: m CookieJar+  putCookieJar :: CookieJar -> m ()++modifyingJar :: MonadHttpState m => Request -> m ()+modifyingJar req =+  bracketOnError+    takeCookieJar+    putCookieJar+    $ \jar -> do+      let req' = req {cookieJar = Just jar}+      resp <- retryWhenTimeout $ reqNoBody req'+      putCookieJar $ responseCookieJar resp+      pure ()++openWithJar :: (MonadHttpState m, MonadIO n) => Request -> m (Response (ConduitT i ByteString n ()))+openWithJar req = do+  jar <- readCookieJar+  let req' = req {cookieJar = Just jar}+  respOpen req'++withJar :: (MonadHttpState m, MonadIO n) => Request -> (ConduitT i ByteString n () -> m a) -> m a+withJar req k = do+  jar <- readCookieJar+  let req' = req {cookieJar = Just jar}+  bracket+    (respOpen req')+    respClose+    (k . responseBody)++data CookieEnv = CookieEnv+  { policy :: Policy,+    jarRef :: MVar CookieJar,+    manager :: {-# UNPACK #-} !Manager+  }+  deriving (Generic)++instance HasHttpManager CookieEnv where+  getHttpManager = manager++newtype CookieT m a = CookieT {unCookieT :: ReaderT CookieEnv m a}+  deriving newtype+    ( Functor,+      Applicative,+      Monad,+      MonadReader CookieEnv,+      MonadThrow,+      MonadCatch,+      MonadMask,+      MonadIO,+      MonadResource,+      MonadUnliftIO,+      MonadError e,+      MonadBase b,+      MonadBaseControl b,+      MonadTime+    )++runCookieT :: MonadIO m => RetryPolicy -> CookieT m a -> m a+runCookieT (Policy -> policy) m = do+  manager <- liftIO newTlsManager+  jarRef <- liftIO $ newMVar mempty+  m+    & unCookieT+    & flip runReaderT CookieEnv {..}++instance MonadTrans CookieT where+  lift = CookieT . lift++instance+  ( MonadIO m,+    MonadUnliftIO m,+    MonadCatch m,+    MonadThrow m+  ) =>+  MonadHttp (CookieT m)+  where+  getRetryPolicy = asks policy+  formRequest = parseRequest+  attachFormData = formDataBody+  respOpen = responseOpen+  respClose = responseClose+  reqNoBody = httpNoBody++instance+  {-# OVERLAPPABLE #-}+  ( MonadHttp m,+    MonadTrans f,+    Monad (f m),+    MonadCatch (f m),+    MonadThrow (f m)+  ) =>+  MonadHttp (f m)+  where+  getRetryPolicy = lift getRetryPolicy+  formRequest = lift . formRequest+  attachFormData p = lift . attachFormData p+  respOpen = lift . respOpen+  respClose = lift . respClose+  reqNoBody = lift . reqNoBody++retryWhenTimeout :: MonadHttpState m => m a -> m a+retryWhenTimeout action = do+  Policy policy <- getRetryPolicy+  recovering policy handlers (const action)+  where+    handlers =+      skipAsyncExceptions+        ++ [ const (Handler (pure . judge))+           ]+    judge (HttpExceptionRequest _ c)+      | ResponseTimeout <- c = True+      | ConnectionTimeout <- c = True+    judge _ = False++instance+  ( MonadMask m,+    MonadUnliftIO m,+    MonadTime m+  ) =>+  MonadHttpState (CookieT m)+  where+  takeCookieJar = do+    ref <- asks jarRef+    liftIO $ takeMVar ref+  putCookieJar jar = do+    ref <- asks jarRef+    liftIO $ putMVar ref jar+  readCookieJar = do+    ref <- asks jarRef+    liftIO $ readMVar ref++instance+  {-# OVERLAPPABLE #-}+  ( MonadHttpState m,+    MonadTrans f,+    MonadMask (f m),+    MonadTime (f m),+    MonadHttp (f m),+    MonadIO (f m)+  ) =>+  MonadHttpState (f m)+  where+  takeCookieJar = lift takeCookieJar+  putCookieJar = lift . putCookieJar+  readCookieJar = lift readCookieJar
+ src/Web/Exhentai/Utils.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE RankNTypes #-}++module Web.Exhentai.Utils where++import Conduit+import Control.Lens+import Data.Aeson+import Data.ByteString (ByteString)+import Data.Maybe (isNothing)+import Data.Text (Text, pack, unpack)+import Data.Time+import Network.HTTP.Client.Conduit+import Text.HTML.DOM+import Text.Read+import Text.XML hiding (sinkDoc)+import Text.XML.Lens+import Web.Exhentai.Types.CookieT++attributeSatisfies' :: Name -> (Maybe Text -> Bool) -> Traversal' Element Element+attributeSatisfies' n p = filtered (p . preview (attrs . ix n))++withoutAttribute :: Name -> Traversal' Element Element+withoutAttribute = flip attributeSatisfies' isNothing++lower :: Traversal' Element Node+lower = nodes . traverse++body :: Traversal' Document Element+body = root . named "html" ... named "body"++div :: Traversal' Element Element+div = named "div"++h1 :: Traversal' Element Element+h1 = named "h1"++a :: Traversal' Element Element+a = named "a"++table :: Traversal' Element Element+table = named "table"++tr :: Traversal' Element Element+tr = named "tr"++td :: Traversal' Element Element+td = named "td"++img :: Traversal' Element Element+img = named "img"++cl :: Text -> Traversal' Element Element+cl = attributeIs "class"++id :: Text -> Traversal' Element Element+id = attributeIs "id"++viaShowRead :: (Show a, Read a) => Prism' Text a+viaShowRead = prism' (pack . show) (readMaybe . unpack)++scripts :: Traversal' Element Element+scripts = named "script" . attributeIs "type" "text/javascript"++infixl 8 ^?:++(^?:) :: Document -> Fold Element a -> Maybe a+doc ^?: fld = doc ^? body ... fld++infixl 8 ^..:++(^..:) :: Document -> Fold Element a -> [a]+doc ^..: fld = doc ^.. body ... fld++sinkAeson :: (FromJSON a, Monad m) => ConduitT ByteString o m (Either String a)+sinkAeson = eitherDecode <$> sinkLazy++jsonRequest :: (FromJSON a, MonadHttpState m) => Request -> m (Either String a)+jsonRequest req = withJar req $ \source -> runConduit $ source .| sinkAeson++htmlRequest :: MonadHttpState m => Request -> m Document+htmlRequest req = withJar req $ \source -> runConduit $ source .| sinkDoc++htmlRequest' :: MonadHttpState m => Text -> m Document+htmlRequest' url = do+  req <- formRequest $ unpack url+  htmlRequest req++parseUploadTime :: Text -> Maybe UTCTime+parseUploadTime s = parseTimeM True defaultTimeLocale "%F %R" $ unpack s
+ test/Spec.hs view
@@ -0,0 +1,114 @@+module Main where++import Conduit+import Control.Monad.Trans.Cont+import Control.Retry+import Data.Maybe+import Network.HTTP.Client+import Test.Hspec+import Text.HTML.DOM+import Web.Exhentai.API.Auth+import Web.Exhentai.API.Gallery+import Web.Exhentai.API.MPV+import qualified Web.Exhentai.Parsing.Gallery as G+import Web.Exhentai.Parsing.Image+import qualified Web.Exhentai.Parsing.Search as S+import Web.Exhentai.Types+import Web.Exhentai.Types.CookieT+import Web.Exhentai.Utils+import Prelude hiding (readFile)++main :: IO ()+main = do+  sanityCheck+  runCookieT retryPolicyDefault $ do+    auth $ Credential "VictorYu" "Victor142857"+    vars <- fetchMpv $ Gallery 1815207 "5f4ceed6d7"+    withSinkFile "1.png" $ \sinkF -> evalContT $ do+      resp <- fetchImage $ head $ toRequests vars+      let source = responseBody resp+      runConduit $ source .| sinkF++{-+    withSinkFile "2.zip" $ \sinkF -> evalContT $ do+      resp <- streamOriginal "https://exhentai.org/archiver.php?gid=1800698&token=3d413c962e&or=447251--2c3a0356a675f5eb4c5a2afe08b9f15e385647bb"+      let source = responseBody resp+      runConduit $ source .| sinkF+-}++sanityCheck :: IO ()+sanityCheck = do+  image <- readFile "test/Image.html"+  galleryMpv <- readFile "test/Gallery-MPV.html"+  galleryNonMpv <- readFile "test/Gallery-NonMPV.html"+  galleryReplaced <- readFile "test/Gallery-Replaced.html"+  search <- readFile "test/Search-Extended.html"+  archiver <- readFile "test/Archiver-Download.html"+  hspec $ do+    describe "Image.imageSrc" $ do+      it "should return the image source link" $ do+        (image ^?: imageSrc) `shouldSatisfy` isJust++    describe "Image.nextPage" $ do+      it "should return the link to the next page" $ do+        (image ^?: nextPage) `shouldSatisfy` isJust++    describe "Gallery.enTitle" $ do+      it "should return the title of the gallery" $ do+        (galleryMpv ^?: G.enTitle) `shouldSatisfy` isJust+        (galleryNonMpv ^?: G.enTitle) `shouldSatisfy` isJust+        (galleryReplaced ^?: G.enTitle) `shouldSatisfy` isJust++    describe "Gallery.jaTitle" $ do+      it "should return the original title of the gallery" $ do+        (galleryMpv ^?: G.jaTitle) `shouldSatisfy` isJust+        (galleryNonMpv ^?: G.jaTitle) `shouldSatisfy` isJust+        (galleryReplaced ^?: G.jaTitle) `shouldSatisfy` isJust++    describe "Gallery.category" $ do+      it "should return the category of the gallery" $ do+        (galleryMpv ^?: G.category) `shouldSatisfy` isJust+        (galleryNonMpv ^?: G.category) `shouldSatisfy` isJust+        (galleryReplaced ^?: G.category) `shouldSatisfy` isJust++    describe "Gallery.uploader" $ do+      it "should return the uploader of the gallery" $ do+        (galleryMpv ^?: G.uploader) `shouldSatisfy` isJust+        (galleryNonMpv ^?: G.uploader) `shouldSatisfy` isJust+        (galleryReplaced ^?: G.uploader) `shouldSatisfy` isJust++    describe "Gallery.ratingCount" $ do+      it "should return the total rating count of the gallery" $ do+        (galleryMpv ^?: G.ratingCount) `shouldSatisfy` isJust+        (galleryNonMpv ^?: G.ratingCount) `shouldSatisfy` isJust+        (galleryReplaced ^?: G.ratingCount) `shouldSatisfy` isJust++    describe "Gallery.averageRating" $ do+      it "should return the average rating of the gallery" $ do+        (galleryMpv ^?: G.averageRating) `shouldSatisfy` isJust+        (galleryNonMpv ^?: G.averageRating) `shouldSatisfy` isJust+        (galleryReplaced ^?: G.averageRating) `shouldSatisfy` isJust++    describe "Gallery.newer" $ do+      it "should return the link to the newer version of the library on replaced galleries and nothing otherwise" $ do+        (galleryMpv ^?: G.newer) `shouldSatisfy` isNothing+        (galleryNonMpv ^?: G.newer) `shouldSatisfy` isNothing+        (galleryReplaced ^?: G.newer) `shouldSatisfy` isJust++    describe "Gallery.parseGallery" $ do+      it "should parse gallery just fine" $ do+        parseGallery galleryMpv `shouldSatisfy` isJust+        parseGallery galleryNonMpv `shouldSatisfy` isJust+        parseGallery galleryReplaced `shouldSatisfy` isJust++    describe "Search.pages" $ do+      it "should return available page range" $ do+        (search ^?: S.pages) `shouldSatisfy` isJust++    describe "Search.galleryPreviewElement" $ do+      it "should return gallery preview elements" $ do+        (search ^?: S.galleryPreviewElement) `shouldSatisfy` isJust++    describe "Search.galleryLink" $ do+      it "should return galleries" $ do+        (search ^?: S.galleryPreviewElement . S.galleryLink) `shouldSatisfy` isJust