exh-1.0.1: test/Spec.hs

{-# LANGUAGE OverloadedLabels #-}

module Main where

import Conduit hiding (withSinkFile)
import Control.Effect
import Control.Effect.Bracket
import Control.Effect.Error
import Control.Effect.Reader
import Control.Monad.Trans.Cont
import Data.ByteString (ByteString)
import Data.Either
import Data.Maybe
import Network.HTTP.Client hiding (Cookie)
import Network.HTTP.Client.TLS
import Optics.Core
import System.IO hiding (readFile)
import Test.Hspec
import Text.HTML.DOM
import Web.Exhentai
import qualified Web.Exhentai.Parsing.Gallery as G
import Web.Exhentai.Parsing.Image
import qualified Web.Exhentai.Parsing.Search as S
import Web.Exhentai.Utils ((^?:))
import Prelude hiding (readFile)

main :: IO ()
main = do
  sanityCheck
  manager <- newTlsManager
  _ <-
    runM $
      runReader manager $
        errorToIOAsExc @HttpException $
          errorToIOAsExc @ExhentaiError $
            bracketToIO $
              exhToIO app
  pure ()

withSinkFile :: Effs '[Embed IO, Bracket] m => FilePath -> ContT r m (ConduitT ByteString o IO ())
withSinkFile fp = ContT $ \k ->
  bracket
    (embed $ openBinaryFile fp WriteMode)
    (embed . hClose)
    (k . sinkHandle)

app :: Effs '[Http, Error HttpException, Error ExhentaiError, Cookie, ConduitIO, Bracket, Embed IO] m => m ()
app = do
  auth $ Credential "VictorYu" "Victor142857"
  watched <- fetchWatched
  embed $ print watched
  popular <- fetchPopular
  embed $ print popular
  searchRes <- search (SearchQuery Nothing "")
  embed $ print searchRes
  let gallery = Gallery 1833806 "cf00133fb7"
  info <- fetchGalleryInfo gallery
  embed $ print info
  reqs <- buildRequest gallery
  evalContT $ do
    -- resp <- streamResampled (info ^. #archiverLink)
    -- sink <- withSinkFile "resampled.zip"
    -- lift $ runConduitIO $ responseBody resp .| sink
    resp' <- fetchImage (reqs !! 1)
    sink' <- withSinkFile "thumb.png"
    lift $ runConduitIO $ responseBody resp' .| sink'

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"
  galleryWithAd <- readFile "test/Gallery-ADs.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 ^?: nextImage) `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` isRight
        parseGallery galleryNonMpv `shouldSatisfy` isRight
        parseGallery galleryReplaced `shouldSatisfy` isRight
        parseGallery galleryWithAd `shouldSatisfy` isRight

    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