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
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
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
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
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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Just String
blacklist -> do
            let patterns :: [String]
patterns = forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"," String
blacklist
                hostnameParts :: [String]
hostnameParts = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
hostname
                isBlacklisted :: Bool
isBlacklisted = 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 = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== String
"*"
                            then Bool
True
                            else String
p 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
            forall (m :: * -> *) a. Monad m => a -> m a
return 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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NormalizedEnv -> Maybe (ProxyType, String, Int)
proxy 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 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" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
scheme
                     then forall (m :: * -> *) a. Monad m => a -> m a
return ProxyType
Socks
                     else forall a. Maybe a
Nothing

    ProxyType
ty <- Maybe ProxyType
getProxyType
    URIAuth
auth <- URI -> Maybe URIAuth
uriAuthority URI
uri
    Int
port <- forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ URIAuth -> String
uriPort URIAuth
auth)
    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 forall a b. (a -> b) -> a -> b
$ forall {b}. (String, b) -> (String, b)
norm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, String)]
env

normalizeVar :: String -> String
normalizeVar :: ShowS
normalizeVar = (Char -> Char
toLower 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) = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ShowS
normalizeVar String
v) [(String, String)]
env