Proxy.hs

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 (Eq, Show)

data ProxyType = Socks
               deriving (Eq, Show)

newtype NormalizedEnv = NormalizedEnv [(String, String)]

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

proxyForScheme :: Scheme -> IO (Maybe (ProxyType, String, Int))
proxyForScheme s = do
    env <- getEnvironment
    let proxy = case s of
          HTTPS -> httpsProxy
    return $ proxy $ normalizeEnv env

httpsProxy :: NormalizedEnv -> Maybe (ProxyType, String, Int)
httpsProxy env = proxyFor "HTTPS_PROXY" env <|>
                 proxyFor "ALL_PROXY" env

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

    let scheme = uriScheme uri
        getProxyType = isSocks
        isSocks = if "socks" `isPrefixOf` scheme
                     then return Socks
                     else Nothing

    ty <- getProxyType
    auth <- uriAuthority uri
    port <- readMaybe (drop 1 $ uriPort auth)
    return (ty, uriRegName auth, port)

normalizeEnv :: [(String, String)] -> NormalizedEnv
normalizeEnv env =
    let norm (k, v) = (normalizeVar k, v)
    in NormalizedEnv $ norm <$> env

normalizeVar :: String -> String
normalizeVar = (toLower <$>)

envLookup :: String -> NormalizedEnv -> Maybe String
envLookup v (NormalizedEnv env) = lookup (normalizeVar v) env