{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}

module Web.Exhentai.API.MPV
  ( DispatchRequest (..),
    DispatchResult (..),
    Vars (..),
    Server (..),
    Dim (..),
    fetchMpv,
    toRequests,
    imageDispatch,
    fetchImage,
    fetchImage',
  )
where

import Conduit
import Control.Applicative
import Control.Lens ((^.))
import Control.Monad.Catch
import Control.Monad.Trans.Cont
import Data.Aeson
import Data.ByteString (ByteString)
import Data.Text (Text, unpack)
import GHC.Generics
import Network.HTTP.Client.Conduit
import Text.XML
import Web.Exhentai.Errors
import Web.Exhentai.Parsing.MPV
import Web.Exhentai.Types
import Web.Exhentai.Types.CookieT
import Web.Exhentai.Utils

data Server
  = HAtH Int
  | Other Text
  deriving (Int -> Server -> ShowS
[Server] -> ShowS
Server -> String
(Int -> Server -> ShowS)
-> (Server -> String) -> ([Server] -> ShowS) -> Show Server
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Server] -> ShowS
$cshowList :: [Server] -> ShowS
show :: Server -> String
$cshow :: Server -> String
showsPrec :: Int -> Server -> ShowS
$cshowsPrec :: Int -> Server -> ShowS
Show, Server -> Server -> Bool
(Server -> Server -> Bool)
-> (Server -> Server -> Bool) -> Eq Server
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Server -> Server -> Bool
$c/= :: Server -> Server -> Bool
== :: Server -> Server -> Bool
$c== :: Server -> Server -> Bool
Eq, (forall x. Server -> Rep Server x)
-> (forall x. Rep Server x -> Server) -> Generic Server
forall x. Rep Server x -> Server
forall x. Server -> Rep Server x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Server x -> Server
$cfrom :: forall x. Server -> Rep Server x
Generic)

instance FromJSON Server where
  parseJSON :: Value -> Parser Server
parseJSON Value
v =
    Int -> Server
HAtH (Int -> Server) -> Parser Int -> Parser Server
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser Server -> Parser Server -> Parser Server
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Text -> Server
Other (Text -> Server) -> Parser Text -> Parser Server
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSON Server where
  toJSON :: Server -> Value
toJSON (HAtH Int
i) = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
i
  toJSON (Other Text
t) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t

newtype Dim = Dim Int
  deriving newtype (Int -> Dim -> ShowS
[Dim] -> ShowS
Dim -> String
(Int -> Dim -> ShowS)
-> (Dim -> String) -> ([Dim] -> ShowS) -> Show Dim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dim] -> ShowS
$cshowList :: [Dim] -> ShowS
show :: Dim -> String
$cshow :: Dim -> String
showsPrec :: Int -> Dim -> ShowS
$cshowsPrec :: Int -> Dim -> ShowS
Show, Dim -> Dim -> Bool
(Dim -> Dim -> Bool) -> (Dim -> Dim -> Bool) -> Eq Dim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dim -> Dim -> Bool
$c/= :: Dim -> Dim -> Bool
== :: Dim -> Dim -> Bool
$c== :: Dim -> Dim -> Bool
Eq)

instance FromJSON Dim where
  parseJSON :: Value -> Parser Dim
parseJSON Value
v = Int -> Dim
Dim (Int -> Dim) -> Parser Int -> Parser Dim
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
str Parser Dim -> Parser Dim -> Parser Dim
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Int -> Dim
Dim (Int -> Dim) -> Parser Int -> Parser Dim
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
int
    where
      str :: Parser Int
str = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Parser String -> Parser Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      int :: Parser Int
int = Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

