{-# 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
data Message
= ControlMessage ControlMessage
| DataMessage Bool Bool Bool DataMessage
deriving (Message -> Message -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show)
data ControlMessage
= Close Word16 BL.ByteString
| Ping BL.ByteString
| Pong BL.ByteString
deriving (ControlMessage -> ControlMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControlMessage -> ControlMessage -> Bool
$c/= :: ControlMessage -> ControlMessage -> Bool
== :: ControlMessage -> ControlMessage -> Bool
$c== :: ControlMessage -> ControlMessage -> Bool
Eq, Int -> ControlMessage -> ShowS
[ControlMessage] -> ShowS
ControlMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControlMessage] -> ShowS
$cshowList :: [ControlMessage] -> ShowS
show :: ControlMessage -> String
$cshow :: ControlMessage -> String
showsPrec :: Int -> ControlMessage -> ShowS
$cshowsPrec :: Int -> ControlMessage -> ShowS
Show)
data DataMessage
= Text BL.ByteString (Maybe TL.Text)
| Binary BL.ByteString
deriving (DataMessage -> DataMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataMessage -> DataMessage -> Bool
$c/= :: DataMessage -> DataMessage -> Bool
== :: DataMessage -> DataMessage -> Bool
$c== :: DataMessage -> DataMessage -> Bool
Eq, Int -> DataMessage -> ShowS
[DataMessage] -> ShowS
DataMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataMessage] -> ShowS
$cshowList :: [DataMessage] -> ShowS
show :: DataMessage -> String
$cshow :: DataMessage -> String
showsPrec :: Int -> DataMessage -> ShowS
$cshowsPrec :: Int -> DataMessage -> ShowS
Show)
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 = forall a. a -> a
id
toLazyByteString :: ByteString -> ByteString
toLazyByteString = forall a. a -> a
id
instance WebSocketsData B.ByteString where
fromDataMessage :: DataMessage -> ByteString
fromDataMessage (Text ByteString
bl Maybe Text
_) = forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bl
fromDataMessage (Binary ByteString
bl) = forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bl
fromLazyByteString :: ByteString -> ByteString
fromLazyByteString = [ByteString] -> ByteString
B.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks
toLazyByteString :: ByteString -> ByteString
toLazyByteString = [ByteString] -> ByteString
BL.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bl
fromDataMessage (Binary ByteString
bl) = 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) = forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bl
fromDataMessage (Binary ByteString
bl) = forall a. WebSocketsData a => ByteString -> a
fromLazyByteString ByteString
bl
fromLazyByteString :: ByteString -> Text
fromLazyByteString = [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
TL.toChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. WebSocketsData a => ByteString -> a
fromLazyByteString
toLazyByteString :: Text -> ByteString
toLazyByteString = forall a. WebSocketsData a => a -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
TL.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
data ConnectionException
= CloseRequest Word16 BL.ByteString
| ConnectionClosed
| ParseException String
| UnicodeException String
deriving (ConnectionException -> ConnectionException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionException -> ConnectionException -> Bool
$c/= :: ConnectionException -> ConnectionException -> Bool
== :: ConnectionException -> ConnectionException -> Bool
$c== :: ConnectionException -> ConnectionException -> Bool
Eq, Int -> ConnectionException -> ShowS
[ConnectionException] -> ShowS
ConnectionException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionException] -> ShowS
$cshowList :: [ConnectionException] -> ShowS
show :: ConnectionException -> String
$cshow :: ConnectionException -> String
showsPrec :: Int -> ConnectionException -> ShowS
$cshowsPrec :: Int -> ConnectionException -> ShowS
Show, Typeable)
instance Exception ConnectionException
data ConnectionType = ServerConnection | ClientConnection
deriving (ConnectionType -> ConnectionType -> Bool
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, Eq 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
min :: ConnectionType -> ConnectionType -> ConnectionType
$cmin :: ConnectionType -> ConnectionType -> ConnectionType
max :: ConnectionType -> ConnectionType -> ConnectionType
$cmax :: ConnectionType -> ConnectionType -> ConnectionType
>= :: ConnectionType -> ConnectionType -> Bool
$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
compare :: ConnectionType -> ConnectionType -> Ordering
$ccompare :: ConnectionType -> ConnectionType -> Ordering
Ord, Int -> ConnectionType -> ShowS
[ConnectionType] -> ShowS
ConnectionType -> String
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)
decodeUtf8Lenient :: BL.ByteString -> TL.Text
decodeUtf8Lenient :: ByteString -> Text
decodeUtf8Lenient = OnDecodeError -> ByteString -> Text
TL.decodeUtf8With OnDecodeError
TL.lenientDecode
decodeUtf8Strict :: BL.ByteString -> Either ConnectionException TL.Text
decodeUtf8Strict :: ByteString -> Either ConnectionException Text
decodeUtf8Strict ByteString
bl = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$
let txt :: Text
txt = OnDecodeError -> ByteString -> Text
TL.decodeUtf8With (\String
err Maybe Word8
_ -> forall a e. Exception e => e -> a
throw (String -> ConnectionException
UnicodeException String
err)) ByteString
bl in
Text -> Int64
TL.length Text
txt seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return Text
txt