{-|
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
  { Proxy -> Text
proxyScheme :: Text
  , Proxy -> Text
proxyHost   :: Text
  , Proxy -> Integer
proxyPort   :: Integer
  , Proxy -> Text
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 :: Text -> Bool
isMalformedProxyUri Text
uri
  | String -> Bool
isAbsoluteURI (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
uri) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ URI -> Bool
isUriValid (URI -> Bool) -> URI -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> URI
toURI Text
uri
  | Bool
otherwise = Bool
True

toURI :: Text -> URI
toURI :: Text -> URI
toURI Text
uri = Maybe URI -> URI
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe URI -> URI) -> Maybe URI -> URI
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
parseURI (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
uri)

isUriValid:: URI -> Bool
isUriValid :: URI -> Bool
isUriValid = [URI -> Bool] -> URI -> Bool
forall a. [a -> Bool] -> a -> Bool
fAnd [URI -> Bool
isSchemeValid, URI -> Bool
isQueryValid, URI -> Bool
isAuthorityValid]

fAnd :: [a -> Bool] -> a -> Bool
fAnd :: [a -> Bool] -> a -> Bool
fAnd [a -> Bool]
fs a
x = ((a -> Bool) -> Bool) -> [a -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ a
x) [a -> Bool]
fs

isSchemeValid :: URI -> Bool
isSchemeValid :: URI -> Bool
isSchemeValid URI {uriScheme :: URI -> String
uriScheme = String
s}
  | Text -> Text
T.toLower (String -> Text
T.pack String
s) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"https:" = Bool
True
  | Text -> Text
T.toLower (String -> Text
T.pack String
s) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"http:" = Bool
True
  | Bool
otherwise = Bool
False

isQueryValid :: URI -> Bool
isQueryValid :: URI -> Bool
isQueryValid URI {uriQuery :: URI -> String
uriQuery = String
""} = Bool
True
isQueryValid URI
_                   = Bool
False

isAuthorityValid :: URI -> Bool
isAuthorityValid :: URI -> Bool
isAuthorityValid URI {uriAuthority :: URI -> Maybe URIAuth
uriAuthority = Maybe URIAuth
a}
  | Maybe URIAuth -> Bool
forall a. Maybe a -> Bool
isJust Maybe URIAuth
a = [URIAuth -> Bool] -> URIAuth -> Bool
forall a. [a -> Bool] -> a -> Bool
fAnd [URIAuth -> Bool
isUserInfoValid, URIAuth -> Bool
isHostValid, URIAuth -> Bool
isPortValid] (URIAuth -> Bool) -> URIAuth -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe URIAuth -> URIAuth
forall a. HasCallStack => Maybe a -> a
fromJust Maybe URIAuth
a
  | Bool
otherwise = Bool
False

isUserInfoValid :: URIAuth -> Bool
isUserInfoValid :: URIAuth -> Bool
isUserInfoValid URIAuth {uriUserInfo :: URIAuth -> String
uriUserInfo = String
""} = Bool
True
isUserInfoValid URIAuth
_                          = Bool
False

isHostValid :: URIAuth -> Bool
isHostValid :: URIAuth -> Bool
isHostValid URIAuth {uriRegName :: URIAuth -> String
uriRegName = String
""} = Bool
False
isHostValid URIAuth
_                         = Bool
True

isPortValid :: URIAuth -> Bool
isPortValid :: URIAuth -> Bool
isPortValid URIAuth {uriPort :: URIAuth -> String
uriPort = String
""} = Bool
True
isPortValid URIAuth {uriPort :: URIAuth -> String
uriPort = (Char
':':String
p)} =
  case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe String
p of
    Just Integer
i  -> Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> (Integer
0 :: Integer) Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
65536
    Maybe Integer
Nothing -> Bool
False
isPortValid URIAuth
_ = Bool
False