data DispatchResult = DispatchResult
  { -- | A piece of text describing the dimensions and the size of this image
    DispatchResult -> Text
dimension :: Text,
    -- | The path part of the url pointing to the original image
    DispatchResult -> Text
origImgPath :: Text,
    -- | The path part of the url that searches for the gallery containing this image
    DispatchResult -> Text
searchPath :: Text,
    -- | The path part of the non-mpv page that displays this image
    DispatchResult -> Text
galleryPath :: Text,
    DispatchResult -> Dim
width :: Dim,
    DispatchResult -> Dim
height :: Dim,
    -- | The full url to this image
    DispatchResult -> Text
imgLink :: Text,
    -- | The server that serves this image
    DispatchResult -> Server
server :: Server
  }
  deriving (Int -> DispatchResult -> ShowS
[DispatchResult] -> ShowS
DispatchResult -> String
(Int -> DispatchResult -> ShowS)
-> (DispatchResult -> String)
-> ([DispatchResult] -> ShowS)
-> Show DispatchResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DispatchResult] -> ShowS
$cshowList :: [DispatchResult] -> ShowS
show :: DispatchResult -> String
$cshow :: DispatchResult -> String
showsPrec :: Int -> DispatchResult -> ShowS
$cshowsPrec :: Int -> DispatchResult -> ShowS
Show, DispatchResult -> DispatchResult -> Bool
(DispatchResult -> DispatchResult -> Bool)
-> (DispatchResult -> DispatchResult -> Bool) -> Eq DispatchResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DispatchResult -> DispatchResult -> Bool
$c/= :: DispatchResult -> DispatchResult -> Bool
== :: DispatchResult -> DispatchResult -> Bool
$c== :: DispatchResult -> DispatchResult -> Bool
Eq, (forall x. DispatchResult -> Rep DispatchResult x)
-> (forall x. Rep DispatchResult x -> DispatchResult)
-> Generic DispatchResult
forall x. Rep DispatchResult x -> DispatchResult
forall x. DispatchResult -> Rep DispatchResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DispatchResult x -> DispatchResult
$cfrom :: forall x. DispatchResult -> Rep DispatchResult x
Generic)

instance FromJSON DispatchResult where
  parseJSON :: Value -> Parser DispatchResult
parseJSON = String
-> (Object -> Parser DispatchResult)
-> Value
-> Parser DispatchResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"imagedispatch result" ((Object -> Parser DispatchResult)
 -> Value -> Parser DispatchResult)
-> (Object -> Parser DispatchResult)
-> Value
-> Parser DispatchResult
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Text
-> Text
-> Text
-> Dim
-> Dim
-> Text
-> Server
-> DispatchResult
DispatchResult
      (Text
 -> Text
 -> Text
 -> Text
 -> Dim
 -> Dim
 -> Text
 -> Server
 -> DispatchResult)
-> Parser Text
-> Parser
     (Text
      -> Text -> Text -> Dim -> Dim -> Text -> Server -> DispatchResult)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"d"
      Parser
  (Text
   -> Text -> Text -> Dim -> Dim -> Text -> Server -> DispatchResult)
-> Parser Text
-> Parser
     (Text -> Text -> Dim -> Dim -> Text -> Server -> DispatchResult)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"lf"
      Parser
  (Text -> Text -> Dim -> Dim -> Text -> Server -> DispatchResult)
-> Parser Text
-> Parser (Text -> Dim -> Dim -> Text -> Server -> DispatchResult)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ls"
      Parser (Text -> Dim -> Dim -> Text -> Server -> DispatchResult)
-> Parser Text
-> Parser (Dim -> Dim -> Text -> Server -> DispatchResult)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"lo"
      Parser (Dim -> Dim -> Text -> Server -> DispatchResult)
-> Parser Dim -> Parser (Dim -> Text -> Server -> DispatchResult)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Dim
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"xres"
      Parser (Dim -> Text -> Server -> DispatchResult)
-> Parser Dim -> Parser (Text -> Server -> DispatchResult)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Dim
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"yres"
      Parser (Text -> Server -> DispatchResult)
-> Parser Text -> Parser (Server -> DispatchResult)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"i"
      Parser (Server -> DispatchResult)
-> Parser Server -> Parser DispatchResult
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Server
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"s"

