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 scheme :: Text
scheme url :: 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 target :: Text
target t :: Text
t =
  case Text -> Text -> (Text, Text)
Text.breakOn Text
target Text
t of
    (a :: Text
a, "") -> (Text
a, Maybe Text
forall a. Maybe a
Nothing)
    (a :: Text
a, b :: 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 url :: Text
url = \case
  (full :: Text
full, Nothing) -> (Tls, Text) -> Either Text (Tls, Text)
forall a b. b -> Either a b
Right (Bool -> Tls
Tls Bool
True, Text
full)
  ("https", Just rest :: Text
rest) -> (Tls, Text) -> Either Text (Tls, Text)
forall a b. b -> Either a b
Right (Bool -> Tls
Tls Bool
True, Text
rest)
  ("http", Just rest :: Text
rest) -> (Tls, Text) -> Either Text (Tls, Text)
forall a b. b -> Either a b
Right (Bool -> Tls
Tls Bool
False, Text
rest)
  (scheme :: Text
scheme, _) -> 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 url :: Text
url = \case
  (host :: Text
host, 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)
  (host :: 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 port :: 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))
  (_, Just port :: 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 url :: Text
url = do
  (tls :: Tls
tls, Text -> Text -> (Text, Maybe Text)
split "/" -> (hostPort :: Text
hostPort, path :: Maybe Text
path)) <- Text -> (Text, Maybe Text) -> Either Text (Tls, Text)
parseScheme Text
url (Text -> Text -> (Text, Maybe Text)
split "://" Text
url)
  (host :: Host
host, port :: Maybe Port
port) <- Text -> (Text, Maybe Text) -> Either Text (Host, Maybe Port)
parseHostPort Text
url (Text -> Text -> (Text, Maybe Text)
split ":" 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 "" Maybe Text
path))

withPort ::
  Maybe Port ->
  Tls ->
  Method ->
  Host ->
  Path ->
  Body ->
  Request
withPort :: Maybe Port -> Tls -> Method -> Host -> Path -> Body -> Request
withPort port :: Maybe Port
port tls :: Tls
tls method :: Method
method host :: Host
host path :: 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
host path :: Path
path =
  Method -> Host -> Path -> Body -> Request
simple Method
Get Host
host Path
path ""

post ::
  Host ->
  Path ->
  Body ->
  Request
post :: Host -> Path -> Body -> Request
post host :: Host
host path :: 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
host path :: 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
host path :: Path
path =
  Method -> Host -> Path -> Body -> Request
simple Method
Delete Host
host Path
path ""

fromUrl ::
  Method ->
  Body ->
  Text ->
  Either Text Request
fromUrl :: Method -> Body -> Text -> Either Text Request
fromUrl method :: Method
method body :: Body
body url :: Text
url = do
  (tls :: Tls
tls, host :: Host
host, port :: Maybe Port
port, path :: 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 ""

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 ""