module Polysemy.Http.Request where

import qualified Data.Text as Text
import Prelude hiding (get)

import Polysemy.Http.Data.Request (Body, Host(Host), Method(..), Path(Path), Port(Port), Request(Request), Tls(Tls))

invalidScheme ::
  Text ->
  Text ->
  Either Text a
invalidScheme :: Text -> Text -> Either Text a
invalidScheme Text
scheme Text
url =
  Text -> Either Text a
forall a b. a -> Either a b
Left [qt|invalid scheme `#{scheme}` in url: #{url}|]

split ::
  Text ->
  Text ->
  (Text, Maybe Text)
split :: Text -> Text -> (Text, Maybe Text)
split Text
target Text
t =
  case Text -> Text -> (Text, Text)
Text.breakOn Text
target Text
t of
    (Text
a, Text
"") -> (Text
a, Maybe Text
forall a. Maybe a
Nothing)
    (Text
a, Text
b) -> (Text
a, Text -> Maybe Text
forall a. a -> Maybe a
Just (Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
target) Text
b))

parseScheme ::
  Text ->
  (Text, Maybe Text) ->
  Either Text (Tls, Text)
parseScheme :: Text -> (Text, Maybe Text) -> Either Text (Tls, Text)
parseScheme Text
url = \case
  (Text
full, Maybe Text
Nothing) -> (Tls, Text) -> Either Text (Tls, Text)
forall a b. b -> Either a b
Right (Bool -> Tls
Tls Bool
True, Text
full)
  (Text
"https", Just Text
rest) -> (Tls, Text) -> Either Text (Tls, Text)
forall a b. b -> Either a b
Right (Bool -> Tls
Tls Bool
True, Text
rest)
  (Text
"http", Just Text
rest) -> (Tls, Text) -> Either Text (Tls, Text)
forall a b. b -> Either a b
Right (Bool -> Tls
Tls Bool
False, Text
rest)
  (Text
scheme, Maybe Text
_) -> Text -> Text -> Either Text (Tls, Text)
forall a. Text -> Text -> Either Text a
invalidScheme Text
scheme Text
url

parseHostPort ::
  Text ->
  (Text, Maybe Text) ->
  Either Text (Host, Maybe Port)
parseHostPort :: Text -> (Text, Maybe Text) -> Either Text (Host, Maybe Port)
parseHostPort Text
url = \case
  (Text
host, Maybe Text
Nothing) -> (Host, Maybe Port) -> Either Text (Host, Maybe Port)
forall a b. b -> Either a b
Right (Text -> Host
Host Text
host, Maybe Port
forall a. Maybe a
Nothing)
  (Text
host, Just (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString -> Just Int
port)) -> (Host, Maybe Port) -> Either Text (Host, Maybe Port)
forall a b. b -> Either a b
Right (Text -> Host
Host Text
host, Port -> Maybe Port
forall a. a -> Maybe a
Just (Int -> Port
Port Int
port))
  (Text
_, Just Text
port) -> Text -> Either Text (Host, Maybe Port)
forall a b. a -> Either a b
Left [qt|invalid port `#{port}` in url: #{url}|]

parseUrl ::
  Text ->
  Either Text (Tls, Host, Maybe Port, Path)
parseUrl :: Text -> Either Text (Tls, Host, Maybe Port, Path)
parseUrl Text
url = do
  (Tls
tls, Text -> Text -> (Text, Maybe Text)
split Text
"/" -> (Text
hostPort, Maybe Text
path)) <- Text -> (Text, Maybe Text) -> Either Text (Tls, Text)
parseScheme Text
url (Text -> Text -> (Text, Maybe Text)
split Text
"://" Text
url)
  (Host
host, Maybe Port
port) <- Text -> (Text, Maybe Text) -> Either Text (Host, Maybe Port)
parseHostPort Text
url (Text -> Text -> (Text, Maybe Text)
split Text
":" Text
hostPort)
  (Tls, Host, Maybe Port, Path)
-> Either Text (Tls, Host, Maybe Port, Path)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tls
tls, Host
host, Maybe Port
port, Text -> Path
Path (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
path))

withPort ::
  Maybe Port ->
  Tls ->
  Method ->
  Host ->
  Path ->
  Body ->
  Request
withPort :: Maybe Port -> Tls -> Method -> Host -> Path -> Body -> Request
withPort Maybe Port
port Tls
tls Method
method Host
host Path
path =
  Method
-> Host
-> Maybe Port
-> Tls
-> Path
-> [(HeaderName, HeaderValue)]
-> [(QueryKey, Maybe QueryValue)]
-> Body
-> Request
Request Method
method Host
host Maybe Port
port Tls
tls Path
path [] []

withTls ::
  Tls ->
  Method ->
  Host ->
  Path ->
  Body ->
  Request
withTls :: Tls -> Method -> Host -> Path -> Body -> Request
withTls =
  Maybe Port -> Tls -> Method -> Host -> Path -> Body -> Request
withPort Maybe Port
forall a. Maybe a
Nothing

simple ::
  Method ->
  Host ->
  Path ->
  Body ->
  Request
simple :: Method -> Host -> Path -> Body -> Request
simple =
  Tls -> Method -> Host -> Path -> Body -> Request
withTls (Bool -> Tls
Tls Bool
True)

get ::
  Host ->
  Path ->
  Request
get :: Host -> Path -> Request
get Host
host Path
path =
  Method -> Host -> Path -> Body -> Request
simple Method
Get Host
host Path
path Body
""

post ::
  Host ->
  Path ->
  Body ->
  Request
post :: Host -> Path -> Body -> Request
post Host
host Path
path =
  Method -> Host -> Path -> Body -> Request
simple Method
Post Host
host Path
path

put ::
  Host ->
  Path ->
  Body ->
  Request
put :: Host -> Path -> Body -> Request
put Host
host Path
path =
  Method -> Host -> Path -> Body -> Request
simple Method
Put Host
host Path
path

delete ::
  Host ->
  Path ->
  Request
delete :: Host -> Path -> Request
delete Host
host Path
path =
  Method -> Host -> Path -> Body -> Request
simple Method
Delete Host
host Path
path Body
""

fromUrl ::
  Method ->
  Body ->
  Text ->
  Either Text Request
fromUrl :: Method -> Body -> Text -> Either Text Request
fromUrl Method
method Body
body Text
url = do
  (Tls
tls, Host
host, Maybe Port
port, Path
path) <- Text -> Either Text (Tls, Host, Maybe Port, Path)
parseUrl Text
url
  Request -> Either Text Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Port -> Tls -> Method -> Host -> Path -> Body -> Request
withPort Maybe Port
port Tls
tls Method
method Host
host Path
path Body
body)

getUrl ::
  Text ->
  Either Text Request
getUrl :: Text -> Either Text Request
getUrl =
  Method -> Body -> Text -> Either Text Request
fromUrl Method
Get Body
""

postUrl ::
  Body ->
  Text ->
  Either Text Request
postUrl :: Body -> Text -> Either Text Request
postUrl =
  Method -> Body -> Text -> Either Text Request
fromUrl Method
Post

putUrl ::
  Body ->
  Text ->
  Either Text Request
putUrl :: Body -> Text -> Either Text Request
putUrl =
  Method -> Body -> Text -> Either Text Request
fromUrl Method
Put

deleteUrl ::
  Text ->
  Either Text Request
deleteUrl :: Text -> Either Text Request
deleteUrl =
  Method -> Body -> Text -> Either Text Request
fromUrl Method
Delete Body
""