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 :: (Text -> f Text) -> Element -> f Element
downloadLink = Text -> Traversal' Element Element
id Text
"db" ((Element -> f Element) -> Element -> f Element)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> Element
-> f Element
forall k (f :: Type -> Type) c s t (p :: k -> Type -> Type)
       (a :: k) b.
(Applicative f, Plated c) =>
LensLike f s t c c -> Over p f c c a b -> Over p f s t a b
... Text -> Traversal' Element Element
id Text
"continue" ((Element -> f Element) -> Element -> f Element)
-> ((Text -> f Text) -> Element -> f Element)
-> (Text -> f Text)
-> Element
-> f Element
forall k (f :: Type -> Type) c s t (p :: k -> Type -> Type)
       (a :: k) b.
(Applicative f, Plated c) =>
LensLike f s t c c -> Over p f c c a b -> Over p f s t a b
... Name -> Traversal' Element Text
attr Name
"href"

originalParts :: [Part]
originalParts :: [Part]
originalParts =
  [ Text -> ByteString -> Part
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"dltype" ByteString
"org",
    Text -> ByteString -> Part
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"dlcheck" ByteString
"Download Original Archive"
  ]
{-# INLINE originalParts #-}

resampledParts :: [Part]
resampledParts :: [Part]
resampledParts =
  [ Text -> ByteString -> Part
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"dltype" ByteString
"res",
    Text -> ByteString -> Part
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"dlcheck" ByteString
"Download Resample Archive"
  ]
{-# INLINE resampledParts #-}

streamWith :: (MonadHttpState m, MonadIO n) => [Part] -> Text -> ContT r m (Response (ConduitT i ByteString n ()))
streamWith :: [Part] -> Text -> ContT r m (Response (ConduitT i ByteString n ()))
streamWith [Part]
parts Text
url = ((Response (ConduitT i ByteString n ()) -> m r) -> m r)
-> ContT r m (Response (ConduitT i ByteString n ()))
forall k (r :: k) (m :: k -> Type) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Response (ConduitT i ByteString n ()) -> m r) -> m r)
 -> ContT r m (Response (ConduitT i ByteString n ())))
-> ((Response (ConduitT i ByteString n ()) -> m r) -> m r)
-> ContT r m (Response (ConduitT i ByteString n ()))
forall a b. (a -> b) -> a -> b
$ \Response (ConduitT i ByteString n ()) -> m r
k -> do
  Request
initReq <- String -> m Request
forall (m :: Type -> Type). MonadHttp m => String -> m Request
formRequest (String -> m Request) -> String -> m Request
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
url
  Request
req <- [Part] -> Request -> m Request
forall (m :: Type -> Type).
MonadIO m =>
[Part] -> Request -> m Request
formDataBody [Part]
parts Request
initReq
  Document
d <- Request -> m Document
forall (m :: Type -> Type).
MonadHttpState m =>
Request -> m Document
htmlRequest Request
req
  case Document
d Document -> Fold Element Text -> Maybe Text
forall a. Document -> Fold Element a -> Maybe a
^?: Traversal' Element Text
Fold Element Text
downloadLink of
    Maybe Text
Nothing -> ExhentaiError -> m r
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> m a
throwM (ExhentaiError -> m r) -> ExhentaiError -> m r
forall a b. (a -> b) -> a -> b
$ Text -> ExhentaiError
XMLParseFailure Text
url
    Just Text
l -> do
      Request
newReq <- String -> m Request
forall (m :: Type -> Type). MonadHttp m => String -> m Request
formRequest (String -> m Request) -> String -> m Request
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
l
      let req' :: Request
req' = [(ByteString, Maybe ByteString)] -> Request -> Request
setQueryString [(ByteString
"start", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"1")] Request
newReq
      m r -> m r
forall (m :: Type -> Type) a. MonadHttpState m => m a -> m a
retryWhenTimeout (m r -> m r) -> m r -> m r
forall a b. (a -> b) -> a -> b
$
        m (Response (ConduitT i ByteString n ()))
-> (Response (ConduitT i ByteString n ()) -> m ())
-> (Response (ConduitT i ByteString n ()) -> m r)
-> m r
forall (m :: Type -> Type) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket
          (Request -> m (Response (ConduitT i ByteString n ()))
forall (m :: Type -> Type) (n :: Type -> Type) i.
(MonadHttp m, MonadIO n) =>
Request -> m (Response (ConduitT i ByteString n ()))
respOpen Request
req')
          Response (ConduitT i ByteString n ()) -> m ()
forall (m :: Type -> Type) body.
MonadHttp m =>
Response body -> m ()
respClose
          Response (ConduitT i ByteString n ()) -> m r
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 :: Text -> ContT r m (Response (ConduitT i ByteString n ()))
streamOriginal = [Part] -> Text -> ContT r m (Response (ConduitT i ByteString n ()))
forall (m :: Type -> Type) (n :: Type -> Type) r i.
(MonadHttpState m, MonadIO n) =>
[Part] -> Text -> ContT r m (Response (ConduitT i ByteString n ()))
streamWith [Part]
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 :: Text -> ContT r m (Response (ConduitT i ByteString n ()))
streamResampled = [Part] -> Text -> ContT r m (Response (ConduitT i ByteString n ()))
forall (m :: Type -> Type) (n :: Type -> Type) r i.
(MonadHttpState m, MonadIO n) =>
[Part] -> Text -> ContT r m (Response (ConduitT i ByteString n ()))
streamWith [Part]
resampledParts