Request.hs

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 scheme url =
  Left [qt|invalid scheme `#{scheme}` in url: #{url}|]

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

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

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

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

withPort ::
  Maybe Port ->
  Tls ->
  Method ->
  Host ->
  Path ->
  Body ->
  Request
withPort port tls method host path =
  Request method host port tls path [] []

withTls ::
  Tls ->
  Method ->
  Host ->
  Path ->
  Body ->
  Request
withTls =
  withPort Nothing

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

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

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

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

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

fromUrl ::
  Method ->
  Body ->
  Text ->
  Either Text Request
fromUrl method body url = do
  (tls, host, port, path) <- parseUrl url
  pure (withPort port tls method host path body)

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

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

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

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