data DispatchRequest = DispatchRequest
  { DispatchRequest -> Int
galleryId :: Int,
    DispatchRequest -> Int
page :: Int,
    DispatchRequest -> Text
imgKey :: Text,
    DispatchRequest -> Text
mpvKey :: Text,
    DispatchRequest -> Maybe Server
exclude :: Maybe Server
  }
  deriving (Int -> DispatchRequest -> ShowS
[DispatchRequest] -> ShowS
DispatchRequest -> String
(Int -> DispatchRequest -> ShowS)
-> (DispatchRequest -> String)
-> ([DispatchRequest] -> ShowS)
-> Show DispatchRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DispatchRequest] -> ShowS
$cshowList :: [DispatchRequest] -> ShowS
show :: DispatchRequest -> String
$cshow :: DispatchRequest -> String
showsPrec :: Int -> DispatchRequest -> ShowS
$cshowsPrec :: Int -> DispatchRequest -> ShowS
Show, DispatchRequest -> DispatchRequest -> Bool
(DispatchRequest -> DispatchRequest -> Bool)
-> (DispatchRequest -> DispatchRequest -> Bool)
-> Eq DispatchRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DispatchRequest -> DispatchRequest -> Bool
$c/= :: DispatchRequest -> DispatchRequest -> Bool
== :: DispatchRequest -> DispatchRequest -> Bool
$c== :: DispatchRequest -> DispatchRequest -> Bool
Eq, (forall x. DispatchRequest -> Rep DispatchRequest x)
-> (forall x. Rep DispatchRequest x -> DispatchRequest)
-> Generic DispatchRequest
forall x. Rep DispatchRequest x -> DispatchRequest
forall x. DispatchRequest -> Rep DispatchRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DispatchRequest x -> DispatchRequest
$cfrom :: forall x. DispatchRequest -> Rep DispatchRequest x
Generic)

instance ToJSON DispatchRequest where
  toJSON :: DispatchRequest -> Value
toJSON DispatchRequest {Int
Maybe Server
Text
exclude :: Maybe Server
mpvKey :: Text
imgKey :: Text
page :: Int
galleryId :: Int
$sel:exclude:DispatchRequest :: DispatchRequest -> Maybe Server
$sel:mpvKey:DispatchRequest :: DispatchRequest -> Text
$sel:imgKey:DispatchRequest :: DispatchRequest -> Text
$sel:page:DispatchRequest :: DispatchRequest -> Int
$sel:galleryId:DispatchRequest :: DispatchRequest -> Int
..} = [Pair] -> Value
object [Pair]
l
    where
      exc :: [Pair]
exc = [Pair] -> (Server -> [Pair]) -> Maybe Server -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Server
s -> [Text
"nl" Text -> Server -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Server
s]) Maybe Server
exclude
      l :: [Pair]
l =
        [Pair]
exc
          [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [ Text
"method" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"imagedispatch" :: Text),
               Text
"gid" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
galleryId,
               Text
"page" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
page,
               Text
"imgkey" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
imgKey,
               Text
"mpvkey" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
mpvKey
             ]

-- | Generate a list of requests from a 'Vars'
toRequests :: Vars -> [DispatchRequest]
toRequests :: Vars -> [DispatchRequest]
toRequests Vars {Int
[MpvImage]
Text
$sel:imageList:Vars :: Vars -> [MpvImage]
$sel:pageCount:Vars :: Vars -> Int
$sel:apiUrl:Vars :: Vars -> Text
$sel:mpvkey:Vars :: Vars -> Text
$sel:gid:Vars :: Vars -> Int
imageList :: [MpvImage]
pageCount :: Int
apiUrl :: Text
mpvkey :: Text
gid :: Int
..} = (Int -> MpvImage -> DispatchRequest)
-> [Int] -> [MpvImage] -> [DispatchRequest]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> MpvImage -> DispatchRequest
formReq [Int
1 ..] [MpvImage]
imageList
  where
    formReq :: Int -> MpvImage -> DispatchRequest
