1{-|
2Module      : PostgREST.Private.ProxyUri
3Description : Proxy Uri validator
4-}
5module PostgREST.Config.Proxy
6  ( Proxy(..)
7  , isMalformedProxyUri
8  , toURI
9  ) where
10
11import Data.Maybe  (fromJust)
12import Data.Text   (pack, toLower)
13import Network.URI (URI (..), URIAuth (..), isAbsoluteURI, parseURI)
14
15import Protolude      hiding (Proxy, dropWhile, get, intercalate,
16                       toLower, toS, (&))
17import Protolude.Conv (toS)
18
19data Proxy = Proxy
20  { proxyScheme :: Text
21  , proxyHost   :: Text
22  , proxyPort   :: Integer
23  , proxyPath   :: Text
24  }
25
26{-|
27  Test whether a proxy uri is malformed or not.
28  A valid proxy uri should be an absolute uri without query and user info,
29  only http(s) schemes are valid, port number range is 1-65535.
30
31  For example
32  http://postgrest.com/openapi.json
33  https://postgrest.com:8080/openapi.json
34-}
35isMalformedProxyUri :: Text -> Bool
36isMalformedProxyUri uri
37  | isAbsoluteURI (toS uri) = not $ isUriValid $ toURI uri
38  | otherwise = True
39
40toURI :: Text -> URI
41toURI uri = fromJust $ parseURI (toS uri)
42
43isUriValid:: URI -> Bool
44isUriValid = fAnd [isSchemeValid, isQueryValid, isAuthorityValid]
45
46fAnd :: [a -> Bool] -> a -> Bool
47fAnd fs x = all ($ x) fs
48
49isSchemeValid :: URI -> Bool
50isSchemeValid URI {uriScheme = s}
51  | toLower (pack s) == "https:" = True
52  | toLower (pack s) == "http:" = True
53  | otherwise = False
54
55isQueryValid :: URI -> Bool
56isQueryValid URI {uriQuery = ""} = True
57isQueryValid _                   = False
58
59isAuthorityValid :: URI -> Bool
60isAuthorityValid URI {uriAuthority = a}
61  | isJust a = fAnd [isUserInfoValid, isHostValid, isPortValid] $ fromJust a
62  | otherwise = False
63
64isUserInfoValid :: URIAuth -> Bool
65isUserInfoValid URIAuth {uriUserInfo = ""} = True
66isUserInfoValid _                          = False
67
68isHostValid :: URIAuth -> Bool
69isHostValid URIAuth {uriRegName = ""} = False
70isHostValid _                         = True
71
72isPortValid :: URIAuth -> Bool
73isPortValid URIAuth {uriPort = ""} = True
74isPortValid URIAuth {uriPort = (':':p)} =
75  case readMaybe p of
76    Just i  -> i > (0 :: Integer) && i < 65536
77    Nothing -> False
78isPortValid _ = False
79