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