module Polysemy.Http.Data.Request where

import Control.Lens (makeClassy)
import qualified Data.Text as Text
import Network.HTTP.Client.Internal (CookieJar)

import Polysemy.Http.Data.Header (HeaderName, HeaderValue)

-- |All standard HTTP methods, mirroring those from 'Network.HTTP.Types', plus a constructor for arbitrary strings.
data Method =
  Get
  |
  Post
  |
  Put
  |
  Delete
  |
  Head
  |
  Trace
  |
  Connect
  |
  Options
  |
  Patch
  |
  Custom Text
  deriving (Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c== :: Method -> Method -> Bool
Eq, Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Method] -> ShowS
$cshowList :: [Method] -> ShowS
show :: Method -> String
$cshow :: Method -> String
showsPrec :: Int -> Method -> ShowS
$cshowsPrec :: Int -> Method -> ShowS
Show)

defaultJson ''Method

instance IsString Method where
  fromString :: String -> Method
fromString = \case
    String
"GET" -> Method
Get
    String
"POST" -> Method
Post
    String
"PUT" -> Method
Put
    String
"DELETE" -> Method
Delete
    String
"HEAD" -> Method
Head
    String
"TRACE" -> Method
Trace
    String
"CONNECT" -> Method
Connect
    String
"OPTIONS" -> Method
Options
    String
"PATCH" -> Method
Patch
    String
"get" -> Method
Get
    String
"post" -> Method
Post
    String
"put" -> Method
Put
    String
"delete" -> Method
Delete
    String
"head" -> Method
Head
    String
"trace" -> Method
Trace
    String
"connect" -> Method
Connect
    String
"options" -> Method
Options
    String
"patch" -> Method
Patch
    String
a -> Text -> Method
Custom (String -> Text
forall a. ToText a => a -> Text
toText String
a)

-- |Produce the usual uppercase representation of a method.
methodUpper :: Method -> Text
methodUpper :: Method -> Text
methodUpper = \case
  Custom Text
n -> Text -> Text
Text.toUpper Text
n
  Method
a -> Text -> Text
Text.toUpper (Method -> Text
forall b a. (Show a, IsString b) => a -> b
show Method
a)

-- |Request host name.
newtype Host =
  Host { Host -> Text
unHost :: Text }
  deriving (Host -> Host -> Bool
(Host -> Host -> Bool) -> (Host -> Host -> Bool) -> Eq Host
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Host -> Host -> Bool
$c/= :: Host -> Host -> Bool
== :: Host -> Host -> Bool
$c== :: Host -> Host -> Bool
Eq, Int -> Host -> ShowS
[Host] -> ShowS
Host -> String
(Int -> Host -> ShowS)
-> (Host -> String) -> ([Host] -> ShowS) -> Show Host
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Host] -> ShowS
$cshowList :: [Host] -> ShowS
show :: Host -> String
$cshow :: Host -> String
showsPrec :: Int -> Host -> ShowS
$cshowsPrec :: Int -> Host -> ShowS
Show, (forall x. Host -> Rep Host x)
-> (forall x. Rep Host x -> Host) -> Generic Host
forall x. Rep Host x -> Host
forall x. Host -> Rep Host x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Host x -> Host
$cfrom :: forall x. Host -> Rep Host x
Generic)
  deriving newtype (String -> Host
(String -> Host) -> IsString Host
forall a. (String -> a) -> IsString a
fromString :: String -> Host
$cfromString :: String -> Host
IsString)

defaultJson ''Host

-- |Request port.
newtype Port =
  Port { Port -> Int
unPort :: Int }
  deriving (Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c== :: Port -> Port -> Bool
Eq, Int -> Port -> ShowS
[Port] -> ShowS
Port -> String
(Int -> Port -> ShowS)
-> (Port -> String) -> ([Port] -> ShowS) -> Show Port
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Port] -> ShowS
$cshowList :: [Port] -> ShowS
show :: Port -> String
$cshow :: Port -> String
showsPrec :: Int -> Port -> ShowS
$cshowsPrec :: Int -> Port -> ShowS
Show, (forall x. Port -> Rep Port x)
-> (forall x. Rep Port x -> Port) -> Generic Port
forall x. Rep Port x -> Port
forall x. Port -> Rep Port x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Port x -> Port
$cfrom :: forall x. Port -> Rep Port x
Generic)

