module Network.Mattermost.Proxy
  ( Scheme(..)
  , ProxyType(..)
  , proxyForScheme
  , proxyHostPermitted
  )
where

import Control.Applicative ((<|>))
import Data.Char (toLower)
import Data.List (isPrefixOf)
import Data.List.Split (splitOn)
import Network.URI (parseURI, uriRegName, uriPort, uriAuthority, uriScheme)
import System.Environment (getEnvironment, lookupEnv)
import Text.Read (readMaybe)

data Scheme = HTTPS
            deriving (Scheme -> Scheme -> Bool
(Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool) -> Eq Scheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c== :: Scheme -> Scheme -> Bool
Eq, Int -> Scheme -> ShowS
[Scheme] -> ShowS
Scheme -> String
(Int -> Scheme -> ShowS)
-> (Scheme -> String) -> ([Scheme] -> ShowS) -> Show Scheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scheme] -> ShowS
$cshowList :: [Scheme] -> ShowS
show :: Scheme -> String
$cshow :: Scheme -> String
showsPrec :: Int -> Scheme -> ShowS
$cshowsPrec :: Int -> Scheme -> ShowS
Show)

data ProxyType = Socks
               deriving (ProxyType -> ProxyType -> Bool
(ProxyType -> ProxyType -> Bool)
-> (ProxyType -> ProxyType -> Bool) -> Eq ProxyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProxyType -> ProxyType -> Bool
$c/= :: ProxyType -> ProxyType -> Bool
== :: ProxyType -> ProxyType -> Bool
$c== :: ProxyType -> ProxyType -> Bool
Eq, Int -> ProxyType -> ShowS
[ProxyType] -> ShowS
ProxyType -> String
(Int -> ProxyType -> ShowS)
-> (ProxyType -> String)
-> ([ProxyType] -> ShowS)
-> Show ProxyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProxyType] -> ShowS
$cshowList :: [ProxyType] -> ShowS
show :: ProxyType -> String
$cshow :: ProxyType -> String
showsPrec :: Int -> ProxyType -> ShowS
$cshowsPrec :: Int -> ProxyType -> ShowS
Show)

newtype NormalizedEnv = NormalizedEnv [(String, String)]

proxyHostPermitted :: String -> IO Bool
proxyHostPermitted :: String -> IO Bool
proxyHostPermitted String
hostname = do
    Maybe String
result <- String -> IO (Maybe String)
lookupEnv String
"NO_PROXY"
    case Maybe String
result of
        Maybe String
Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Just String
blacklist -> do
            let patterns :: [String]
patterns = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"," String
blacklist
                hostnameParts :: [String]
hostnameParts = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
hostname
                isBlacklisted :: Bool
isBlacklisted = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
matches [String]
patterns
                matches :: String -> Bool
matches String
pat =
                    let patParts :: [String]
patParts = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
pat
                        go :: [String] -> [String] -> Bool
go [] [] = Bool
True
                        go [] [String]
_ = Bool
False
                        go [String]
_ [] = Bool
False
                        go (String
p:[String]
pParts) (String
h:[String]
hTail) =
                            if String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"*"
                            then Bool
True
                            else String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
h Bool -> Bool -> Bool
&& [String] -> [String] -> Bool
go [String]
pParts [String]
hTail
                    in [String] -> [String] -> Bool
go [String]
patParts [String]
hostnameParts
            Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
isBlacklisted

proxyForScheme :: Scheme -> IO (Maybe (ProxyType, String, Int))
proxyForScheme :: Scheme -> IO (Maybe (ProxyType, String, Int))
proxyForScheme Scheme
s = do
    [(String, String)]
env <- IO [(String, String)]
getEnvironment
    let proxy :: NormalizedEnv -> Maybe (ProxyType, String, Int)
proxy = case Scheme
s of
          Scheme
HTTPS -> NormalizedEnv -> Maybe (ProxyType, String, Int)
httpsProxy
    Maybe (ProxyType, String, Int)
-> IO (Maybe (ProxyType, String, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ProxyType, String, Int)
 -> IO (Maybe (ProxyType, String, Int)))
-> Maybe (ProxyType, String, Int)
-> IO (Maybe (ProxyType, String, Int))
forall a b. (a -> b) -> a -> b
$ NormalizedEnv -> Maybe (ProxyType, String, Int)
proxy (NormalizedEnv -> Maybe (ProxyType, String, Int))
-> NormalizedEnv -> Maybe (ProxyType, String, Int)
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> NormalizedEnv
normalizeEnv [(String, String)]
env

httpsProxy :: NormalizedEnv -> Maybe (ProxyType, String, Int)
httpsProxy :: NormalizedEnv -> Maybe (ProxyType, String, Int)
httpsProxy NormalizedEnv
env = String -> NormalizedEnv -> Maybe (ProxyType, String, Int)
proxyFor String
"HTTPS_PROXY" NormalizedEnv
env Maybe (ProxyType, String, Int)
-> Maybe (ProxyType, String, Int) -> Maybe (ProxyType, String, Int)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                 String -> NormalizedEnv -> Maybe (ProxyType, String, Int)
proxyFor String
"ALL_PROXY" NormalizedEnv
env

proxyFor :: String -> NormalizedEnv -> Maybe (ProxyType, String, Int)
proxyFor :: String -> NormalizedEnv -> Maybe (ProxyType, String, Int)
proxyFor String
name NormalizedEnv
env = do
    String
val <- String -> NormalizedEnv -> Maybe String
envLookup String
name NormalizedEnv
env
    URI
uri <- String -> Maybe URI
parseURI String
val

    let scheme :: String
scheme = URI -> String
uriScheme URI
uri
        getProxyType :: Maybe ProxyType
getProxyType = Maybe ProxyType
isSocks
        isSocks :: Maybe ProxyType
isSocks = if String
"socks" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
scheme
                     then ProxyType -> Maybe ProxyType
forall (m :: * -> *) a. Monad m => a -> m a
return ProxyType
Socks
                     else Maybe ProxyType
forall a. Maybe a
Nothing

    ProxyType
ty <- Maybe ProxyType
getProxyType
    URIAuth
auth <- URI -> Maybe URIAuth
uriAuthority URI
uri
    Int
port <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ URIAuth -> String
uriPort URIAuth
auth)
    (ProxyType, String, Int) -> Maybe (ProxyType, String, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProxyType
ty, URIAuth -> String
uriRegName URIAuth
auth, Int
port)

normalizeEnv :: [(String, String)] -> NormalizedEnv
normalizeEnv :: [(String, String)] -> NormalizedEnv
normalizeEnv [(String, String)]
env =
    let norm :: (String, b) -> (String, b)
norm (String
k, b
v) = (ShowS
normalizeVar String
k, b
v)
    in [(String, String)] -> NormalizedEnv
NormalizedEnv ([(String, String)] -> NormalizedEnv)
-> [(String, String)] -> NormalizedEnv
forall a b. (a -> b) -> a -> b
$ (String, String) -> (String, String)
forall b. (String, b) -> (String, b)
norm ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, String)]
env

normalizeVar :: String -> String
normalizeVar :: ShowS
normalizeVar = (Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

envLookup :: String -> NormalizedEnv -> Maybe String
envLookup :: String -> NormalizedEnv -> Maybe String
envLookup String
v (NormalizedEnv [(String, String)]
env) = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ShowS
normalizeVar String
v) [(String, String)]
env