{-# 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
noteE :: Exception e => Maybe r -> e -> IO r
noteE :: forall e r. Exception e => 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r
hoistE :: Exception e => Either e r -> IO r
hoistE :: forall e r. Exception e => 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r
assertE :: Exception e => Bool -> e -> IO ()
assertE :: forall e. Exception e => Bool -> e -> IO ()
assertE Bool
True e
_ = () -> IO ()
forall a. a -> IO a
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
(~=) :: String -> String -> Bool
[Char]
a ~= :: [Char] -> [Char] -> Bool
~= [Char]
b = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
a [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
b
withConnection :: ConnectionData -> (MMConn -> IO a) -> IO a
withConnection :: forall a. 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
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, [Char], Port)
proxy' <- case ConnectionType
connTy of
ConnectHTTPS Bool
_ -> Scheme -> IO (Maybe (ProxyType, [Char], Port))
proxyForScheme Scheme
HTTPS
ConnectionType
ConnectHTTP -> Maybe (ProxyType, [Char], Port)
-> IO (Maybe (ProxyType, [Char], Port))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ProxyType, [Char], Port)
forall a. Maybe a
Nothing
Bool
canUseProxy <- [Char] -> IO Bool
proxyHostPermitted (Hostname -> [Char]
T.unpack Hostname
host)
let proxy :: Maybe (ProxyType, [Char], Port)
proxy = if Bool
canUseProxy then Maybe (ProxyType, [Char], Port)
proxy' else Maybe (ProxyType, [Char], 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
{ connectionHostname :: [Char]
connectionHostname = Hostname -> [Char]
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 ->
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, [Char]
cHost, Port
cPort) <- Maybe (ProxyType, [Char], Port)
proxy
case ProxyType
ty of
ProxyType
Socks -> ProxySettings -> Maybe ProxySettings
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProxySettings -> Maybe ProxySettings)
-> ProxySettings -> Maybe ProxySettings
forall a b. (a -> b) -> a -> b
$ [Char] -> PortNumber -> ProxySettings
SockSettingsSimple [Char]
cHost (Port -> PortNumber
forall a. Enum a => Port -> a
toEnum Port
cPort)
}
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 a. a -> IO a
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))
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 a. a -> IO a
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