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 -> Text -> ExhentaiError
XMLParseFailure Text
"download link" 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
streamOriginal ::
(MonadHttpState m, MonadIO n) =>
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
streamResampled ::
(MonadHttpState m, MonadIO n) =>
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