defaultJson ''Port

-- |A flag that indicates whether a request should use TLS.
newtype Tls =
  Tls { Tls -> Bool
unTls :: Bool }
  deriving (Tls -> Tls -> Bool
(Tls -> Tls -> Bool) -> (Tls -> Tls -> Bool) -> Eq Tls
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tls -> Tls -> Bool
$c/= :: Tls -> Tls -> Bool
== :: Tls -> Tls -> Bool
$c== :: Tls -> Tls -> Bool
Eq, Int -> Tls -> ShowS
[Tls] -> ShowS
Tls -> String
(Int -> Tls -> ShowS)
-> (Tls -> String) -> ([Tls] -> ShowS) -> Show Tls
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tls] -> ShowS
$cshowList :: [Tls] -> ShowS
show :: Tls -> String
$cshow :: Tls -> String
showsPrec :: Int -> Tls -> ShowS
$cshowsPrec :: Int -> Tls -> ShowS
Show, (forall x. Tls -> Rep Tls x)
-> (forall x. Rep Tls x -> Tls) -> Generic Tls
forall x. Rep Tls x -> Tls
forall x. Tls -> Rep Tls x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tls x -> Tls
$cfrom :: forall x. Tls -> Rep Tls x
Generic)

defaultJson ''Tls

-- |Rrequest path.
newtype Path =
  Path { Path -> Text
unPath :: Text }
  deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show, (forall x. Path -> Rep Path x)
-> (forall x. Rep Path x -> Path) -> Generic Path
forall x. Rep Path x -> Path
forall x. Path -> Rep Path x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Path x -> Path
$cfrom :: forall x. Path -> Rep Path x
Generic)
  deriving newtype (String -> Path
(String -> Path) -> IsString Path
forall a. (String -> a) -> IsString a
fromString :: String -> Path
$cfromString :: String -> Path
IsString, Semigroup Path
Path
Semigroup Path
-> Path
-> (Path -> Path -> Path)
-> ([Path] -> Path)
-> Monoid Path
[Path] -> Path
Path -> Path -> Path
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Path] -> Path
$cmconcat :: [Path] -> Path
mappend :: Path -> Path -> Path
$cmappend :: Path -> Path -> Path
mempty :: Path
$cmempty :: Path
$cp1Monoid :: Semigroup Path
Monoid)

instance Semigroup Path where
  Path Text
l <> :: Path -> Path -> Path
<> Path Text
r =
    Text -> Path
Path ((Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char
'/' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
Text.dropWhile (Char
'/' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
r)

defaultJson ''Path

-- |The key of a query parameter.
newtype QueryKey =
  QueryKey { QueryKey -> Text
unQueryKey :: Text }
  deriving (QueryKey -> QueryKey -> Bool
(QueryKey -> QueryKey -> Bool)
-> (QueryKey -> QueryKey -> Bool) -> Eq QueryKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryKey -> QueryKey -> Bool
$c/= :: QueryKey -> QueryKey -> Bool
== :: QueryKey -> QueryKey -> Bool
$c== :: QueryKey -> QueryKey -> Bool
Eq, Int -> QueryKey -> ShowS
[QueryKey] -> ShowS
QueryKey -> String
(Int -> QueryKey -> ShowS)
-> (QueryKey -> String) -> ([QueryKey] -> ShowS) -> Show QueryKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryKey] -> ShowS
$cshowList :: [QueryKey] -> ShowS
show :: QueryKey -> String
$cshow :: QueryKey -> String
showsPrec :: Int -> QueryKey -> ShowS
$cshowsPrec :: Int -> QueryKey -> ShowS
Show, (forall x. QueryKey -> Rep QueryKey x)
-> (forall x. Rep QueryKey x -> QueryKey) -> Generic QueryKey
forall x. Rep QueryKey x -> QueryKey
forall x. QueryKey -> Rep QueryKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QueryKey x -> QueryKey
$cfrom :: forall x. QueryKey -> Rep QueryKey x
Generic)
  deriving newtype (String -> QueryKey
(String -> QueryKey) -> IsString QueryKey
forall a. (String -> a) -> IsString a
fromString :: String -> QueryKey
$cfromString :: String -> QueryKey
IsString)

defaultJson ''QueryKey

-- |The value of a query parameter.
newtype QueryValue =
  QueryValue { QueryValue -> Text
unQueryValue :: Text }
  deriving (QueryValue -> QueryValue -> Bool
(QueryValue -> QueryValue -> Bool)
-> (QueryValue -> QueryValue -> Bool) -> Eq QueryValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryValue -> QueryValue -> Bool
$c/= :: QueryValue -> QueryValue -> Bool
== :: QueryValue -> QueryValue -> Bool
$c== :: QueryValue -> QueryValue -> Bool
Eq, Int -> QueryValue -> ShowS
[QueryValue] -> ShowS
QueryValue -> String
(Int -> QueryValue -> ShowS)
-> (QueryValue -> String)
-> ([QueryValue] -> ShowS)
-> Show QueryValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryValue] -> ShowS
$cshowList :: [QueryValue] -> ShowS
show :: QueryValue -> String
$cshow :: QueryValue -> String
showsPrec :: Int -> QueryValue -> ShowS
$cshowsPrec :: Int -> QueryValue -> ShowS
Show, (forall x. QueryValue -> Rep QueryValue x)
-> (forall x. Rep QueryValue x -> QueryValue) -> Generic QueryValue
forall x. Rep QueryValue x -> QueryValue
forall x. QueryValue -> Rep QueryValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QueryValue x -> QueryValue
$cfrom :: forall x. QueryValue -> Rep QueryValue x
Generic)
  deriving newtype (String -> QueryValue
(String -> QueryValue) -> IsString QueryValue
forall a. (String -> a) -> IsString a
fromString :: String -> QueryValue
$cfromString :: String -> QueryValue
IsString)

