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