{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Network.Mattermost.Util
( ConnectionType(..)
, assertE
, noteE
, hoistE
, (~=)
, withConnection
, mkConnection
, connectionGetExact
, buildPath
) where

import           Control.Exception (finally, onException)
import           Data.Char ( toUpper )
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified Text.URI as URI
import           Data.Monoid ((<>))

import           Control.Exception ( Exception
                                   , throwIO )
import           Data.Pool (takeResource, putResource, destroyResource)
import           Network.Connection ( Connection
                                    , ConnectionContext
                                    , ConnectionParams(..)
                                    , ProxySettings(..)
                                    , TLSSettings(..)
                                    , connectionGet
                                    , connectTo )

import           Network.Mattermost.Types.Base
import           Network.Mattermost.Types.Internal
import           Network.Mattermost.Proxy

-- | This unwraps a 'Maybe' value, throwing a provided exception
--   if the value is 'Nothing'.
noteE :: Exception e => Maybe r -> e -> IO r
noteE :: Maybe r -> e -> IO r
noteE Maybe r
Nothing  e
e  = e -> IO r
forall e a. Exception e => e -> IO a
throwIO e
e
noteE (Just r
r) e
_  = r -> IO r
forall (f :: * -> *) a. Applicative f => a -> f a
pure    r
r

-- | This unwraps an 'Either' value, throwing the contained exception
--   if the 'Either' was a 'Left' value.
hoistE :: Exception e => Either e r -> IO r
hoistE :: Either e r -> IO r
hoistE (Left e
e)  = e -> IO r
forall e a. Exception e => e -> IO a
throwIO e
e
hoistE (Right r
r) = r -> IO r
forall (f :: * -> *) a. Applicative f => a -> f a
pure    r
r

-- | This asserts that the provided 'Bool' is 'True', throwing a
--   provided exception is the argument was 'False'.
assertE :: Exception e => Bool -> e -> IO ()
assertE :: Bool -> e -> IO ()
assertE Bool
True  e
_ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure    ()
assertE Bool
False e
e = e -> IO ()
forall e a. Exception e => e -> IO a
throwIO e
e

-- | Case Insensitive string comparison
(~=) :: String -> String -> Bool
String
a ~= :: String -> String -> Bool
~= String
b = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
b

-- | Creates a new connection to 'Hostname' from an already initialized
-- 'ConnectionContext'.
withConnection :: ConnectionData -> (MMConn -> IO a) -> IO a
withConnection :: ConnectionData -> (MMConn -> IO a) -> IO a
withConnection ConnectionData
cd MMConn -> IO a
action = do
    (MMConn
conn, LocalPool MMConn
lp) <- Pool MMConn -> IO (MMConn, LocalPool MMConn)
forall a. Pool a -> IO (a, LocalPool a)
takeResource (ConnectionData -> Pool MMConn
cdConnectionPool ConnectionData
cd)
    (MMConn -> IO a
action MMConn
conn IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`onException` MMConn -> IO ()
closeMMConn MMConn
conn) IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` do
        Bool
c <- MMConn -> IO Bool
isConnected MMConn
conn
        if Bool
c then
             LocalPool MMConn -> MMConn -> IO ()
forall a. LocalPool a -> a -> IO ()
putResource LocalPool MMConn
lp MMConn
conn else
             Pool MMConn -> LocalPool MMConn -> MMConn -> IO ()
forall a. Pool a -> LocalPool a -> a -> IO ()
destroyResource (ConnectionData -> Pool MMConn
cdConnectionPool ConnectionData
cd) LocalPool MMConn
lp MMConn
conn

-- | Creates a connection from a 'ConnectionData' value, returning it. It
--   is the user's responsibility to close this appropriately.
--
-- This function respects ALL_PROXY, HTTP_PROXY, HTTPS_PROXY, and
-- NO_PROXY environment variables for controlling whether the resulting
-- connection uses a proxy. However, note:
--
-- * Only SOCKS version 4 and 5 proxies are supported using socks4://
--   and socks5:// URIs, and
-- * No proxy authentication is supported.
mkConnection :: ConnectionContext -> Hostname -> Port -> ConnectionType -> IO Connection
mkConnection :: ConnectionContext
-> Hostname -> Port -> ConnectionType -> IO Connection
mkConnection ConnectionContext
ctx Hostname
host Port
port ConnectionType
connTy = do
  Maybe (ProxyType, String, Port)
proxy' <- case ConnectionType
connTy of
     ConnectHTTPS Bool
_ -> Scheme -> IO (Maybe (ProxyType, String, Port))
proxyForScheme Scheme
HTTPS
     ConnectionType
ConnectHTTP -> Maybe (ProxyType, String, Port)
-> IO (Maybe (ProxyType, String, Port))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ProxyType, String, Port)
forall a. Maybe a
Nothing

  Bool
canUseProxy <- String -> IO Bool
proxyHostPermitted (Hostname -> String
T.unpack Hostname
host)
  let proxy :: Maybe (ProxyType, String, Port)
proxy = if Bool
canUseProxy then Maybe (ProxyType, String, Port)
proxy' else Maybe (ProxyType, String, Port)
forall a. Maybe a
Nothing
  ConnectionContext -> ConnectionParams -> IO Connection
connectTo ConnectionContext
ctx (ConnectionParams -> IO Connection)
-> ConnectionParams -> IO Connection
forall a b. (a -> b) -> a -> b
$ ConnectionParams :: String
-> PortNumber
-> Maybe TLSSettings
-> Maybe ProxySettings
-> ConnectionParams
ConnectionParams
    { connectionHostname :: String
connectionHostname  = Hostname -> String
T.unpack Hostname
host
    , connectionPort :: PortNumber
connectionPort      = Port -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Port
port
    , connectionUseSecure :: Maybe TLSSettings
connectionUseSecure = case ConnectionType
connTy of
        ConnectionType
ConnectHTTP -> Maybe TLSSettings
forall a. Maybe a
Nothing
        ConnectHTTPS Bool
requireTrustedCert ->
            -- The first argument to TLSSettingsSimple is whether to
            -- /disable/ cert validation. If requireTrustedCert is True,
            -- we want that argument to be False to force validation.
            TLSSettings -> Maybe TLSSettings
forall a. a -> Maybe a
Just (Bool -> Bool -> Bool -> TLSSettings
TLSSettingsSimple (Bool -> Bool
not Bool
requireTrustedCert) Bool
False Bool
False)
    , connectionUseSocks :: Maybe ProxySettings
connectionUseSocks  = do
        (ProxyType
ty, String
cHost, Port
cPort) <- Maybe (ProxyType, String, Port)
proxy
        case ProxyType
ty of
            ProxyType
Socks -> ProxySettings -> Maybe ProxySettings
forall (m :: * -> *) a. Monad m => a -> m a
return (ProxySettings -> Maybe ProxySettings)
-> ProxySettings -> Maybe ProxySettings
forall a b. (a -> b) -> a -> b
$ String -> PortNumber -> ProxySettings
SockSettingsSimple String
cHost (Port -> PortNumber
forall a. Enum a => Port -> a
toEnum Port
cPort)
    }

-- | Get exact count of bytes from a connection.
--
-- The size argument is the exact amount that must be returned to the user.
-- The call will wait until all data is available.  Hence, it behaves like
-- 'B.hGet'.
--
-- On end of input, 'connectionGetExact' will throw an 'E.isEOFError'
-- exception.
-- Taken from: https://github.com/vincenthz/hs-connection/issues/9
connectionGetExact :: Connection -> Int -> IO B.ByteString
connectionGetExact :: Connection -> Port -> IO ByteString
connectionGetExact Connection
con Port
n = ByteString -> Port -> IO ByteString
loop ByteString
B.empty Port
0
  where loop :: ByteString -> Port -> IO ByteString
loop ByteString
bs Port
y
          | Port
y Port -> Port -> Bool
forall a. Eq a => a -> a -> Bool
== Port
n = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
          | Bool
otherwise = do
            ByteString
next <- Connection -> Port -> IO ByteString
connectionGet Connection
con (Port
n Port -> Port -> Port
forall a. Num a => a -> a -> a
- Port
y)
            ByteString -> Port -> IO ByteString
loop (ByteString -> ByteString -> ByteString
B.append ByteString
bs ByteString
next) (Port
y Port -> Port -> Port
forall a. Num a => a -> a -> a
+ (ByteString -> Port
B.length ByteString
next))

-- | Build a full URI path from the path of an API endpoint
buildPath :: ConnectionData -> T.Text -> IO T.Text
buildPath :: ConnectionData -> Hostname -> IO Hostname
buildPath ConnectionData
cd Hostname
endpoint = do
  let rawPath :: Hostname
rawPath = Hostname
"/" Hostname -> Hostname -> Hostname
forall a. Semigroup a => a -> a -> a
<> ((Char -> Bool) -> Hostname -> Hostname
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') (Hostname -> Hostname) -> Hostname -> Hostname
forall a b. (a -> b) -> a -> b
$ ConnectionData -> Hostname
cdUrlPath ConnectionData
cd Hostname -> Hostname -> Hostname
forall a. Semigroup a => a -> a -> a
<> Hostname
"/api/v4/" Hostname -> Hostname -> Hostname
forall a. Semigroup a => a -> a -> a
<> Hostname
endpoint)
  URI
uri <- Hostname -> IO URI
forall (m :: * -> *). MonadThrow m => Hostname -> m URI
URI.mkURI Hostname
rawPath
  Hostname -> IO Hostname
forall (m :: * -> *) a. Monad m => a -> m a
return (Hostname -> IO Hostname) -> Hostname -> IO Hostname
forall a b. (a -> b) -> a -> b
$ URI -> Hostname
URI.render URI
uri