Archiver.hs

module Web.Exhentai.API.Archiver
  ( streamOriginal,
    streamResampled,
  )
where

import Conduit
import Control.Effect
import Control.Effect.Bracket
import Control.Effect.Error
import Control.Effect.Exh
import Control.Monad.Trans.Cont
import Data.ByteString (ByteString)
import Data.Text (Text, unpack)
import Network.HTTP.Client hiding (Cookie)
import Network.HTTP.Client.MultipartFormData
import Optics.Core (Traversal')
import Text.XML.Optics
import Web.Exhentai.Errors
import Web.Exhentai.Utils
import Prelude hiding (id)

downloadLink :: Traversal' Element Text
downloadLink = id "db" .// id "continue" .// attr "href"
{-# INLINE downloadLink #-}

originalParts :: Applicative m => [PartM m]
originalParts =
  [ partBS "dltype" "org",
    partBS "dlcheck" "Download Original Archive"
  ]
{-# INLINE originalParts #-}

resampledParts :: Applicative m => [PartM m]
resampledParts =
  [ partBS "dltype" "res",
    partBS "dlcheck" "Download Resample Archive"
  ]
{-# INLINE resampledParts #-}

streamWith ::
  Effs '[Http, Error HttpException, Cookie, ConduitIO, Bracket, Throw ExhentaiError] m =>
  [PartM m] ->
  Text ->
  ContT r m (Response (ConduitT i ByteString IO ()))
streamWith parts url = ContT $ \k -> do
  initReq <- formRequest $ unpack url
  req <- attachFormData parts initReq
  d <- htmlRequest req
  case d ^?: downloadLink of
    Nothing -> throw $ XMLParseFailure "download link" url
    Just l -> do
      newReq <- formRequest $ unpack l
      let req' = setQueryString [("start", Just "1")] newReq
      bracket
        (respOpen req')
        respClose
        (k . fmap bodyReaderSource)
{-# INLINEABLE streamWith #-}

-- | Download an origian archive from an archiver url as a stream
streamOriginal ::
  Effs '[Http, Error HttpException, Cookie, ConduitIO, Bracket, Throw ExhentaiError] m =>
  -- | Archiver url, usually the 'archiverLink` field
  Text ->
  ContT r m (Response (ConduitT i ByteString IO ()))
streamOriginal = streamWith originalParts
{-# INLINEABLE streamOriginal #-}

-- | Download an resampled archive from an archiver url as a stream
streamResampled ::
  Effs '[Http, Error HttpException, Cookie, ConduitIO, Bracket, Throw ExhentaiError] m =>
  -- | Archiver url, usually the 'archiverLink` field
  Text ->
  ContT r m (Response (ConduitT i ByteString IO ()))
streamResampled = streamWith resampledParts
{-# INLINEABLE streamResampled #-}