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] hParts = if String p String -> String -> Bool forall a. Eq a => a -> a -> Bool == String "*" then Bool True else case [String] hParts of [] -> Bool False (String h:[String] hTail) -> 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