1{-# LANGUAGE ScopedTypeVariables #-} 2{-# LANGUAGE OverloadedStrings #-} 3-- | The types defined in this module are exported to facilitate 4-- efforts such as QuickCheck and other instrospection efforts, but 5-- users are advised to avoid using these types wherever possible: 6-- they can be used in a manner that would cause significant 7-- disruption and may be subject to change without being reflected in 8-- the mattermost-api version. 9 10module Network.Mattermost.Types.Internal where 11 12import Control.Monad (when) 13import Data.Monoid ((<>)) 14import Data.Pool (Pool) 15import qualified Network.Connection as C 16import Control.Exception (finally) 17import Data.IORef (IORef, newIORef, readIORef, writeIORef) 18import Network.HTTP.Headers (Header, HeaderName(..), mkHeader) 19import qualified Network.HTTP.Stream as HTTP 20import qualified Data.ByteString.Char8 as B 21import Network.Mattermost.Types.Base 22import qualified Data.Text as T 23 24data Token = Token String 25 deriving (Read, Show, Eq, Ord) 26 27getTokenString :: Token -> String 28getTokenString (Token s) = s 29 30data AutoClose = No | Yes 31 deriving (Read, Show, Eq, Ord) 32 33-- | We return a list of headers so that we can treat 34-- the headers like a monoid. 35autoCloseToHeader :: AutoClose -> [Header] 36autoCloseToHeader No = [] 37autoCloseToHeader Yes = [mkHeader HdrConnection "Close"] 38 39data MMConn = MMConn { fromMMConn :: C.Connection 40 , connConnected :: IORef Bool 41 } 42 43closeMMConn :: MMConn -> IO () 44closeMMConn c = do 45 conn <- readIORef $ connConnected c 46 when conn $ 47 C.connectionClose (fromMMConn c) 48 `finally` (writeIORef (connConnected c) False) 49 50newMMConn :: C.Connection -> IO MMConn 51newMMConn c = do 52 v <- newIORef True 53 return $ MMConn c v 54 55isConnected :: MMConn -> IO Bool 56isConnected = readIORef . connConnected 57 58maxLineLength :: Int 59maxLineLength = 2^(16::Int) 60 61-- | HTTP ends newlines with \r\n sequence, but the 'connection' package doesn't 62-- know this so we need to drop the \r after reading lines. This should only be 63-- needed in your compatibility with the HTTP library. 64dropTrailingChar :: B.ByteString -> B.ByteString 65dropTrailingChar bs | not (B.null bs) = B.init bs 66dropTrailingChar _ = "" 67 68-- | This instance allows us to use 'simpleHTTP' from 'Network.HTTP.Stream' with 69-- connections from the 'connection' package. 70instance HTTP.Stream MMConn where 71 readLine con = Right . B.unpack . dropTrailingChar <$> C.connectionGetLine maxLineLength (fromMMConn con) 72 readBlock con n = Right . B.unpack <$> C.connectionGetExact (fromMMConn con) n 73 writeBlock con block = Right <$> C.connectionPut (fromMMConn con) (B.pack block) 74 close con = C.connectionClose (fromMMConn con) 75 closeOnEnd _ _ = return () 76 77data ConnectionType = 78 ConnectHTTPS Bool 79 -- ^ Boolean is whether to require trusted certificate 80 | ConnectHTTP 81 -- ^ Make an insecure connection over HTTP 82 deriving (Eq, Show, Read) 83 84data ConnectionData 85 = ConnectionData 86 { cdHostname :: Hostname 87 , cdPort :: Port 88 , cdUrlPath :: T.Text 89 , cdAutoClose :: AutoClose 90 , cdConnectionPool :: Pool MMConn 91 , cdConnectionCtx :: C.ConnectionContext 92 , cdToken :: Maybe Token 93 , cdLogger :: Maybe Logger 94 , cdConnectionType :: ConnectionType 95 } 96 97newtype ServerBaseURL = ServerBaseURL T.Text 98 deriving (Eq, Show) 99 100connectionDataURL :: ConnectionData -> ServerBaseURL 101connectionDataURL cd = 102 let scheme = case cdConnectionType cd of 103 ConnectHTTPS {} -> "https" 104 ConnectHTTP {} -> "http" 105 host = cdHostname cd 106 port = T.pack $ 107 if cdConnectionType cd == ConnectHTTP 108 then if cdPort cd == 80 then "" else ":" <> show (cdPort cd) 109 else if cdPort cd == 443 then "" else ":" <> show (cdPort cd) 110 path1 = cdUrlPath cd 111 path2 = if "/" `T.isPrefixOf` path1 112 then path1 else "/" <> path1 113 in ServerBaseURL $ scheme <> "://" <> host <> port <> path2 114