formReq Int
i MpvImage {Text
$sel:thumbnail:MpvImage :: MpvImage -> Text
$sel:key:MpvImage :: MpvImage -> Text
$sel:name:MpvImage :: MpvImage -> Text
thumbnail :: Text
key :: Text
name :: Text
..} =
      DispatchRequest :: Int -> Int -> Text -> Text -> Maybe Server -> DispatchRequest
DispatchRequest
        { $sel:galleryId:DispatchRequest :: Int
galleryId = Int
gid,
          $sel:page:DispatchRequest :: Int
page = Int
i,
          $sel:imgKey:DispatchRequest :: Text
imgKey = Text
key,
          $sel:exclude:DispatchRequest :: Maybe Server
exclude = Maybe Server
forall a. Maybe a
Nothing,
          $sel:mpvKey:DispatchRequest :: Text
mpvKey = Text
mpvkey
        }

-- | Fetch the 'Vars' from a Gallery's mpv page
fetchMpv :: (MonadHttpState m, MonadIO m) => Gallery -> m Vars
fetchMpv :: Gallery -> m Vars
fetchMpv Gallery
g = Text -> m Document
forall (m :: Type -> Type). MonadHttpState m => Text -> m Document
htmlRequest' (Gallery -> Text
toMpvLink Gallery
g) m Document -> (Document -> m Vars) -> m Vars
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Document -> m Vars
forall (m :: Type -> Type).
(MonadIO m, MonadThrow m) =>
Document -> m Vars
parseMpv

parseMpv :: (MonadIO m, MonadThrow m) => Document -> m Vars
parseMpv :: Document -> m Vars
parseMpv Document
doc = do
  let script :: Text
script = Document
doc Document -> Getting Text Document Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Document Text
Traversal' Document Text
allScripts
  Result Vars
res <- IO (Result Vars) -> m (Result Vars)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Result Vars) -> m (Result Vars))
-> IO (Result Vars) -> m (Result Vars)
forall a b. (a -> b) -> a -> b
$ Text -> IO (Result Vars)
extractEnv Text
script
  case Result Vars
res of
    Error String
e -> ExhentaiError -> m Vars
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> m a
throwM (ExhentaiError -> m Vars) -> ExhentaiError -> m Vars
forall a b. (a -> b) -> a -> b
$ String -> ExhentaiError
ExtractionFailure String
e
    Success Vars
vars -> Vars -> m Vars
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Vars
vars

-- | Calls the API to dispatch a image request to a H@H server
imageDispatch :: MonadHttpState m => DispatchRequest -> m DispatchResult
imageDispatch :: DispatchRequest -> m DispatchResult
imageDispatch DispatchRequest
dreq = do
  Request
initReq <- String -> m Request
forall (m :: Type -> Type). MonadHttp m => String -> m Request
formRequest String
"https://exhentai.org/api.php"
  let req :: Request
req = Request
initReq {method :: Method
method = Method
"POST", requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ DispatchRequest -> ByteString
forall a. ToJSON a => a -> ByteString
encode DispatchRequest
dreq}
  Either String DispatchResult
r <- Request -> m (Either String DispatchResult)
forall a (m :: Type -> Type).
(FromJSON a, MonadHttpState m) =>
Request -> m (Either String a)
jsonRequest Request
req
  case Either String DispatchResult
r of
    Left String
e -> ExhentaiError -> m DispatchResult
forall (m :: Type -> Type) e a.
(MonadThrow m, Exception e) =>
e -> m a
throwM (ExhentaiError -> m DispatchResult)
-> ExhentaiError -> m DispatchResult
forall a b. (a -> b) -> a -> b
$ String -> ExhentaiError
JSONParseFailure String
e
    Right DispatchResult
res -> DispatchResult -> m DispatchResult
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure DispatchResult
res

-- | Fetch an image with a 'DispatchRequest'
fetchImage :: (MonadHttpState m, MonadIO n) => DispatchRequest -> ContT r m (Response (ConduitT i ByteString n ()))
fetchImage :: DispatchRequest -> ContT r m (Response (ConduitT i Method n ()))
fetchImage DispatchRequest
dreq = ((Response (ConduitT i Method n ()) -> m r) -> m r)
-> ContT r m (Response (ConduitT i Method n ()))
forall k (r :: k) (m :: k -> Type) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Response (ConduitT i Method n ()) -> m r) -> m r)
 -> ContT r m (Response (ConduitT i Method n ())))
