git.iko.soy/servant
on master help sign in
Merge pull request #89 from PierreR/master
e8f7c69Julian Arni
servant-client/src/Servant/Common/BaseUrl.hs+23−9
compare with master
unifiedsplit
@@ -1,8 +1,19 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
1−{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE ViewPatterns #-}
3+{-# LANGUAGE ViewPatterns #-}
3−module Servant.Common.BaseUrl where
4+module Servant.Common.BaseUrl (
5+ -- * types
6+ BaseUrl (..)
7+ , InvalidBaseUrlException
8+ , Scheme (..)
9+ -- * functions
10+ , parseBaseUrl
11+ , showBaseUrl
12+) where
4
13
14+import Control.Monad.Catch (MonadThrow, throwM, Exception)
5import Data.List
15import Data.List
16+import Data.Typeable
6import GHC.Generics
17import GHC.Generics
7import Network.URI
18import Network.URI
8import Safe
19import Safe
@@ -34,20 +45,23 @@ showBaseUrl (BaseUrl urlscheme host port) =
34 (Https, 443) -> ""
45 (Https, 443) -> ""
35 _ -> ":" ++ show port
46 _ -> ":" ++ show port
36
47
48+data InvalidBaseUrlException = InvalidBaseUrlException String deriving (Show, Typeable)
49+instance Exception InvalidBaseUrlException
50+
37−parseBaseUrl :: String -> Either String BaseUrl
51+parseBaseUrl :: MonadThrow m => String -> m BaseUrl
38parseBaseUrl s = case parseURI (removeTrailingSlash s) of
52parseBaseUrl s = case parseURI (removeTrailingSlash s) of
39 -- This is a rather hacky implementation and should be replaced with something
53 -- This is a rather hacky implementation and should be replaced with something
40 -- implemented in attoparsec (which is already a dependency anyhow (via aeson)).
54 -- implemented in attoparsec (which is already a dependency anyhow (via aeson)).
41 Just (URI "http:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) "" "" "") ->
55 Just (URI "http:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) "" "" "") ->
42− Right (BaseUrl Http host port)
56+ return (BaseUrl Http host port)
43 Just (URI "http:" (Just (URIAuth "" host "")) "" "" "") ->
57 Just (URI "http:" (Just (URIAuth "" host "")) "" "" "") ->
44− Right (BaseUrl Http host 80)
58+ return (BaseUrl Http host 80)
45 Just (URI "https:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) "" "" "") ->
59 Just (URI "https:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) "" "" "") ->
46− Right (BaseUrl Https host port)
60+ return (BaseUrl Https host port)
47 Just (URI "https:" (Just (URIAuth "" host "")) "" "" "") ->
61 Just (URI "https:" (Just (URIAuth "" host "")) "" "" "") ->
48− Right (BaseUrl Https host 443)
62+ return (BaseUrl Https host 443)
49 _ -> if "://" `isInfixOf` s
63 _ -> if "://" `isInfixOf` s
50− then Left ("invalid base url: " ++ s)
64+ then throwM (InvalidBaseUrlException $ "Invalid base URL: " ++ s)
51 else parseBaseUrl ("http://" ++ s)
65 else parseBaseUrl ("http://" ++ s)
52 where
66 where
53 removeTrailingSlash str = case lastMay str of
67 removeTrailingSlash str = case lastMay str of
servant-client/src/Servant/Common/Req.hs+5−1
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE CPP #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE ScopedTypeVariables #-}
@@ -18,6 +19,7 @@ import Data.String.Conversions
18import Data.Proxy
19import Data.Proxy
19import Data.Text (Text)
20import Data.Text (Text)
20import Data.Text.Encoding
21import Data.Text.Encoding
22+import Data.Typeable
21import Network.HTTP.Client hiding (Proxy)
23import Network.HTTP.Client hiding (Proxy)
22import Network.HTTP.Client.TLS
24import Network.HTTP.Client.TLS
23import Network.HTTP.Media
25import Network.HTTP.Media
@@ -53,7 +55,9 @@ data ServantError
53 { responseContentTypeHeader :: ByteString
55 { responseContentTypeHeader :: ByteString
54 , responseBody :: ByteString
56 , responseBody :: ByteString
55 }
57 }
56− deriving (Show)
58+ deriving (Show, Typeable)
59+
60+instance Exception ServantError
57
61
58data Req = Req
62data Req = Req
59 { reqPath :: String
63 { reqPath :: String