{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Web.Exhentai.API.Auth
( Credential (..),
auth,
)
where
import Control.Effect
import Control.Effect.Bracket
import Control.Effect.Error
import Control.Effect.Exh
import Data.ByteString (ByteString)
import Network.HTTP.Client hiding (Cookie)
import Network.HTTP.Client.MultipartFormData
import Optics.TH
data Credential = Credential
{ Credential -> ByteString
username :: ByteString,
Credential -> ByteString
password :: ByteString
}
deriving (Int -> Credential -> ShowS
[Credential] -> ShowS
Credential -> String
(Int -> Credential -> ShowS)
-> (Credential -> String)
-> ([Credential] -> ShowS)
-> Show Credential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Credential] -> ShowS
$cshowList :: [Credential] -> ShowS
show :: Credential -> String
$cshow :: Credential -> String
showsPrec :: Int -> Credential -> ShowS
$cshowsPrec :: Int -> Credential -> ShowS
Show, Credential -> Credential -> Bool
(Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool) -> Eq Credential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Credential -> Credential -> Bool
$c/= :: Credential -> Credential -> Bool
== :: Credential -> Credential -> Bool
$c== :: Credential -> Credential -> Bool
Eq)
auth :: Effs '[Http, Error HttpException, Cookie, ConduitIO, Bracket] m => Credential -> m ()
auth :: Credential -> m ()
auth Credential {ByteString
password :: ByteString
username :: ByteString
$sel:password:Credential :: Credential -> ByteString
$sel:username:Credential :: Credential -> ByteString
..} = do
Request
initReq <- String -> m Request
forall (m :: Type -> Type).
Effs '[Http, Error HttpException] m =>
String -> m Request
formRequest String
"POST https://forums.e-hentai.org/index.php"
let parts :: [PartM m]
parts =
[ Text -> ByteString -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"CookieDate" ByteString
"1",
Text -> ByteString -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"b" ByteString
"d",
Text -> ByteString -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"bt" ByteString
"1-6",
Text -> ByteString -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"UserName" ByteString
username,
Text -> ByteString -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"PassWord" ByteString
password,
Text -> ByteString -> PartM m
forall (m :: Type -> Type).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"ipb_login_submit" ByteString
"Login!"
]
let req :: Request
req =
[(ByteString, Maybe ByteString)] -> Request -> Request
setQueryString
[ (ByteString
"act", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"Login"),
(ByteString
"CODE", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"01")
]
Request
initReq
Request
finalReq <- [PartM m] -> Request -> m Request
forall (m :: Type -> Type).
Eff Http m =>
[PartM m] -> Request -> m Request
attachFormData [PartM m]
parts Request
req
Request -> m ()
forall (m :: Type -> Type).
Effs '[Http, Cookie, Error HttpException, Bracket] m =>
Request -> m ()
modifyJar Request
finalReq
Request
req2 <- String -> m Request
forall (m :: Type -> Type).
Effs '[Http, Error HttpException] m =>
String -> m Request
formRequest String
"https://exhentai.org"
Request -> m ()
forall (m :: Type -> Type).
Effs '[Http, Cookie, Error HttpException, Bracket] m =>
Request -> m ()
modifyJar Request
req2
Request
req3 <- String -> m Request
forall (m :: Type -> Type).
Effs '[Http, Error HttpException] m =>
String -> m Request
formRequest String
"https://exhentai.org/uconfig.php"
Request -> m ()
forall (m :: Type -> Type).
Effs '[Http, Cookie, Error HttpException, Bracket] m =>
Request -> m ()
modifyJar Request
req3
Request
req4 <- String -> m Request
forall (m :: Type -> Type).
Effs '[Http, Error HttpException] m =>
String -> m Request
formRequest String
"https://exhentai.org/mytags"
Request -> m ()
forall (m :: Type -> Type).
Effs '[Http, Cookie, Error HttpException, Bracket] m =>
Request -> m ()
modifyJar Request
req4
{-# INLINEABLE auth #-}
makeFieldLabelsWith noPrefixFieldLabels ''Credential