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 :: Traversal' Element Text
downloadLink = Text -> AffineTraversal' Element Element
id Text
"db" AffineTraversal' Element Element
-> Traversal' Element Text
-> Optic
(Join (Join An_AffineTraversal A_Traversal) A_Traversal)
(Append NoIx NoIx)
Element
Element
Text
Text
forall k l (is :: IxList) s t (js :: IxList) a b.
(Is (Join k A_Traversal) (Join (Join k A_Traversal) l),
Is l (Join (Join k A_Traversal) l), Is k (Join k A_Traversal),
Is A_Traversal (Join k A_Traversal)) =>
Optic k is s t Element Element
-> Optic l js Element Element a b
-> Optic (Join (Join k A_Traversal) l) (Append is js) s t a b
.// Text -> AffineTraversal' Element Element
id Text
"continue" AffineTraversal' Element Element
-> Optic An_AffineTraversal NoIx Element Element Text Text
-> Optic
(Join (Join An_AffineTraversal A_Traversal) An_AffineTraversal)
(Append NoIx NoIx)
Element
Element
Text
Text
forall k l (is :: IxList) s t (js :: IxList) a b.
(Is (Join k A_Traversal) (Join (Join k A_Traversal) l),
Is l (Join (Join k A_Traversal) l), Is k (Join k A_Traversal),
Is A_Traversal (Join k A_Traversal)) =>
Optic k is s t Element Element
-> Optic l js Element Element a b
-> Optic (Join (Join k A_Traversal) l) (Append is js) s t a b
.// Name -> Optic An_AffineTraversal NoIx Element Element Text Text
attr Name
"href"
{-# INLINE downloadLink #-}
originalParts :: Applicative m => [PartM m]
originalParts :: [PartM m]
originalParts =
[ Text -> ByteString -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"dltype" ByteString
"org",
Text -> ByteString -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"dlcheck" ByteString
"Download Original Archive"
]
{-# INLINE originalParts #-}
resampledParts :: Applicative m => [PartM m]
resampledParts :: [PartM m]
resampledParts =
[ Text -> ByteString -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"dltype" ByteString
"res",
Text -> ByteString -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"dlcheck" ByteString
"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 :: [PartM m]
-> Text -> ContT r m (Response (ConduitT i ByteString IO ()))
streamWith [PartM m]
parts Text
url = ((Response (ConduitT i ByteString IO ()) -> m r) -> m r)
-> ContT r m (Response (ConduitT i ByteString IO ()))
forall k (r :: k) (m :: k -> Type) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Response (ConduitT i ByteString IO ()) -> m r) -> m r)
-> ContT r m (Response (ConduitT i ByteString IO ())))
-> ((Response (ConduitT i ByteString IO ()) -> m r) -> m r)
-> ContT r m (Response (ConduitT i ByteString IO ()))
forall a b. (a -> b) -> a -> b
$ \Response (ConduitT i ByteString IO ()) -> m r
k -> do
Request
initReq <- String -> m Request
forall (m :: Type -> Type).
Effs '[Http, Error HttpException] 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 <- [PartM m] -> Request -> m Request
forall (m :: Type -> Type).
Eff Http m =>
[PartM m] -> Request -> m Request
attachFormData [PartM m]
parts Request
initReq
Document
d <- Request -> m Document
forall (m :: Type -> Type).
Effs '[Http, Error HttpException, ConduitIO, Cookie, Bracket] m =>
Request -> m Document
htmlRequest Request
req
case Document
d Document -> Traversal' Element Text -> Maybe Text
forall l (is :: IxList) a.
(Is (Join A_Traversal l) A_Fold, Is l (Join A_Traversal l),
Is A_Traversal (Join A_Traversal l)) =>
Document -> Optic l is Element Element a a -> Maybe a
^?: Traversal' Element Text
downloadLink of
Maybe Text
Nothing -> ExhentaiError -> m r
forall e (m :: Type -> Type) a. Eff (Throw e) m => e -> m a
throw (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).
Effs '[Http, Error HttpException] 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 (Response BodyReader)
-> (Response BodyReader -> m ())
-> (Response BodyReader -> m r)
-> m r
forall (m :: Type -> Type) a c b.
Eff Bracket m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket
(Request -> m (Response BodyReader)
forall (m :: Type -> Type).
Effs '[Http, Error HttpException] m =>
Request -> m (Response BodyReader)
respOpen Request
req')
Response BodyReader -> m ()
forall (m :: Type -> Type) a. Eff Http m => Response a -> m ()
respClose
(Response (ConduitT i ByteString IO ()) -> m r
k (Response (ConduitT i ByteString IO ()) -> m r)
-> (Response BodyReader -> Response (ConduitT i ByteString IO ()))
-> Response BodyReader
-> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BodyReader -> ConduitT i ByteString IO ())
-> Response BodyReader -> Response (ConduitT i ByteString IO ())
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap BodyReader -> ConduitT i ByteString IO ()
forall i. BodyReader -> ConduitT i ByteString IO ()
bodyReaderSource)
{-# INLINEABLE streamWith #-}
streamOriginal ::
Effs '[Http, Error HttpException, Cookie, ConduitIO, Bracket, Throw ExhentaiError] m =>
Text ->
ContT r m (Response (ConduitT i ByteString IO ()))
streamOriginal :: Text -> ContT r m (Response (ConduitT i ByteString IO ()))
streamOriginal = [PartM m]
-> Text -> ContT r m (Response (ConduitT i ByteString IO ()))
forall (m :: Type -> Type) r i.
Effs
'[Http, Error HttpException, Cookie, ConduitIO, Bracket,
Throw ExhentaiError]
m =>
[PartM m]
-> Text -> ContT r m (Response (ConduitT i ByteString IO ()))
streamWith [PartM m]
forall (m :: Type -> Type). Applicative m => [PartM m]
originalParts
{-# INLINEABLE streamOriginal #-}
streamResampled ::
Effs '[Http, Error HttpException, Cookie, ConduitIO, Bracket, Throw ExhentaiError] m =>
Text ->
ContT r m (Response (ConduitT i ByteString IO ()))
streamResampled :: Text -> ContT r m (Response (ConduitT i ByteString IO ()))
streamResampled = [PartM m]
-> Text -> ContT r m (Response (ConduitT i ByteString IO ()))
forall (m :: Type -> Type) r i.
Effs
'[Http, Error HttpException, Cookie, ConduitIO, Bracket,
Throw ExhentaiError]
m =>
[PartM m]
-> Text -> ContT r m (Response (ConduitT i ByteString IO ()))
streamWith [PartM m]
forall (m :: Type -> Type). Applicative m => [PartM m]
resampledParts
{-# INLINEABLE streamResampled #-}