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 #-}

-- | 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 :: 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 #-}

-- | 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 :: 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 #-}