postgrest-9.0.0: src/PostgREST/Config/Proxy.hs
{-|
Module : PostgREST.Private.ProxyUri
Description : Proxy Uri validator
-}
module PostgREST.Config.Proxy
( Proxy(..)
, isMalformedProxyUri
, toURI
) where
import qualified Data.Text as T
import Data.Maybe (fromJust)
import Network.URI (URI (..), URIAuth (..), isAbsoluteURI, parseURI)
import Protolude hiding (Proxy)
data Proxy = Proxy
{ proxyScheme :: Text
, proxyHost :: Text
, proxyPort :: Integer
, proxyPath :: Text
}
{-|
Test whether a proxy uri is malformed or not.
A valid proxy uri should be an absolute uri without query and user info,
only http(s) schemes are valid, port number range is 1-65535.
For example
http://postgrest.com/openapi.json
https://postgrest.com:8080/openapi.json
-}
isMalformedProxyUri :: Text -> Bool
isMalformedProxyUri uri
| isAbsoluteURI (toS uri) = not $ isUriValid $ toURI uri
| otherwise = True
toURI :: Text -> URI
toURI uri = fromJust $ parseURI (toS uri)
isUriValid:: URI -> Bool
isUriValid = fAnd [isSchemeValid, isQueryValid, isAuthorityValid]
fAnd :: [a -> Bool] -> a -> Bool
fAnd fs x = all ($ x) fs
isSchemeValid :: URI -> Bool
isSchemeValid URI {uriScheme = s}
| T.toLower (T.pack s) == "https:" = True
| T.toLower (T.pack s) == "http:" = True
| otherwise = False
isQueryValid :: URI -> Bool
isQueryValid URI {uriQuery = ""} = True
isQueryValid _ = False
isAuthorityValid :: URI -> Bool
isAuthorityValid URI {uriAuthority = a}
| isJust a = fAnd [isUserInfoValid, isHostValid, isPortValid] $ fromJust a
| otherwise = False
isUserInfoValid :: URIAuth -> Bool
isUserInfoValid URIAuth {uriUserInfo = ""} = True
isUserInfoValid _ = False
isHostValid :: URIAuth -> Bool
isHostValid URIAuth {uriRegName = ""} = False
isHostValid _ = True
isPortValid :: URIAuth -> Bool
isPortValid URIAuth {uriPort = ""} = True
isPortValid URIAuth {uriPort = (':':p)} =
case readMaybe p of
Just i -> i > (0 :: Integer) && i < 65536
Nothing -> False
isPortValid _ = False