-> ((Response (ConduitT i Method n ()) -> m r) -> m r)
-> ContT r m (Response (ConduitT i Method n ()))
forall a b. (a -> b) -> a -> b
$ \Response (ConduitT i Method n ()) -> m r
k -> m (Response (ConduitT i Method n ()))
-> (Response (ConduitT i Method n ()) -> m ())
-> (Response (ConduitT i Method 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 (DispatchRequest -> m (Response (ConduitT i Method n ()))
forall (m :: Type -> Type) (n :: Type -> Type) i.
(MonadHttpState m, MonadIO n) =>
DispatchRequest -> m (Response (ConduitT i Method n ()))
fetchImage' DispatchRequest
dreq) Response (ConduitT i Method n ()) -> m ()
forall (m :: Type -> Type) body.
MonadHttp m =>
Response body -> m ()
respClose Response (ConduitT i Method n ()) -> m r
k

-- | Like 'fetchImage', but the user is responsible of closing the response
fetchImage' :: (MonadHttpState m, MonadIO n) => DispatchRequest -> m (Response (ConduitT i ByteString n ()))
fetchImage' :: DispatchRequest -> m (Response (ConduitT i Method n ()))
fetchImage' DispatchRequest
dreq = do
  DispatchResult
res <- DispatchRequest -> m DispatchResult
forall (m :: Type -> Type).
MonadHttpState m =>
DispatchRequest -> m DispatchResult
imageDispatch DispatchRequest
dreq
  Request
req <- 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 -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ DispatchResult -> Text
imgLink DispatchResult
res
  Request -> m (Response (ConduitT i Method n ()))
forall (m :: Type -> Type) (n :: Type -> Type) i.
(MonadHttpState m, MonadIO n) =>
Request -> m (Response (ConduitT i Method n ()))
openWithJar Request
req m (Response (ConduitT i Method n ()))
-> (HttpException -> m (Response (ConduitT i Method n ())))
-> m (Response (ConduitT i Method n ()))
forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(HttpException
_ :: HttpException) -> do
    DispatchResult
res' <- DispatchRequest -> m DispatchResult
forall (m :: Type -> Type).
MonadHttpState m =>
DispatchRequest -> m DispatchResult
imageDispatch (DispatchRequest -> m DispatchResult)
-> DispatchRequest -> m DispatchResult
forall a b. (a -> b) -> a -> b
$ DispatchRequest
dreq {$sel:exclude:DispatchRequest :: Maybe Server
exclude = Server -> Maybe Server
forall a. a -> Maybe a
Just (Server -> Maybe Server) -> Server -> Maybe Server
forall a b. (a -> b) -> a -> b
$ DispatchResult -> Server
server DispatchResult
res}
    Request
req' <- 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 -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ DispatchResult -> Text
imgLink DispatchResult
res'
    Request -> m (Response (ConduitT i Method n ()))
forall (m :: Type -> Type) (n :: Type -> Type) i.
(MonadHttpState m, MonadIO n) =>
Request -> m (Response (ConduitT i Method n ()))
openWithJar Request
req' m (Response (ConduitT i Method n ()))
-> (HttpException -> m (Response (ConduitT i Method n ())))
-> m (Response (ConduitT i Method n ()))
forall (m :: Type -> Type) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(HttpException
_ :: HttpException) -> do
      Request
req'' <- 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 -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"https://exhentai.org/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DispatchResult -> Text
origImgPath DispatchResult
res
      Request -> m (Response (ConduitT i Method n ()))
forall (m :: Type -> Type) (n :: Type -> Type) i.
(MonadHttpState m, MonadIO n) =>
Request -> m (Response (ConduitT i Method n ()))
openWithJar Request
req''