{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Authentication API.
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)

-- | Authenticates and loads user preferences.
-- This should be called before any other functions are called
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