    --------------------------------------------------------------------------------
    -- | This module exposes connection internals
    {-# LANGUAGE OverloadedStrings #-}
    module Network.WebSockets.Connection
        ( PendingConnection (..)
        , acceptRequest
        , AcceptRequest(..)
        , defaultAcceptRequest
        , acceptRequestWith
        , rejectRequest
        , RejectRequest(..)
        , defaultRejectRequest
        , rejectRequestWith

        , Connection (..)

        , ConnectionOptions (..)
        , defaultConnectionOptions

        , receive
        , receiveDataMessage
        , receiveData
        , send
        , sendDataMessage
        , sendDataMessages
        , sendTextData
        , sendTextDatas
        , sendBinaryData
        , sendBinaryDatas
        , sendClose
        , sendCloseCode
        , sendPing
        , sendPong

        , withPingThread
        , forkPingThread
        , pingThread

        , CompressionOptions (..)
        , PermessageDeflate (..)
        , defaultPermessageDeflate

        , SizeLimit (..)
        ) where

    --------------------------------------------------------------------------------
    import           Control.Applicative                             ((<$>))
    import           Control.Concurrent                              (forkIO,
                                                                      threadDelay)
    import qualified Control.Concurrent.Async                        as Async
    import           Control.Concurrent.MVar                         (MVar, newEmptyMVar, tryPutMVar)
    import           Control.Exception                               (AsyncException,
                                                                      fromException,
                                                                      handle,
                                                                      throwIO)
    import           Control.Monad                                   (foldM, unless,
                                                                      when)
    import qualified Data.ByteString                                 as B
    import qualified Data.ByteString.Builder                         as Builder
    import qualified Data.ByteString.Char8                           as B8
    import           Data.IORef                                      (IORef,
                                                                      newIORef,
                                                                      readIORef,
                                                                      writeIORef)
    import           Data.List                                       (find)
    import           Data.Maybe                                      (catMaybes)
    import qualified Data.Text                                       as T
    import           Data.Word                                       (Word16)
    import           Prelude

    --------------------------------------------------------------------------------
    import           Network.WebSockets.Connection.Options
    import           Network.WebSockets.Extensions                   as Extensions
    import           Network.WebSockets.Extensions.PermessageDeflate
    import           Network.WebSockets.Extensions.StrictUnicode
    import           Network.WebSockets.Http
    import           Network.WebSockets.Protocol
    import           Network.WebSockets.Stream                       (Stream)
    import qualified Network.WebSockets.Stream                       as Stream
    import           Network.WebSockets.Types

    --------------------------------------------------------------------------------
    -- | A new client connected to the server. We haven't accepted the connection
    -- yet, though.
    data PendingConnection = PendingConnection
        { PendingConnection -> ConnectionOptions
    pendingOptions  :: !ConnectionOptions
        -- ^ Options, passed as-is to the 'Connection'
        , PendingConnection -> RequestHead
    pendingRequest  :: !RequestHead
        -- ^ Useful for e.g. inspecting the request path.
        , PendingConnection -> Connection -> IO ()
    pendingOnAccept :: !(Connection -> IO ())
        -- ^ One-shot callback fired when a connection is accepted, i.e., *after*
        -- the accepting response is sent to the client.
        , PendingConnection -> Stream
    pendingStream   :: !Stream
        -- ^ Input/output stream
        }

    --------------------------------------------------------------------------------
    -- | This datatype allows you to set options for 'acceptRequestWith'.  It is
    -- strongly recommended to use 'defaultAcceptRequest' and then modify the
    -- various fields, that way new fields introduced in the library do not break
    -- your code.
    data AcceptRequest = AcceptRequest
        { AcceptRequest -> Maybe ByteString
    acceptSubprotocol :: !(Maybe B.ByteString)
        -- ^ The subprotocol to speak with the client.  If 'pendingSubprotcols' is
        -- non-empty, 'acceptSubprotocol' must be one of the subprotocols from the
        -- list.
        , AcceptRequest -> Headers
    acceptHeaders     :: !Headers
        -- ^ Extra headers to send with the response.
        }

    --------------------------------------------------------------------------------
    defaultAcceptRequest :: AcceptRequest
    defaultAcceptRequest :: AcceptRequest
    defaultAcceptRequest = Maybe ByteString -> Headers -> AcceptRequest
    AcceptRequest Maybe ByteString
    forall a. Maybe a
    Nothing []

    --------------------------------------------------------------------------------
    -- | Utility
    sendResponse :: PendingConnection -> Response -> IO ()
    sendResponse :: PendingConnection -> Response -> IO ()
    sendResponse PendingConnection
    pc Response
    rsp = Stream -> ByteString -> IO ()
    Stream.write (PendingConnection -> Stream
    pendingStream PendingConnection
    pc)
        (Builder -> ByteString
    Builder.toLazyByteString (Response -> Builder
    encodeResponse Response
    rsp))

    --------------------------------------------------------------------------------
    -- | Accept a pending connection, turning it into a 'Connection'.
    acceptRequest :: PendingConnection -> IO Connection
    acceptRequest :: PendingConnection -> IO Connection
    acceptRequest PendingConnection
    pc = PendingConnection -> AcceptRequest -> IO Connection
    acceptRequestWith PendingConnection
    pc AcceptRequest
    defaultAcceptRequest

    --------------------------------------------------------------------------------
    -- | This function is like 'acceptRequest' but allows you to set custom options
    -- using the 'AcceptRequest' datatype.
    acceptRequestWith :: PendingConnection -> AcceptRequest -> IO Connection
    acceptRequestWith :: PendingConnection -> AcceptRequest -> IO Connection
    acceptRequestWith PendingConnection
    pc AcceptRequest
    ar = case (Protocol -> Bool) -> [Protocol] -> Maybe Protocol
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find ((Protocol -> RequestHead -> Bool)
    -> RequestHead -> Protocol -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Protocol -> RequestHead -> Bool
    compatible RequestHead
    request) [Protocol]
    protocols of
        Maybe Protocol
    Nothing       -> do
            PendingConnection -> Response -> IO ()
    sendResponse PendingConnection
    pc (Response -> IO ()) -> Response -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Headers -> ByteString -> Response
    response400 Headers
    versionHeader ByteString
    ""
            HandshakeException -> IO Connection
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO HandshakeException
    NotSupported
        Just Protocol
    protocol -> do

            -- Get requested list of exceptions from client.
            rqExts <- (HandshakeException -> IO ExtensionDescriptions)
    -> (ExtensionDescriptions -> IO ExtensionDescriptions)
    -> Either HandshakeException ExtensionDescriptions
    -> IO ExtensionDescriptions
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either HandshakeException -> IO ExtensionDescriptions
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO ExtensionDescriptions -> IO ExtensionDescriptions
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either HandshakeException ExtensionDescriptions
     -> IO ExtensionDescriptions)
    -> Either HandshakeException ExtensionDescriptions
    -> IO ExtensionDescriptions
    forall a b. (a -> b) -> a -> b
    $
                RequestHead -> Either HandshakeException ExtensionDescriptions
    getRequestSecWebSocketExtensions RequestHead
    request

            -- Set up permessage-deflate extension if configured.
            pmdExt <- case connectionCompressionOptions (pendingOptions pc) of
                CompressionOptions
    NoCompression                     -> Maybe Extension -> IO (Maybe Extension)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Extension
    forall a. Maybe a
    Nothing
                PermessageDeflateCompression PermessageDeflate
    pmd0 ->
                    case SizeLimit -> Maybe PermessageDeflate -> NegotiateExtension
    negotiateDeflate (ConnectionOptions -> SizeLimit
    connectionMessageDataSizeLimit ConnectionOptions
    options) (PermessageDeflate -> Maybe PermessageDeflate
    forall a. a -> Maybe a
    Just PermessageDeflate
    pmd0) ExtensionDescriptions
    rqExts of
                        Left String
    err   -> do
                            PendingConnection -> RejectRequest -> IO ()
    rejectRequestWith PendingConnection
    pc RejectRequest
    defaultRejectRequest {rejectMessage = B8.pack err}
                            HandshakeException -> IO (Maybe Extension)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO HandshakeException
    NotSupported
                        Right Extension
    pmd1 -> Maybe Extension -> IO (Maybe Extension)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Extension -> Maybe Extension
    forall a. a -> Maybe a
    Just Extension
    pmd1)

            -- Set up strict utf8 extension if configured.
            let unicodeExt =
                    if ConnectionOptions -> Bool
    connectionStrictUnicode (PendingConnection -> ConnectionOptions
    pendingOptions PendingConnection
    pc)
                        then Extension -> Maybe Extension
    forall a. a -> Maybe a
    Just Extension
    strictUnicode else Maybe Extension
    forall a. Maybe a
    Nothing

            -- Final extension list.
            let exts = [Maybe Extension] -> [Extension]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe Extension
    pmdExt, Maybe Extension
    unicodeExt]

            let subproto = Headers -> (ByteString -> Headers) -> Maybe ByteString -> Headers
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\ByteString
    p -> [(CI ByteString
    "Sec-WebSocket-Protocol", ByteString
    p)]) (Maybe ByteString -> Headers) -> Maybe ByteString -> Headers
    forall a b. (a -> b) -> a -> b
    $ AcceptRequest -> Maybe ByteString
    acceptSubprotocol AcceptRequest
    ar
                headers = Headers
    subproto Headers -> Headers -> Headers
    forall a. [a] -> [a] -> [a]
    ++ AcceptRequest -> Headers
    acceptHeaders AcceptRequest
    ar Headers -> Headers -> Headers
    forall a. [a] -> [a] -> [a]
    ++ (Extension -> Headers) -> [Extension] -> Headers
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Extension -> Headers
    extHeaders [Extension]
    exts
                response = Protocol
    -> RequestHead -> Headers -> Either HandshakeException Response
    finishRequest Protocol
    protocol RequestHead
    request Headers
    headers

            either throwIO (sendResponse pc) response

            parseRaw <- decodeMessages
                protocol
                (connectionFramePayloadSizeLimit options)
                (connectionMessageDataSizeLimit options)
                (pendingStream pc)
            writeRaw <- encodeMessages protocol ServerConnection (pendingStream pc)

            write <- foldM (\[Message] -> IO ()
    x Extension
    ext -> Extension -> ([Message] -> IO ()) -> IO ([Message] -> IO ())
    extWrite Extension
    ext [Message] -> IO ()
    x) writeRaw exts
            parse <- foldM (\IO (Maybe Message)
    x Extension
    ext -> Extension -> IO (Maybe Message) -> IO (IO (Maybe Message))
    extParse Extension
    ext IO (Maybe Message)
    x) parseRaw exts

            sentRef <- newIORef False
            heartbeat <- newEmptyMVar
            let connection = Connection
                    { connectionOptions :: ConnectionOptions
    connectionOptions   = ConnectionOptions
    options
                    , connectionType :: ConnectionType
    connectionType      = ConnectionType
    ServerConnection
                    , connectionProtocol :: Protocol
    connectionProtocol  = Protocol
    protocol
                    , connectionParse :: IO (Maybe Message)
    connectionParse     = IO (Maybe Message)
    parse
                    , connectionWrite :: [Message] -> IO ()
    connectionWrite     = [Message] -> IO ()
    write
                    , connectionHeartbeat :: MVar ()
    connectionHeartbeat = MVar ()
    heartbeat
                    , connectionSentClose :: IORef Bool
    connectionSentClose = IORef Bool
    sentRef
                    }

            pendingOnAccept pc connection
            return connection
      where
        options :: ConnectionOptions
    options       = PendingConnection -> ConnectionOptions
    pendingOptions PendingConnection
    pc
        request :: RequestHead
    request       = PendingConnection -> RequestHead
    pendingRequest PendingConnection
    pc
        versionHeader :: Headers
    versionHeader = [(CI ByteString
    "Sec-WebSocket-Version",
            ByteString -> [ByteString] -> ByteString
    B.intercalate ByteString
    ", " ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Protocol -> [ByteString]) -> [Protocol] -> [ByteString]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Protocol -> [ByteString]
    headerVersions [Protocol]
    protocols)]

    --------------------------------------------------------------------------------
    -- | Parameters that allow you to tweak how a request is rejected.  Please use
    -- 'defaultRejectRequest' and modify fields using record syntax so your code
    -- will not break when new fields are added.
    data RejectRequest = RejectRequest
        { -- | The status code, 400 by default.
          RejectRequest -> Int
    rejectCode    :: !Int
        , -- | The message, "Bad Request" by default
          RejectRequest -> ByteString
    rejectMessage :: !B.ByteString
        , -- | Extra headers to be sent with the response.
          RejectRequest -> Headers
    rejectHeaders :: Headers
        , -- | Reponse body of the rejection.
          RejectRequest -> ByteString
    rejectBody    :: !B.ByteString
        }

    --------------------------------------------------------------------------------
    defaultRejectRequest :: RejectRequest
    defaultRejectRequest :: RejectRequest
    defaultRejectRequest = RejectRequest
        { rejectCode :: Int
    rejectCode    = Int
    400
        , rejectMessage :: ByteString
    rejectMessage = ByteString
    "Bad Request"
        , rejectHeaders :: Headers
    rejectHeaders = []
        , rejectBody :: ByteString
    rejectBody    = ByteString
    ""
        }

    --------------------------------------------------------------------------------
    rejectRequestWith
        :: PendingConnection  -- ^ Connection to reject
        -> RejectRequest      -- ^ Params on how to reject the request
        -> IO ()
    rejectRequestWith :: PendingConnection -> RejectRequest -> IO ()
    rejectRequestWith PendingConnection
    pc RejectRequest
    reject = PendingConnection -> Response -> IO ()
    sendResponse PendingConnection
    pc (Response -> IO ()) -> Response -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ResponseHead -> ByteString -> Response
    Response
        ResponseHead
            { responseCode :: Int
    responseCode    = RejectRequest -> Int
    rejectCode RejectRequest
    reject
            , responseMessage :: ByteString
    responseMessage = RejectRequest -> ByteString
    rejectMessage RejectRequest
    reject
            , responseHeaders :: Headers
    responseHeaders = RejectRequest -> Headers
    rejectHeaders RejectRequest
    reject
            }
        (RejectRequest -> ByteString
    rejectBody RejectRequest
    reject)

    --------------------------------------------------------------------------------
    -- | Requires calling 'pendingStream' and 'Stream.close'.
    rejectRequest
        :: PendingConnection  -- ^ Connection to reject
        -> B.ByteString       -- ^ Rejection response body
        -> IO ()
    rejectRequest :: PendingConnection -> ByteString -> IO ()
    rejectRequest PendingConnection
    pc ByteString
    body = PendingConnection -> RejectRequest -> IO ()
    rejectRequestWith PendingConnection
    pc
        RejectRequest
    defaultRejectRequest {rejectBody = body}

    --------------------------------------------------------------------------------
    data Connection = Connection
        { Connection -> ConnectionOptions
    connectionOptions   :: !ConnectionOptions
        , Connection -> ConnectionType
    connectionType      :: !ConnectionType
        , Connection -> Protocol
    connectionProtocol  :: !Protocol
        , Connection -> MVar ()
    connectionHeartbeat :: !(MVar ())
        -- ^ This MVar is filled whenever a pong is received.  This is used by
        -- 'withPingPong' to timeout the connection if a pong is not received.
        , Connection -> IO (Maybe Message)
    connectionParse     :: !(IO (Maybe Message))
        , Connection -> [Message] -> IO ()
    connectionWrite     :: !([Message] -> IO ())
        , Connection -> IORef Bool
    connectionSentClose :: !(IORef Bool)
        -- ^ According to the RFC, both the client and the server MUST send
        -- a close control message to each other.  Either party can initiate
        -- the first close message but then the other party must respond.  Finally,
        -- the server is in charge of closing the TCP connection.  This IORef tracks
        -- if we have sent a close message and are waiting for the peer to respond.
        }

    --------------------------------------------------------------------------------
    receive :: Connection -> IO Message
    receive :: Connection -> IO Message
    receive Connection
    conn = do
        mbMsg <- Connection -> IO (Maybe Message)
    connectionParse Connection
    conn
        case mbMsg of
            Maybe Message
    Nothing  -> ConnectionException -> IO Message
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO ConnectionException
    ConnectionClosed
            Just Message
    msg -> Message -> IO Message
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Message
    msg

    --------------------------------------------------------------------------------
    -- | Receive an application message. Automatically respond to control messages.
    --
    -- When the peer sends a close control message, an exception of type 'CloseRequest'
    -- is thrown.  The peer can send a close control message either to initiate a
    -- close or in response to a close message we have sent to the peer.  In either
    -- case the 'CloseRequest' exception will be thrown.  The RFC specifies that
    -- the server is responsible for closing the TCP connection, which should happen
    -- after receiving the 'CloseRequest' exception from this function.
    --
    -- This will throw 'ConnectionClosed' if the TCP connection dies unexpectedly.
    receiveDataMessage :: Connection -> IO DataMessage
    receiveDataMessage :: Connection -> IO DataMessage
    receiveDataMessage Connection
    conn = do
        msg <- Connection -> IO Message
    receive Connection
    conn
        case msg of
            DataMessage Bool
    _ Bool
    _ Bool
    _ DataMessage
    am -> DataMessage -> IO DataMessage
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DataMessage
    am
            ControlMessage ControlMessage
    cm    -> case ControlMessage
    cm of
                Close Word16
    i ByteString
    closeMsg -> do
                    hasSentClose <- 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
    $ Connection -> IORef Bool
    connectionSentClose Connection
    conn
                    unless hasSentClose $ send conn msg
                    throwIO $ CloseRequest i closeMsg
                Pong ByteString
    _    -> do
                    _ <- MVar () -> () -> IO Bool
    forall a. MVar a -> a -> IO Bool
    tryPutMVar (Connection -> MVar ()
    connectionHeartbeat Connection
    conn) ()
                    connectionOnPong (connectionOptions conn)
                    receiveDataMessage conn
                Ping ByteString
    pl   -> do
                    Connection -> Message -> IO ()
    send Connection
    conn (ControlMessage -> Message
    ControlMessage (ByteString -> ControlMessage
    Pong ByteString
    pl))
                    Connection -> IO DataMessage
    receiveDataMessage Connection
    conn

    --------------------------------------------------------------------------------
    -- | Receive a message, converting it to whatever format is needed.
    receiveData :: WebSocketsData a => Connection -> IO a
    receiveData :: forall a. WebSocketsData a => Connection -> IO a
    receiveData Connection
    conn = DataMessage -> a
    forall a. WebSocketsData a => DataMessage -> a
    fromDataMessage (DataMessage -> a) -> IO DataMessage -> IO a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Connection -> IO DataMessage
    receiveDataMessage Connection
    conn

    --------------------------------------------------------------------------------
    send :: Connection -> Message -> IO ()
    send :: Connection -> Message -> IO ()
    send Connection
    conn = Connection -> [Message] -> IO ()
    sendAll Connection
    conn ([Message] -> IO ()) -> (Message -> [Message]) -> Message -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Message -> [Message]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    --------------------------------------------------------------------------------
    sendAll :: Connection -> [Message] -> IO ()
    sendAll :: Connection -> [Message] -> IO ()
    sendAll Connection
    _    []   = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    sendAll Connection
    conn [Message]
    msgs = do
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((Message -> Bool) -> [Message] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Message -> Bool
    isCloseMessage [Message]
    msgs) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          IORef Bool -> Bool -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (Connection -> IORef Bool
    connectionSentClose Connection
    conn) Bool
    True
        Connection -> [Message] -> IO ()
    connectionWrite Connection
    conn [Message]
    msgs
      where
        isCloseMessage :: Message -> Bool
    isCloseMessage (ControlMessage (Close Word16
    _ ByteString
    _)) = Bool
    True
        isCloseMessage Message
    _                            = Bool
    False

    --------------------------------------------------------------------------------
    -- | Send a 'DataMessage'.  This allows you send both human-readable text and
    -- binary data.  This is a slightly more low-level interface than 'sendTextData'
    -- or 'sendBinaryData'.
    sendDataMessage :: Connection -> DataMessage -> IO ()
    sendDataMessage :: Connection -> DataMessage -> IO ()
    sendDataMessage Connection
    conn = Connection -> [DataMessage] -> IO ()
    sendDataMessages Connection
    conn ([DataMessage] -> IO ())
    -> (DataMessage -> [DataMessage]) -> DataMessage -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataMessage -> [DataMessage]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    --------------------------------------------------------------------------------
    -- | Send a collection of 'DataMessage's.  This is more efficient than calling
    -- 'sendDataMessage' many times.
    sendDataMessages :: Connection -> [DataMessage] -> IO ()
    sendDataMessages :: Connection -> [DataMessage] -> IO ()
    sendDataMessages Connection
    conn = Connection -> [Message] -> IO ()
    sendAll Connection
    conn ([Message] -> IO ())
    -> ([DataMessage] -> [Message]) -> [DataMessage] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DataMessage -> Message) -> [DataMessage] -> [Message]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool -> Bool -> Bool -> DataMessage -> Message
    DataMessage Bool
    False Bool
    False Bool
    False)

    --------------------------------------------------------------------------------
    -- | Send a textual message.  The message will be encoded as UTF-8.  This should
    -- be the default choice for human-readable text-based protocols such as JSON.
    sendTextData :: WebSocketsData a => Connection -> a -> IO ()
    sendTextData :: forall a. WebSocketsData a => Connection -> a -> IO ()
    sendTextData Connection
    conn = Connection -> [a] -> IO ()
    forall a. WebSocketsData a => Connection -> [a] -> IO ()
    sendTextDatas Connection
    conn ([a] -> IO ()) -> (a -> [a]) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> [a]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    --------------------------------------------------------------------------------
    -- | Send a number of textual messages.  This is more efficient than calling
    -- 'sendTextData' many times.
    sendTextDatas :: WebSocketsData a => Connection -> [a] -> IO ()
    sendTextDatas :: forall a. WebSocketsData a => Connection -> [a] -> IO ()
    sendTextDatas Connection
    conn =
        Connection -> [DataMessage] -> IO ()
    sendDataMessages Connection
    conn ([DataMessage] -> IO ()) -> ([a] -> [DataMessage]) -> [a] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        (a -> DataMessage) -> [a] -> [DataMessage]
    forall a b. (a -> b) -> [a] -> [b]
    map (\a
    x -> ByteString -> Maybe Text -> DataMessage
    Text (a -> ByteString
    forall a. WebSocketsData a => a -> ByteString
    toLazyByteString a
    x) Maybe Text
    forall a. Maybe a
    Nothing)

    --------------------------------------------------------------------------------
    -- | Send a binary message.  This is useful for sending binary blobs, e.g.
    -- images, data encoded with MessagePack, images...
    sendBinaryData :: WebSocketsData a => Connection -> a -> IO ()
    sendBinaryData :: forall a. WebSocketsData a => Connection -> a -> IO ()
    sendBinaryData Connection
    conn = Connection -> [a] -> IO ()
    forall a. WebSocketsData a => Connection -> [a] -> IO ()
    sendBinaryDatas Connection
    conn ([a] -> IO ()) -> (a -> [a]) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> [a]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    --------------------------------------------------------------------------------
    -- | Send a number of binary messages.  This is more efficient than calling
    -- 'sendBinaryData' many times.
    sendBinaryDatas :: WebSocketsData a => Connection -> [a] -> IO ()
    sendBinaryDatas :: forall a. WebSocketsData a => Connection -> [a] -> IO ()
    sendBinaryDatas Connection
    conn = Connection -> [DataMessage] -> IO ()
    sendDataMessages Connection
    conn ([DataMessage] -> IO ()) -> ([a] -> [DataMessage]) -> [a] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> DataMessage) -> [a] -> [DataMessage]
    forall a b. (a -> b) -> [a] -> [b]
    map (ByteString -> DataMessage
    Binary (ByteString -> DataMessage)
    -> (a -> ByteString) -> a -> DataMessage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ByteString
    forall a. WebSocketsData a => a -> ByteString
    toLazyByteString)

    --------------------------------------------------------------------------------
    -- | Send a friendly close message.  Note that after sending this message,
    -- you should still continue calling 'receiveDataMessage' to process any
    -- in-flight messages.  The peer will eventually respond with a close control
    -- message of its own which will cause 'receiveDataMessage' to throw the
    -- 'CloseRequest' exception.  This exception is when you can finally consider
    -- the connection closed.
    sendClose :: WebSocketsData a => Connection -> a -> IO ()
    sendClose :: forall a. WebSocketsData a => Connection -> a -> IO ()
    sendClose Connection
    conn = Connection -> Word16 -> a -> IO ()
    forall a. WebSocketsData a => Connection -> Word16 -> a -> IO ()
    sendCloseCode Connection
    conn Word16
    1000

    --------------------------------------------------------------------------------
    -- | Send a friendly close message and close code.  Similar to 'sendClose',
    -- you should continue calling 'receiveDataMessage' until you receive a
    -- 'CloseRequest' exception.
    --
    -- See <http://tools.ietf.org/html/rfc6455#section-7.4> for a list of close
    -- codes.
    sendCloseCode :: WebSocketsData a => Connection -> Word16 -> a -> IO ()
    sendCloseCode :: forall a. WebSocketsData a => Connection -> Word16 -> a -> IO ()
    sendCloseCode Connection
    conn Word16
    code =
        Connection -> Message -> IO ()
    send Connection
    conn (Message -> IO ()) -> (a -> Message) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ControlMessage -> Message
    ControlMessage (ControlMessage -> Message)
    -> (a -> ControlMessage) -> a -> Message
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word16 -> ByteString -> ControlMessage
    Close Word16
    code (ByteString -> ControlMessage)
    -> (a -> ByteString) -> a -> ControlMessage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ByteString
    forall a. WebSocketsData a => a -> ByteString
    toLazyByteString

    --------------------------------------------------------------------------------
    -- | Send a ping
    sendPing :: WebSocketsData a => Connection -> a -> IO ()
    sendPing :: forall a. WebSocketsData a => Connection -> a -> IO ()
    sendPing Connection
    conn = Connection -> Message -> IO ()
    send Connection
    conn (Message -> IO ()) -> (a -> Message) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ControlMessage -> Message
    ControlMessage (ControlMessage -> Message)
    -> (a -> ControlMessage) -> a -> Message
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ControlMessage
    Ping (ByteString -> ControlMessage)
    -> (a -> ByteString) -> a -> ControlMessage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ByteString
    forall a. WebSocketsData a => a -> ByteString
    toLazyByteString

    --------------------------------------------------------------------------------
    -- | Send a pong
    sendPong :: WebSocketsData a => Connection -> a -> IO ()
    sendPong :: forall a. WebSocketsData a => Connection -> a -> IO ()
    sendPong Connection
    conn = Connection -> Message -> IO ()
    send Connection
    conn (Message -> IO ()) -> (a -> Message) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ControlMessage -> Message
    ControlMessage (ControlMessage -> Message)
    -> (a -> ControlMessage) -> a -> Message
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ControlMessage
    Pong (ByteString -> ControlMessage)
    -> (a -> ByteString) -> a -> ControlMessage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ByteString
    forall a. WebSocketsData a => a -> ByteString
    toLazyByteString

    --------------------------------------------------------------------------------
    -- | Forks a ping thread, sending a ping message every @n@ seconds over the
    -- connection.  The thread is killed when the inner IO action is finished.
    --
    -- This is useful to keep idle connections open through proxies and whatnot.
    -- Many (but not all) proxies have a 60 second default timeout, so based on that
    -- sending a ping every 30 seconds is a good idea.
    --
    -- Note that usually you want to use 'Network.WebSockets.Connection.PingPong.withPingPong'
    -- to timeout the connection if a pong is not received.
    withPingThread
        :: Connection
        -> Int    -- ^ Second interval in which pings should be sent.
        -> IO ()  -- ^ Repeat this after sending a ping.
        -> IO a   -- ^ Application to wrap with a ping thread.
        -> IO a   -- ^ Executes application and kills ping thread when done.
    withPingThread :: forall a. Connection -> Int -> IO () -> IO a -> IO a
    withPingThread Connection
    conn Int
    n IO ()
    action IO a
    app =
        IO () -> (Async () -> IO a) -> IO a
    forall a b. IO a -> (Async a -> IO b) -> IO b
    Async.withAsync (Connection -> Int -> IO () -> IO ()
    pingThread Connection
    conn Int
    n IO ()
    action) (\Async ()
    _ -> IO a
    app)

    --------------------------------------------------------------------------------
    -- | DEPRECATED: Use 'withPingThread' instead.
    --
    -- Forks a ping thread, sending a ping message every @n@ seconds over the
    -- connection.  The thread dies silently if the connection crashes or is closed.
    --
    -- This is useful to keep idle connections open through proxies and whatnot.
    -- Many (but not all) proxies have a 60 second default timeout, so based on that
    -- sending a ping every 30 seconds is a good idea.
    forkPingThread :: Connection -> Int -> IO ()
    forkPingThread :: Connection -> Int -> IO ()
    forkPingThread Connection
    conn Int
    n = do
        _ <- IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ Connection -> Int -> IO () -> IO ()
    pingThread Connection
    conn Int
    n (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
        return ()
    {-# DEPRECATED forkPingThread "Use 'withPingThread' instead" #-}

    --------------------------------------------------------------------------------
    -- | Use this if you want to run the ping thread yourself.
    --
    -- See also 'withPingThread'.
    pingThread :: Connection -> Int -> IO () -> IO ()
    pingThread :: Connection -> Int -> IO () -> IO ()
    pingThread Connection
    conn Int
    n IO ()
    action
        | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0    = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        | Bool
    otherwise = SomeException -> IO ()
    ignore (SomeException -> IO ()) -> IO () -> IO ()
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    `handle` Int -> IO ()
    go Int
    1
      where
        go :: Int -> IO ()
        go :: Int -> IO ()
    go Int
    i = do
            Int -> IO ()
    threadDelay (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    1000 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    1000)
            Connection -> Text -> IO ()
    forall a. WebSocketsData a => Connection -> a -> IO ()
    sendPing Connection
    conn (String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show Int
    i)
            IO ()
    action
            Int -> IO ()
    go (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

        ignore :: SomeException -> IO ()
    ignore SomeException
    e = case SomeException -> Maybe AsyncException
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e of
            Just AsyncException
    async -> AsyncException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (AsyncException
    async :: AsyncException)
            Maybe AsyncException
    Nothing    -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()