{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
-- | The types defined in this module are exported to facilitate
-- efforts such as QuickCheck and other instrospection efforts, but
-- users are advised to avoid using these types wherever possible:
-- they can be used in a manner that would cause significant
-- disruption and may be subject to change without being reflected in
-- the mattermost-api version.

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]
(Int -> ReadS Token)
-> ReadS [Token]
-> ReadPrec Token
-> ReadPrec [Token]
-> Read 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
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
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
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
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
Eq Token
-> (Token -> Token -> Ordering)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Token)
-> (Token -> Token -> Token)
-> Ord 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
$cp1Ord :: Eq Token
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]
(Int -> ReadS AutoClose)
-> ReadS [AutoClose]
-> ReadPrec AutoClose
-> ReadPrec [AutoClose]
-> Read 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
(Int -> AutoClose -> ShowS)
-> (AutoClose -> String)
-> ([AutoClose] -> ShowS)
-> Show AutoClose
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
(AutoClose -> AutoClose -> Bool)
-> (AutoClose -> AutoClose -> Bool) -> Eq AutoClose
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
Eq AutoClose
-> (AutoClose -> AutoClose -> Ordering)
-> (AutoClose -> AutoClose -> Bool)
-> (AutoClose -> AutoClose -> Bool)
-> (AutoClose -> AutoClose -> Bool)
-> (AutoClose -> AutoClose -> Bool)
-> (AutoClose -> AutoClose -> AutoClose)
-> (AutoClose -> AutoClose -> AutoClose)
-> Ord 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
$cp1Ord :: Eq AutoClose
Ord)

-- | We return a list of headers so that we can treat
-- the headers like a monoid.
autoCloseToHeader :: AutoClose -> [Header]
autoCloseToHeader :: AutoClose -> [Header]
autoCloseToHeader 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 <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (IORef Bool -> IO Bool) -> IORef Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ MMConn -> IORef Bool
connConnected MMConn
c
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
conn (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Connection -> IO ()
C.connectionClose (MMConn -> Connection
fromMMConn MMConn
c)
            IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` (IORef Bool -> Bool -> IO ()
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 <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True
    MMConn -> IO MMConn
forall (m :: * -> *) a. Monad m => a -> m a
return (MMConn -> IO MMConn) -> MMConn -> IO MMConn
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 = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (IORef Bool -> IO Bool)
-> (MMConn -> IORef Bool) -> MMConn -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMConn -> IORef Bool
connConnected

maxLineLength :: Int
maxLineLength :: Int
maxLineLength = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
16::Int)

-- | HTTP ends newlines with \r\n sequence, but the 'connection' package doesn't
-- know this so we need to drop the \r after reading lines. This should only be
-- needed in your compatibility with the HTTP library.
dropTrailingChar :: B.ByteString -> B.ByteString
dropTrailingChar :: ByteString -> ByteString
dropTrailingChar ByteString
bs | Bool -> Bool
not (ByteString -> Bool
B.null ByteString
bs) = ByteString -> ByteString
B.init ByteString
bs
dropTrailingChar ByteString
_ = ByteString
""

-- | This instance allows us to use 'simpleHTTP' from 'Network.HTTP.Stream' with
-- connections from the 'connection' package.
instance HTTP.Stream MMConn where
  readLine :: MMConn -> IO (Result String)
readLine   MMConn
con       = String -> Result String
forall a b. b -> Either a b
Right (String -> Result String)
-> (ByteString -> String) -> ByteString -> Result String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropTrailingChar (ByteString -> Result String)
-> IO ByteString -> IO (Result String)
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     = String -> Result String
forall a b. b -> Either a b
Right (String -> Result String)
-> (ByteString -> String) -> ByteString -> Result String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack (ByteString -> Result String)
-> IO ByteString -> IO (Result String)
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 = () -> Result ()
forall a b. b -> Either a b
Right (() -> Result ()) -> IO () -> IO (Result ())
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
_     = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

data ConnectionType =
    ConnectHTTPS Bool
    -- ^ Boolean is whether to require trusted certificate
    | ConnectHTTP
    -- ^ Make an insecure connection over HTTP
    deriving (ConnectionType -> ConnectionType -> Bool
(ConnectionType -> ConnectionType -> Bool)
-> (ConnectionType -> ConnectionType -> Bool) -> Eq ConnectionType
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
(Int -> ConnectionType -> ShowS)
-> (ConnectionType -> String)
-> ([ConnectionType] -> ShowS)
-> Show ConnectionType
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]
(Int -> ReadS ConnectionType)
-> ReadS [ConnectionType]
-> ReadPrec ConnectionType
-> ReadPrec [ConnectionType]
-> Read 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 -> Hostname
cdHostname       :: Hostname
  , ConnectionData -> Int
cdPort           :: Port
  , ConnectionData -> Hostname
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
(ServerBaseURL -> ServerBaseURL -> Bool)
-> (ServerBaseURL -> ServerBaseURL -> Bool) -> Eq ServerBaseURL
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
(Int -> ServerBaseURL -> ShowS)
-> (ServerBaseURL -> String)
-> ([ServerBaseURL] -> ShowS)
-> Show ServerBaseURL
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 :: Hostname
scheme = case ConnectionData -> ConnectionType
cdConnectionType ConnectionData
cd of
            ConnectHTTPS {} -> Hostname
"https"
            ConnectHTTP {} -> Hostname
"http"
        host :: Hostname
host = ConnectionData -> Hostname
cdHostname ConnectionData
cd
        port :: Hostname
port = String -> Hostname
T.pack (String -> Hostname) -> String -> Hostname
forall a b. (a -> b) -> a -> b
$
               if ConnectionData -> ConnectionType
cdConnectionType ConnectionData
cd ConnectionType -> ConnectionType -> Bool
forall a. Eq a => a -> a -> Bool
== ConnectionType
ConnectHTTP
               then if ConnectionData -> Int
cdPort ConnectionData
cd Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
80 then String
"" else String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ConnectionData -> Int
cdPort ConnectionData
cd)
               else if ConnectionData -> Int
cdPort ConnectionData
cd Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
443 then String
"" else String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ConnectionData -> Int
cdPort ConnectionData
cd)
        path1 :: Hostname
path1 = ConnectionData -> Hostname
cdUrlPath ConnectionData
cd
        path2 :: Hostname
path2 = if Hostname
"/" Hostname -> Hostname -> Bool
`T.isPrefixOf` Hostname
path1
                then Hostname
path1 else Hostname
"/" Hostname -> Hostname -> Hostname
forall a. Semigroup a => a -> a -> a
<> Hostname
path1
    in Hostname -> ServerBaseURL
ServerBaseURL (Hostname -> ServerBaseURL) -> Hostname -> ServerBaseURL
forall a b. (a -> b) -> a -> b
$ Hostname
scheme Hostname -> Hostname -> Hostname
forall a. Semigroup a => a -> a -> a
<> Hostname
"://" Hostname -> Hostname -> Hostname
forall a. Semigroup a => a -> a -> a
<> Hostname
host Hostname -> Hostname -> Hostname
forall a. Semigroup a => a -> a -> a
<> Hostname
port Hostname -> Hostname -> Hostname
forall a. Semigroup a => a -> a -> a
<> Hostname
path2