{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Mattermost.Types.Internal where
import Control.Monad (when)
import Data.Monoid ((<>))
import Data.Pool (Pool)
import qualified Network.Connection as C
import Control.Exception (finally)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Network.HTTP.Headers (Header, HeaderName(..), mkHeader)
import qualified Network.HTTP.Stream as HTTP
import qualified Data.ByteString.Char8 as B
import Network.Mattermost.Types.Base
import qualified Data.Text as T
data Token = Token String
deriving (ReadPrec [Token]
ReadPrec Token
Int -> ReadS Token
ReadS [Token]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Token]
$creadListPrec :: ReadPrec [Token]
readPrec :: ReadPrec Token
$creadPrec :: ReadPrec Token
readList :: ReadS [Token]
$creadList :: ReadS [Token]
readsPrec :: Int -> ReadS Token
$creadsPrec :: Int -> ReadS Token
Read, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Eq Token
Token -> Token -> Bool
Token -> Token -> Ordering
Token -> Token -> Token
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmax :: Token -> Token -> Token
>= :: Token -> Token -> Bool
$c>= :: Token -> Token -> Bool
> :: Token -> Token -> Bool
$c> :: Token -> Token -> Bool
<= :: Token -> Token -> Bool
$c<= :: Token -> Token -> Bool
< :: Token -> Token -> Bool
$c< :: Token -> Token -> Bool
compare :: Token -> Token -> Ordering
$ccompare :: Token -> Token -> Ordering
Ord)
getTokenString :: Token -> String
getTokenString :: Token -> String
getTokenString (Token String
s) = String
s
data AutoClose = No | Yes
deriving (ReadPrec [AutoClose]
ReadPrec AutoClose
Int -> ReadS AutoClose
ReadS [AutoClose]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AutoClose]
$creadListPrec :: ReadPrec [AutoClose]
readPrec :: ReadPrec AutoClose
$creadPrec :: ReadPrec AutoClose
readList :: ReadS [AutoClose]
$creadList :: ReadS [AutoClose]
readsPrec :: Int -> ReadS AutoClose
$creadsPrec :: Int -> ReadS AutoClose
Read, Int -> AutoClose -> ShowS
[AutoClose] -> ShowS
AutoClose -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutoClose] -> ShowS
$cshowList :: [AutoClose] -> ShowS
show :: AutoClose -> String
$cshow :: AutoClose -> String
showsPrec :: Int -> AutoClose -> ShowS
$cshowsPrec :: Int -> AutoClose -> ShowS
Show, AutoClose -> AutoClose -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutoClose -> AutoClose -> Bool
$c/= :: AutoClose -> AutoClose -> Bool
== :: AutoClose -> AutoClose -> Bool
$c== :: AutoClose -> AutoClose -> Bool
Eq, Eq AutoClose
AutoClose -> AutoClose -> Bool
AutoClose -> AutoClose -> Ordering
AutoClose -> AutoClose -> AutoClose
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AutoClose -> AutoClose -> AutoClose
$cmin :: AutoClose -> AutoClose -> AutoClose
max :: AutoClose -> AutoClose -> AutoClose
$cmax :: AutoClose -> AutoClose -> AutoClose
>= :: AutoClose -> AutoClose -> Bool
$c>= :: AutoClose -> AutoClose -> Bool
> :: AutoClose -> AutoClose -> Bool
$c> :: AutoClose -> AutoClose -> Bool
<= :: AutoClose -> AutoClose -> Bool
$c<= :: AutoClose -> AutoClose -> Bool
< :: AutoClose -> AutoClose -> Bool
$c< :: AutoClose -> AutoClose -> Bool
compare :: AutoClose -> AutoClose -> Ordering
$ccompare :: AutoClose -> AutoClose -> Ordering
Ord)
autoCloseToHeader :: AutoClose -> [Header]
AutoClose
No = []
autoCloseToHeader AutoClose
Yes = [HeaderName -> String -> Header
mkHeader HeaderName
HdrConnection String
"Close"]
data MMConn = MMConn { MMConn -> Connection
fromMMConn :: C.Connection
, MMConn -> IORef Bool
connConnected :: IORef Bool
}
closeMMConn :: MMConn -> IO ()
closeMMConn :: MMConn -> IO ()
closeMMConn MMConn
c = do
Bool
conn <- forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ MMConn -> IORef Bool
connConnected MMConn
c
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
conn forall a b. (a -> b) -> a -> b
$
Connection -> IO ()
C.connectionClose (MMConn -> Connection
fromMMConn MMConn
c)
forall a b. IO a -> IO b -> IO a
`finally` (forall a. IORef a -> a -> IO ()
writeIORef (MMConn -> IORef Bool
connConnected MMConn
c) Bool
False)
newMMConn :: C.Connection -> IO MMConn
newMMConn :: Connection -> IO MMConn
newMMConn Connection
c = do
IORef Bool
v <- forall a. a -> IO (IORef a)
newIORef Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Connection -> IORef Bool -> MMConn
MMConn Connection
c IORef Bool
v
isConnected :: MMConn -> IO Bool
isConnected :: MMConn -> IO Bool
isConnected = forall a. IORef a -> IO a
readIORef forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMConn -> IORef Bool
connConnected
maxLineLength :: Int
maxLineLength :: Int
maxLineLength = Int
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
16::Int)
dropTrailingChar :: B.ByteString -> B.ByteString
dropTrailingChar :: ByteString -> ByteString
dropTrailingChar ByteString
bs | Bool -> Bool
not (ByteString -> Bool
B.null ByteString
bs) = HasCallStack => ByteString -> ByteString
B.init ByteString
bs
dropTrailingChar ByteString
_ = ByteString
""
instance HTTP.Stream MMConn where
readLine :: MMConn -> IO (Result String)
readLine MMConn
con = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropTrailingChar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Connection -> IO ByteString
C.connectionGetLine Int
maxLineLength (MMConn -> Connection
fromMMConn MMConn
con)
readBlock :: MMConn -> Int -> IO (Result String)
readBlock MMConn
con Int
n = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Int -> IO ByteString
C.connectionGetExact (MMConn -> Connection
fromMMConn MMConn
con) Int
n
writeBlock :: MMConn -> String -> IO (Result ())
writeBlock MMConn
con String
block = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> ByteString -> IO ()
C.connectionPut (MMConn -> Connection
fromMMConn MMConn
con) (String -> ByteString
B.pack String
block)
close :: MMConn -> IO ()
close MMConn
con = Connection -> IO ()
C.connectionClose (MMConn -> Connection
fromMMConn MMConn
con)
closeOnEnd :: MMConn -> Bool -> IO ()
closeOnEnd MMConn
_ Bool
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
data ConnectionType =
ConnectHTTPS Bool
| ConnectHTTP
deriving (ConnectionType -> ConnectionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionType -> ConnectionType -> Bool
$c/= :: ConnectionType -> ConnectionType -> Bool
== :: ConnectionType -> ConnectionType -> Bool
$c== :: ConnectionType -> ConnectionType -> Bool
Eq, Int -> ConnectionType -> ShowS
[ConnectionType] -> ShowS
ConnectionType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionType] -> ShowS
$cshowList :: [ConnectionType] -> ShowS
show :: ConnectionType -> String
$cshow :: ConnectionType -> String
showsPrec :: Int -> ConnectionType -> ShowS
$cshowsPrec :: Int -> ConnectionType -> ShowS
Show, ReadPrec [ConnectionType]
ReadPrec ConnectionType
Int -> ReadS ConnectionType
ReadS [ConnectionType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConnectionType]
$creadListPrec :: ReadPrec [ConnectionType]
readPrec :: ReadPrec ConnectionType
$creadPrec :: ReadPrec ConnectionType
readList :: ReadS [ConnectionType]
$creadList :: ReadS [ConnectionType]
readsPrec :: Int -> ReadS ConnectionType
$creadsPrec :: Int -> ReadS ConnectionType
Read)
data ConnectionData
= ConnectionData
{ ConnectionData -> Text
cdHostname :: Hostname
, ConnectionData -> Int
cdPort :: Port
, ConnectionData -> Text
cdUrlPath :: T.Text
, ConnectionData -> AutoClose
cdAutoClose :: AutoClose
, ConnectionData -> Pool MMConn
cdConnectionPool :: Pool MMConn
, ConnectionData -> ConnectionContext
cdConnectionCtx :: C.ConnectionContext
, ConnectionData -> Maybe Token
cdToken :: Maybe Token
, ConnectionData -> Maybe Logger
cdLogger :: Maybe Logger
, ConnectionData -> ConnectionType
cdConnectionType :: ConnectionType
}
newtype ServerBaseURL = ServerBaseURL T.Text
deriving (ServerBaseURL -> ServerBaseURL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerBaseURL -> ServerBaseURL -> Bool
$c/= :: ServerBaseURL -> ServerBaseURL -> Bool
== :: ServerBaseURL -> ServerBaseURL -> Bool
$c== :: ServerBaseURL -> ServerBaseURL -> Bool
Eq, Int -> ServerBaseURL -> ShowS
[ServerBaseURL] -> ShowS
ServerBaseURL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerBaseURL] -> ShowS
$cshowList :: [ServerBaseURL] -> ShowS
show :: ServerBaseURL -> String
$cshow :: ServerBaseURL -> String
showsPrec :: Int -> ServerBaseURL -> ShowS
$cshowsPrec :: Int -> ServerBaseURL -> ShowS
Show)
connectionDataURL :: ConnectionData -> ServerBaseURL
connectionDataURL :: ConnectionData -> ServerBaseURL
connectionDataURL ConnectionData
cd =
let scheme :: Text
scheme = case ConnectionData -> ConnectionType
cdConnectionType ConnectionData
cd of
ConnectHTTPS {} -> Text
"https"
ConnectHTTP {} -> Text
"http"
host :: Text
host = ConnectionData -> Text
cdHostname ConnectionData
cd
port :: Text
port = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
if ConnectionData -> ConnectionType
cdConnectionType ConnectionData
cd forall a. Eq a => a -> a -> Bool
== ConnectionType
ConnectHTTP
then if ConnectionData -> Int
cdPort ConnectionData
cd forall a. Eq a => a -> a -> Bool
== Int
80 then String
"" else String
":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (ConnectionData -> Int
cdPort ConnectionData
cd)
else if ConnectionData -> Int
cdPort ConnectionData
cd forall a. Eq a => a -> a -> Bool
== Int
443 then String
"" else String
":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (ConnectionData -> Int
cdPort ConnectionData
cd)
path1 :: Text
path1 = ConnectionData -> Text
cdUrlPath ConnectionData
cd
path2 :: Text
path2 = if Text
"/" Text -> Text -> Bool
`T.isPrefixOf` Text
path1
then Text
path1 else Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
path1
in Text -> ServerBaseURL
ServerBaseURL forall a b. (a -> b) -> a -> b
$ Text
scheme forall a. Semigroup a => a -> a -> a
<> Text
"://" forall a. Semigroup a => a -> a -> a
<> Text
host forall a. Semigroup a => a -> a -> a
<> Text
port forall a. Semigroup a => a -> a -> a
<> Text
path2