defaultJson ''QueryValue

-- |Request body, using 'LByteString' because it is what 'Aeson.encode' produces.
newtype Body =
  Body { Body -> LByteString
unBody :: LByteString }
  deriving (Body -> Body -> Bool
(Body -> Body -> Bool) -> (Body -> Body -> Bool) -> Eq Body
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Body -> Body -> Bool
$c/= :: Body -> Body -> Bool
== :: Body -> Body -> Bool
$c== :: Body -> Body -> Bool
Eq, Int -> Body -> ShowS
[Body] -> ShowS
Body -> String
(Int -> Body -> ShowS)
-> (Body -> String) -> ([Body] -> ShowS) -> Show Body
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Body] -> ShowS
$cshowList :: [Body] -> ShowS
show :: Body -> String
$cshow :: Body -> String
showsPrec :: Int -> Body -> ShowS
$cshowsPrec :: Int -> Body -> ShowS
Show, (forall x. Body -> Rep Body x)
-> (forall x. Rep Body x -> Body) -> Generic Body
forall x. Rep Body x -> Body
forall x. Body -> Rep Body x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Body x -> Body
$cfrom :: forall x. Body -> Rep Body x
Generic)
  deriving newtype (String -> Body
(String -> Body) -> IsString Body
forall a. (String -> a) -> IsString a
fromString :: String -> Body
$cfromString :: String -> Body
IsString)

-- |HTTP request parameters, used by 'Polysemy.Http.Data.Http'.
data Request =
  Request {
    Request -> Method
_method :: Method,
    Request -> Host
_host :: Host,
    Request -> Maybe Port
_port :: Maybe Port,
    Request -> Tls
_tls :: Tls,
    Request -> Path
_path :: Path,
    Request -> [(HeaderName, HeaderValue)]
_headers :: [(HeaderName, HeaderValue)],
    Request -> CookieJar
_cookies :: CookieJar,
    Request -> [(QueryKey, Maybe QueryValue)]
_query :: [(QueryKey, Maybe QueryValue)],
    Request -> Body
_body :: Body
  }
  deriving (Request -> Request -> Bool
(Request -> Request -> Bool)
-> (Request -> Request -> Bool) -> Eq Request
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c== :: Request -> Request -> Bool
Eq, Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show, (forall x. Request -> Rep Request x)
-> (forall x. Rep Request x -> Request) -> Generic Request
forall x. Rep Request x -> Request
forall x. Request -> Rep Request x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Request x -> Request
$cfrom :: forall x. Request -> Rep Request x
Generic)

makeClassy ''Request