    --------------------------------------------------------------------------------
    -- | Primary types
    {-# LANGUAGE DeriveDataTypeable #-}
    module Network.WebSockets.Types
        ( Message (..)
        , ControlMessage (..)
        , DataMessage (..)
        , WebSocketsData (..)

        , HandshakeException (..)
        , ConnectionException (..)

        , ConnectionType (..)

        , decodeUtf8Lenient
        , decodeUtf8Strict
        ) where

    --------------------------------------------------------------------------------
    import           Control.Exception        (Exception (..))
    import           Control.Exception        (throw, try)
    import qualified Data.ByteString          as B
    import qualified Data.ByteString.Lazy     as BL
    import qualified Data.Text                as T
    import qualified Data.Text.Encoding.Error as TL
    import qualified Data.Text.Lazy           as TL
    import qualified Data.Text.Lazy.Encoding  as TL
    import           Data.Typeable            (Typeable)
    import           Data.Word                (Word16)
    import           System.IO.Unsafe         (unsafePerformIO)

    --------------------------------------------------------------------------------
    import           Network.WebSockets.Http

    --------------------------------------------------------------------------------
    -- | The kind of message a server application typically deals with
    data Message
        = ControlMessage ControlMessage
        -- | Reserved bits, actual message
        | DataMessage Bool Bool Bool DataMessage
        deriving (Message -> Message -> Bool
    (Message -> Message -> Bool)
    -> (Message -> Message -> Bool) -> Eq Message
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Message -> Message -> Bool
    == :: Message -> Message -> Bool
    $c/= :: Message -> Message -> Bool
    /= :: Message -> Message -> Bool
    Eq, Int -> Message -> ShowS
    [Message] -> ShowS
    Message -> String
    (Int -> Message -> ShowS)
    -> (Message -> String) -> ([Message] -> ShowS) -> Show Message
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Message -> ShowS
    showsPrec :: Int -> Message -> ShowS
    $cshow :: Message -> String
    show :: Message -> String
    $cshowList :: [Message] -> ShowS
    showList :: [Message] -> ShowS
    Show)

    --------------------------------------------------------------------------------
    -- | Different control messages
    data ControlMessage
        = Close Word16 BL.ByteString
        | Ping BL.ByteString
        | Pong BL.ByteString
        deriving (ControlMessage -> ControlMessage -> Bool
    (ControlMessage -> ControlMessage -> Bool)
    -> (ControlMessage -> ControlMessage -> Bool) -> Eq ControlMessage
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ControlMessage -> ControlMessage -> Bool
    == :: ControlMessage -> ControlMessage -> Bool
    $c/= :: ControlMessage -> ControlMessage -> Bool
    /= :: ControlMessage -> ControlMessage -> Bool
    Eq, Int -> ControlMessage -> ShowS
    [ControlMessage] -> ShowS
    ControlMessage -> String
    (Int -> ControlMessage -> ShowS)
    -> (ControlMessage -> String)
    -> ([ControlMessage] -> ShowS)
    -> Show ControlMessage
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ControlMessage -> ShowS
    showsPrec :: Int -> ControlMessage -> ShowS
    $cshow :: ControlMessage -> String
    show :: ControlMessage -> String
    $cshowList :: [ControlMessage] -> ShowS
    showList :: [ControlMessage] -> ShowS
    Show)

    --------------------------------------------------------------------------------
    -- | For an end-user of this library, dealing with 'Frame's would be a bit
    -- low-level. This is why define another type on top of it, which represents
    -- data for the application layer.
    --
    -- There are currently two kinds of data messages supported by the WebSockets
    -- protocol:
    --
    -- * Textual UTF-8 encoded data.  This corresponds roughly to sending a String
    -- in JavaScript.
    --
    -- * Binary data.  This corresponds roughly to send an ArrayBuffer in
    -- JavaScript.
    data DataMessage
        -- | A textual message.  The second field /might/ contain the decoded UTF-8
        -- text for caching reasons.  This field is computed lazily so if it's not
        -- accessed, it should have no performance impact.
        = Text BL.ByteString (Maybe TL.Text)
        -- | A binary message.
        | Binary BL.ByteString
        deriving (DataMessage -> DataMessage -> Bool
    (DataMessage -> DataMessage -> Bool)
    -> (DataMessage -> DataMessage -> Bool) -> Eq DataMessage
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DataMessage -> DataMessage -> Bool
    == :: DataMessage -> DataMessage -> Bool
    $c/= :: DataMessage -> DataMessage -> Bool
    /= :: DataMessage -> DataMessage -> Bool
    Eq, Int -> DataMessage -> ShowS
    [DataMessage] -> ShowS
    DataMessage -> String
    (Int -> DataMessage -> ShowS)
    -> (DataMessage -> String)
    -> ([DataMessage] -> ShowS)
    -> Show DataMessage
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> DataMessage -> ShowS
    showsPrec :: Int -> DataMessage -> ShowS
    $cshow :: DataMessage -> String
    show :: DataMessage -> String
    $cshowList :: [DataMessage] -> ShowS
    showList :: [DataMessage] -> ShowS
    Show)

    --------------------------------------------------------------------------------
    -- | In order to have an even more high-level API, we define a typeclass for
    -- values the user can receive from and send to the socket. A few warnings
    -- apply:
    --
    -- * Natively, everything is represented as a 'BL.ByteString', so this is the
    --   fastest instance
    --
    -- * You should only use the 'TL.Text' or the 'T.Text' instance when you are
    --   sure that the data is UTF-8 encoded (which is the case for 'Text'
    --   messages).
    --
    -- * Messages can be very large. If this is the case, it might be inefficient to
    --   use the strict 'B.ByteString' and 'T.Text' instances.
    class WebSocketsData a where
        fromDataMessage :: DataMessage -> a

        fromLazyByteString :: BL.ByteString -> a
        toLazyByteString   :: a -> BL.ByteString

    --------------------------------------------------------------------------------
    instance WebSocketsData BL.ByteString where
        fromDataMessage :: DataMessage -> ByteString
    fromDataMessage (Text   ByteString
    bl Maybe Text
    _) = ByteString
    bl
        fromDataMessage (Binary ByteString
    bl)   = ByteString
    bl

        fromLazyByteString :: ByteString -> ByteString
    fromLazyByteString = ByteString -> ByteString
    forall a. a -> a
    id
        toLazyByteString :: ByteString -> ByteString
    toLazyByteString   = ByteString -> ByteString
    forall a. a -> a
    id

    --------------------------------------------------------------------------------
    instance WebSocketsData B.ByteString where
        fromDataMessage :: DataMessage -> ByteString
    fromDataMessage (Text   ByteString
    bl Maybe Text
    _) = ByteString -> ByteString
    forall a. WebSocketsData a => ByteString -> a
    fromLazyByteString ByteString
    bl
        fromDataMessage (Binary ByteString
    bl)   = ByteString -> ByteString
    forall a. WebSocketsData a => ByteString -> a
    fromLazyByteString ByteString
    bl

        fromLazyByteString :: ByteString -> ByteString
    fromLazyByteString = [ByteString] -> ByteString
    B.concat ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    BL.toChunks
        toLazyByteString :: ByteString -> ByteString
    toLazyByteString   = [ByteString] -> ByteString
    BL.fromChunks ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    --------------------------------------------------------------------------------
    instance WebSocketsData TL.Text where
        fromDataMessage :: DataMessage -> Text
    fromDataMessage (Text   ByteString
    _  (Just Text
    tl)) = Text
    tl
        fromDataMessage (Text   ByteString
    bl Maybe Text
    Nothing)   = ByteString -> Text
    forall a. WebSocketsData a => ByteString -> a
    fromLazyByteString ByteString
    bl
        fromDataMessage (Binary ByteString
    bl)           = ByteString -> Text
    forall a. WebSocketsData a => ByteString -> a
    fromLazyByteString ByteString
    bl

        fromLazyByteString :: ByteString -> Text
    fromLazyByteString = ByteString -> Text
    TL.decodeUtf8
        toLazyByteString :: Text -> ByteString
    toLazyByteString   = Text -> ByteString
    TL.encodeUtf8

    --------------------------------------------------------------------------------
    instance WebSocketsData T.Text where
        fromDataMessage :: DataMessage -> Text
    fromDataMessage (Text   ByteString
    _ (Just Text
    tl)) = [Text] -> Text
    T.concat (Text -> [Text]
    TL.toChunks Text
    tl)
        fromDataMessage (Text   ByteString
    bl Maybe Text
    Nothing)  = ByteString -> Text
    forall a. WebSocketsData a => ByteString -> a
    fromLazyByteString ByteString
    bl
        fromDataMessage (Binary ByteString
    bl)          = ByteString -> Text
    forall a. WebSocketsData a => ByteString -> a
    fromLazyByteString ByteString
    bl

        fromLazyByteString :: ByteString -> Text
    fromLazyByteString = [Text] -> Text
    T.concat ([Text] -> Text) -> (ByteString -> [Text]) -> ByteString -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text]
    TL.toChunks (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Text
    forall a. WebSocketsData a => ByteString -> a
    fromLazyByteString
        toLazyByteString :: Text -> ByteString
    toLazyByteString   = Text -> ByteString
    forall a. WebSocketsData a => a -> ByteString
    toLazyByteString (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> Text
    TL.fromChunks ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    --------------------------------------------------------------------------------
    -- | Various exceptions that can occur while receiving or transmitting messages
    data ConnectionException
        -- | The peer has requested that the connection be closed, and included
        -- a close code and a reason for closing.  When receiving this exception,
        -- no more messages can be sent.  Also, the server is responsible for
        -- closing the TCP connection once this exception is received.
        --
        -- See <http://tools.ietf.org/html/rfc6455#section-7.4> for a list of close
        -- codes.
        = CloseRequest Word16 BL.ByteString

        -- | The peer unexpectedly closed the connection while we were trying to
        -- receive some data.  This is a violation of the websocket RFC since the
        -- TCP connection should only be closed after sending and receiving close
        -- control messages.
        | ConnectionClosed

        -- | The client sent garbage, i.e. we could not parse the WebSockets stream.
        | ParseException String

        -- | The client sent invalid UTF-8.  Note that this exception will only be
        -- thrown if strict decoding is set in the connection options.
        | UnicodeException String
        deriving (ConnectionException -> ConnectionException -> Bool
    (ConnectionException -> ConnectionException -> Bool)
    -> (ConnectionException -> ConnectionException -> Bool)
    -> Eq ConnectionException
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ConnectionException -> ConnectionException -> Bool
    == :: ConnectionException -> ConnectionException -> Bool
    $c/= :: ConnectionException -> ConnectionException -> Bool
    /= :: ConnectionException -> ConnectionException -> Bool
    Eq, Int -> ConnectionException -> ShowS
    [ConnectionException] -> ShowS
    ConnectionException -> String
    (Int -> ConnectionException -> ShowS)
    -> (ConnectionException -> String)
    -> ([ConnectionException] -> ShowS)
    -> Show ConnectionException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ConnectionException -> ShowS
    showsPrec :: Int -> ConnectionException -> ShowS
    $cshow :: ConnectionException -> String
    show :: ConnectionException -> String
    $cshowList :: [ConnectionException] -> ShowS
    showList :: [ConnectionException] -> ShowS
    Show, Typeable)

    --------------------------------------------------------------------------------
    instance Exception ConnectionException

    --------------------------------------------------------------------------------
    data ConnectionType = ServerConnection | ClientConnection
        deriving (ConnectionType -> ConnectionType -> Bool
    (ConnectionType -> ConnectionType -> Bool)
    -> (ConnectionType -> ConnectionType -> Bool) -> Eq ConnectionType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ConnectionType -> ConnectionType -> Bool
    == :: ConnectionType -> ConnectionType -> Bool
    $c/= :: ConnectionType -> ConnectionType -> Bool
    /= :: ConnectionType -> ConnectionType -> Bool
    Eq, Eq ConnectionType
    Eq ConnectionType =>
    (ConnectionType -> ConnectionType -> Ordering)
    -> (ConnectionType -> ConnectionType -> Bool)
    -> (ConnectionType -> ConnectionType -> Bool)
    -> (ConnectionType -> ConnectionType -> Bool)
    -> (ConnectionType -> ConnectionType -> Bool)
    -> (ConnectionType -> ConnectionType -> ConnectionType)
    -> (ConnectionType -> ConnectionType -> ConnectionType)
    -> Ord ConnectionType
    ConnectionType -> ConnectionType -> Bool
    ConnectionType -> ConnectionType -> Ordering
    ConnectionType -> ConnectionType -> ConnectionType
    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
    $ccompare :: ConnectionType -> ConnectionType -> Ordering
    compare :: ConnectionType -> ConnectionType -> Ordering
    $c< :: ConnectionType -> ConnectionType -> Bool
    < :: ConnectionType -> ConnectionType -> Bool
    $c<= :: ConnectionType -> ConnectionType -> Bool
    <= :: ConnectionType -> ConnectionType -> Bool
    $c> :: ConnectionType -> ConnectionType -> Bool
    > :: ConnectionType -> ConnectionType -> Bool
    $c>= :: ConnectionType -> ConnectionType -> Bool
    >= :: ConnectionType -> ConnectionType -> Bool
    $cmax :: ConnectionType -> ConnectionType -> ConnectionType
    max :: ConnectionType -> ConnectionType -> ConnectionType
    $cmin :: ConnectionType -> ConnectionType -> ConnectionType
    min :: ConnectionType -> ConnectionType -> ConnectionType
    Ord, 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
    $cshowsPrec :: Int -> ConnectionType -> ShowS
    showsPrec :: Int -> ConnectionType -> ShowS
    $cshow :: ConnectionType -> String
    show :: ConnectionType -> String
    $cshowList :: [ConnectionType] -> ShowS
    showList :: [ConnectionType] -> ShowS
    Show)

    --------------------------------------------------------------------------------
    -- | Replace an invalid input byte with the Unicode replacement character
    -- U+FFFD.
    decodeUtf8Lenient :: BL.ByteString -> TL.Text
    decodeUtf8Lenient :: ByteString -> Text
    decodeUtf8Lenient = OnDecodeError -> ByteString -> Text
    TL.decodeUtf8With OnDecodeError
    TL.lenientDecode

    --------------------------------------------------------------------------------
    -- | Throw an error if there is an invalid input byte.
    decodeUtf8Strict :: BL.ByteString -> Either ConnectionException TL.Text
    decodeUtf8Strict :: ByteString -> Either ConnectionException Text
    decodeUtf8Strict ByteString
    bl = IO (Either ConnectionException Text)
    -> Either ConnectionException Text
    forall a. IO a -> a
    unsafePerformIO (IO (Either ConnectionException Text)
     -> Either ConnectionException Text)
    -> IO (Either ConnectionException Text)
    -> Either ConnectionException Text
    forall a b. (a -> b) -> a -> b
    $ IO Text -> IO (Either ConnectionException Text)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO Text -> IO (Either ConnectionException Text))
    -> IO Text -> IO (Either ConnectionException Text)
    forall a b. (a -> b) -> a -> b
    $
        let txt :: Text
    txt = OnDecodeError -> ByteString -> Text
    TL.decodeUtf8With (\String
    err Maybe Word8
    _ -> ConnectionException -> Maybe Char
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (String -> ConnectionException
    UnicodeException String
    err)) ByteString
    bl in
        Text -> Int64
    TL.length Text
    txt Int64 -> IO Text -> IO Text
    forall a b. a -> b -> b
    `seq` Text -> IO Text
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    txt