{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wall #-}
module Network.Http.Client.WebSocket
(
WSFrameHdr(..)
, wsFrameHdrSize
, wsFrameHdrToBuilder
, WSOpcode(..)
, WSOpcodeReserved(..)
, wsIsDataFrame
, writeWSFrame
, sendWSFragData
, readWSFrame
, receiveWSFrame
, wsUpgradeConnection
, SecWebSocketKey
, wsKeyToAcceptB64
, secWebSocketKeyFromB64
, secWebSocketKeyToB64
, secWebSocketKeyFromWords
, WsException(..)
) where
import Blaze.ByteString.Builder (Builder)
import qualified Blaze.ByteString.Builder as Builder
import Control.Exception
import Control.Monad (unless, when)
import qualified Crypto.Hash.SHA1 as SHA1
import qualified Data.Binary as Bin
import qualified Data.Binary.Get as Bin
import qualified Data.Binary.Put as Bin
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as BL
import qualified Data.CaseInsensitive as CI
import Data.IORef
import Data.Maybe (isJust)
import Data.Monoid (Monoid (..))
import Data.Typeable (Typeable)
import Data.Word
import Data.XOR (xor32LazyByteString, xor32StrictByteString')
import Network.Http.Client as HC
import qualified Network.Http.Connection as HC
import System.IO.Streams (InputStream, OutputStream)
import qualified System.IO.Streams as Streams
data WsException = WsException String
deriving (Typeable,Int -> WsException -> ShowS
[WsException] -> ShowS
WsException -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [WsException] -> ShowS
$cshowList :: [WsException] -> ShowS
show :: WsException -> [Char]
$cshow :: WsException -> [Char]
showsPrec :: Int -> WsException -> ShowS
$cshowsPrec :: Int -> WsException -> ShowS
Show)
instance Exception WsException
data WSFrameHdr = WSFrameHdr
{ WSFrameHdr -> Bool
ws'FIN :: !Bool
, WSFrameHdr -> Bool
ws'RSV1 :: !Bool
, WSFrameHdr -> Bool
ws'RSV2 :: !Bool
, WSFrameHdr -> Bool
ws'RSV3 :: !Bool
, WSFrameHdr -> WSOpcode
ws'opcode :: !WSOpcode
, WSFrameHdr -> Word64
ws'length :: !Word64
, WSFrameHdr -> Maybe Word32
ws'mask :: !(Maybe Word32)
} deriving Int -> WSFrameHdr -> ShowS
[WSFrameHdr] -> ShowS
WSFrameHdr -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [WSFrameHdr] -> ShowS
$cshowList :: [WSFrameHdr] -> ShowS
show :: WSFrameHdr -> [Char]
$cshow :: WSFrameHdr -> [Char]
showsPrec :: Int -> WSFrameHdr -> ShowS
$cshowsPrec :: Int -> WSFrameHdr -> ShowS
Show
wsFrameHdrSize :: WSFrameHdr -> Int
wsFrameHdrSize :: WSFrameHdr -> Int
wsFrameHdrSize WSFrameHdr{ws'mask :: WSFrameHdr -> Maybe Word32
ws'mask = Maybe Word32
Nothing, Word64
ws'length :: Word64
ws'length :: WSFrameHdr -> Word64
ws'length}
| Word64
ws'length forall a. Ord a => a -> a -> Bool
< Word64
126 = Int
2
| Word64
ws'length forall a. Ord a => a -> a -> Bool
<= Word64
0xffff = Int
4
| Bool
otherwise = Int
10
wsFrameHdrSize WSFrameHdr{ws'mask :: WSFrameHdr -> Maybe Word32
ws'mask = Just Word32
_, Word64
ws'length :: Word64
ws'length :: WSFrameHdr -> Word64
ws'length}
| Word64
ws'length forall a. Ord a => a -> a -> Bool
< Word64
126 = Int
6
| Word64
ws'length forall a. Ord a => a -> a -> Bool
<= Word64
0xffff = Int
8
| Bool
otherwise = Int
14
readWSFrameHdr :: Connection -> IO (Maybe WSFrameHdr)
readWSFrameHdr :: Connection -> IO (Maybe WSFrameHdr)
readWSFrameHdr (HC.Connection { cIn :: Connection -> InputStream ByteString
cIn = InputStream ByteString
is }) = do
Maybe ByteString
mchunk <- forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream ByteString
is
case Maybe ByteString
mchunk of
Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just ByteString
chunk -> Decoder WSFrameHdr -> IO (Maybe WSFrameHdr)
go forall a b. (a -> b) -> a -> b
$ (if ByteString -> Bool
BS.null ByteString
chunk then forall a. a -> a
id else forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Decoder a -> ByteString -> Decoder a
Bin.pushChunk ByteString
chunk)
forall a b. (a -> b) -> a -> b
$ forall a. Get a -> Decoder a
Bin.runGetIncremental forall t. Binary t => Get t
Bin.get
where
go :: Bin.Decoder WSFrameHdr -> IO (Maybe WSFrameHdr)
go :: Decoder WSFrameHdr -> IO (Maybe WSFrameHdr)
go (Bin.Fail ByteString
rest ByteOffset
_ [Char]
err) = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
rest) forall a b. (a -> b) -> a -> b
$
forall a. a -> InputStream a -> IO ()
Streams.unRead ByteString
rest InputStream ByteString
is
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> WsException
WsException ([Char]
"readWSFrameHdr: " forall a. [a] -> [a] -> [a]
++ [Char]
err)
go partial :: Decoder WSFrameHdr
partial@(Bin.Partial Maybe ByteString -> Decoder WSFrameHdr
cont) = do
Maybe ByteString
mchunk <- forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream ByteString
is
case Maybe ByteString
mchunk of
Maybe ByteString
Nothing -> Decoder WSFrameHdr -> IO (Maybe WSFrameHdr)
go (Maybe ByteString -> Decoder WSFrameHdr
cont forall a. Maybe a
Nothing)
Just ByteString
chunk
| ByteString -> Bool
BS.null ByteString
chunk -> Decoder WSFrameHdr -> IO (Maybe WSFrameHdr)
go Decoder WSFrameHdr
partial
| Bool
otherwise -> Decoder WSFrameHdr -> IO (Maybe WSFrameHdr)
go (Maybe ByteString -> Decoder WSFrameHdr
cont (forall a. a -> Maybe a
Just ByteString
chunk))
go (Bin.Done ByteString
rest ByteOffset
_ WSFrameHdr
x) = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
rest) forall a b. (a -> b) -> a -> b
$
forall a. a -> InputStream a -> IO ()
Streams.unRead ByteString
rest InputStream ByteString
is
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just WSFrameHdr
x)
receiveWSFrame :: Connection -> (WSFrameHdr -> InputStream ByteString -> IO a) -> IO (Maybe a)
receiveWSFrame :: forall a.
Connection
-> (WSFrameHdr -> InputStream ByteString -> IO a) -> IO (Maybe a)
receiveWSFrame (conn :: Connection
conn@HC.Connection { cIn :: Connection -> InputStream ByteString
cIn = InputStream ByteString
is }) WSFrameHdr -> InputStream ByteString -> IO a
cont = do
Maybe WSFrameHdr
mhdr <- Connection -> IO (Maybe WSFrameHdr)
readWSFrameHdr Connection
conn
case Maybe WSFrameHdr
mhdr of
Maybe WSFrameHdr
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just WSFrameHdr
hdr
| WSFrameHdr -> Word64
ws'length WSFrameHdr
hdr forall a. Eq a => a -> a -> Bool
== Word64
0 -> do
InputStream ByteString
is' <- forall a. IO (InputStream a)
Streams.nullInput
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` WSFrameHdr -> InputStream ByteString -> IO a
cont WSFrameHdr
hdr InputStream ByteString
is'
| Bool
otherwise -> do
InputStream ByteString
is' <- ByteOffset -> InputStream ByteString -> IO (InputStream ByteString)
Streams.takeExactly (forall a b. (Integral a, Num b) => a -> b
fromIntegral (WSFrameHdr -> Word64
ws'length WSFrameHdr
hdr)) InputStream ByteString
is
InputStream ByteString
is'' <- Word32 -> InputStream ByteString -> IO (InputStream ByteString)
xor32InputStream (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 forall a. a -> a
id (WSFrameHdr -> Maybe Word32
ws'mask WSFrameHdr
hdr)) InputStream ByteString
is'
a
res <- WSFrameHdr -> InputStream ByteString -> IO a
cont WSFrameHdr
hdr InputStream ByteString
is''
forall a. InputStream a -> IO ()
Streams.skipToEof InputStream ByteString
is'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! a
res
sendWSFragData :: Connection -> WSFrameHdr -> (OutputStream ByteString -> IO a) -> IO a
sendWSFragData :: forall a.
Connection
-> WSFrameHdr -> (OutputStream ByteString -> IO a) -> IO a
sendWSFragData Connection
_ WSFrameHdr
hdr0 OutputStream ByteString -> IO a
_
| Bool -> Bool
not (WSOpcode -> Bool
wsIsDataFrame (WSFrameHdr -> WSOpcode
ws'opcode WSFrameHdr
hdr0))
= forall e a. Exception e => e -> IO a
throwIO ([Char] -> WsException
WsException [Char]
"sendWSFragData: sending control-frame requested")
| WSFrameHdr -> WSOpcode
ws'opcode WSFrameHdr
hdr0 forall a. Eq a => a -> a -> Bool
== WSOpcode
WSOpcode'Continuation
= forall e a. Exception e => e -> IO a
throwIO ([Char] -> WsException
WsException [Char]
"sendWSFragData: sending continuation frame requested")
sendWSFragData (HC.Connection { cOut :: Connection -> OutputStream Builder
cOut = OutputStream Builder
os }) WSFrameHdr
hdr0 OutputStream ByteString -> IO a
cont = do
IORef WSOpcode
opcodeRef <- forall a. a -> IO (IORef a)
newIORef (WSFrameHdr -> WSOpcode
ws'opcode WSFrameHdr
hdr0)
let go :: Maybe ByteString -> IO ()
go Maybe ByteString
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ()
go (Just ByteString
chunk)
| ByteString -> Bool
BS.null ByteString
chunk = forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just Builder
Builder.flush) OutputStream Builder
os
| Bool
otherwise = do
let (Word32
_,ByteString
chunk') = Word32 -> ByteString -> (Word32, ByteString)
xor32StrictByteString' (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ WSFrameHdr -> Maybe Word32
ws'mask WSFrameHdr
hdr0) ByteString
chunk
WSOpcode
opcode <- forall a. IORef a -> IO a
readIORef IORef WSOpcode
opcodeRef
forall a. IORef a -> a -> IO ()
writeIORef IORef WSOpcode
opcodeRef WSOpcode
WSOpcode'Continuation
let fraghdr :: WSFrameHdr
fraghdr = WSFrameHdr
hdr0 { ws'FIN :: Bool
ws'FIN = Bool
False
, ws'length :: Word64
ws'length = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
chunk)
, ws'opcode :: WSOpcode
ws'opcode = WSOpcode
opcode
}
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! WSFrameHdr -> Builder
wsFrameHdrToBuilder WSFrameHdr
fraghdr forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
Builder.fromByteString ByteString
chunk') OutputStream Builder
os
OutputStream ByteString
os' <- forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
Streams.makeOutputStream Maybe ByteString -> IO ()
go
!a
res <- OutputStream ByteString -> IO a
cont OutputStream ByteString
os'
WSOpcode
opcode <- forall a. IORef a -> IO a
readIORef IORef WSOpcode
opcodeRef
let final :: WSFrameHdr
final = (WSFrameHdr
hdr0 { ws'FIN :: Bool
ws'FIN = Bool
True
, ws'length :: Word64
ws'length = Word64
0
, ws'opcode :: WSOpcode
ws'opcode = WSOpcode
opcode
, ws'mask :: Maybe Word32
ws'mask = forall a. a -> Maybe a
Just Word32
0
})
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WSFrameHdr -> Builder
wsFrameHdrToBuilder WSFrameHdr
final forall a. Monoid a => a -> a -> a
`mappend` Builder
Builder.flush) OutputStream Builder
os
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a
res
writeWSFrame :: Connection -> WSOpcode -> Maybe Word32 -> BL.ByteString -> IO ()
writeWSFrame :: Connection -> WSOpcode -> Maybe Word32 -> ByteString -> IO ()
writeWSFrame (HC.Connection { cOut :: Connection -> OutputStream Builder
cOut = OutputStream Builder
os }) WSOpcode
opcode Maybe Word32
mmask ByteString
payload = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (WSOpcode -> Bool
wsIsDataFrame WSOpcode
opcode) Bool -> Bool -> Bool
&& Word64
plen forall a. Ord a => a -> a -> Bool
>= Word64
126) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO ([Char] -> WsException
WsException [Char]
"writeWSFrame: over-sized control-frame")
let hdr :: Builder
hdr = WSFrameHdr -> Builder
wsFrameHdrToBuilder (Bool
-> Bool
-> Bool
-> Bool
-> WSOpcode
-> Word64
-> Maybe Word32
-> WSFrameHdr
WSFrameHdr Bool
True Bool
False Bool
False Bool
False WSOpcode
opcode Word64
plen Maybe Word32
mmask)
dat :: Builder
dat = case Maybe Word32
mmask of
Maybe Word32
Nothing -> ByteString -> Builder
Builder.fromLazyByteString ByteString
payload
Just Word32
0 -> ByteString -> Builder
Builder.fromLazyByteString ByteString
payload
Just Word32
msk -> ByteString -> Builder
Builder.fromLazyByteString (Word32 -> ByteString -> ByteString
xor32LazyByteString Word32
msk ByteString
payload)
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Builder
hdr forall a. Monoid a => a -> a -> a
`mappend` Builder
dat forall a. Monoid a => a -> a -> a
`mappend` Builder
Builder.flush) OutputStream Builder
os
where
plen :: Word64
plen = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> ByteOffset
BL.length ByteString
payload)
readWSFrame :: Int -> Connection -> IO (Maybe (WSFrameHdr,ByteString))
readWSFrame :: Int -> Connection -> IO (Maybe (WSFrameHdr, ByteString))
readWSFrame Int
maxSize (conn :: Connection
conn@HC.Connection { cIn :: Connection -> InputStream ByteString
cIn = InputStream ByteString
is }) = do
Maybe WSFrameHdr
mhdr <- Connection -> IO (Maybe WSFrameHdr)
readWSFrameHdr Connection
conn
case Maybe WSFrameHdr
mhdr of
Maybe WSFrameHdr
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just WSFrameHdr
hdr
| WSFrameHdr -> Word64
ws'length WSFrameHdr
hdr forall a. Eq a => a -> a -> Bool
== Word64
0 ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (WSFrameHdr
hdr,ByteString
BS.empty)
| WSFrameHdr -> Word64
ws'length WSFrameHdr
hdr forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxSize ->
forall e a. Exception e => e -> IO a
throwIO ([Char] -> WsException
WsException [Char]
"readWSFrame: frame larger than maxSize")
| Bool
otherwise -> do
ByteString
dat <- Int -> InputStream ByteString -> IO ByteString
Streams.readExactly (forall a b. (Integral a, Num b) => a -> b
fromIntegral (WSFrameHdr -> Word64
ws'length WSFrameHdr
hdr)) InputStream ByteString
is
let dat' :: ByteString
dat' = case WSFrameHdr -> Maybe Word32
ws'mask WSFrameHdr
hdr of
Maybe Word32
Nothing -> ByteString
dat
Just Word32
0 -> ByteString
dat
Just Word32
m -> forall a b. (a, b) -> b
snd (Word32 -> ByteString -> (Word32, ByteString)
xor32StrictByteString' Word32
m ByteString
dat)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (WSFrameHdr
hdr,ByteString
dat')
wsFrameHdrToBuilder :: WSFrameHdr -> Builder
wsFrameHdrToBuilder :: WSFrameHdr -> Builder
wsFrameHdrToBuilder WSFrameHdr{Bool
Maybe Word32
Word64
WSOpcode
ws'mask :: Maybe Word32
ws'length :: Word64
ws'opcode :: WSOpcode
ws'RSV3 :: Bool
ws'RSV2 :: Bool
ws'RSV1 :: Bool
ws'FIN :: Bool
ws'mask :: WSFrameHdr -> Maybe Word32
ws'length :: WSFrameHdr -> Word64
ws'opcode :: WSFrameHdr -> WSOpcode
ws'RSV3 :: WSFrameHdr -> Bool
ws'RSV2 :: WSFrameHdr -> Bool
ws'RSV1 :: WSFrameHdr -> Bool
ws'FIN :: WSFrameHdr -> Bool
..} = forall a. Monoid a => [a] -> a
mconcat
[ Word8 -> Builder
Builder.fromWord8 forall a b. (a -> b) -> a -> b
$!
(if Bool
ws'FIN then Word8
0x80 else Word8
0) forall a. Bits a => a -> a -> a
.|.
(if Bool
ws'RSV1 then Word8
0x40 else Word8
0) forall a. Bits a => a -> a -> a
.|.
(if Bool
ws'RSV2 then Word8
0x20 else Word8
0) forall a. Bits a => a -> a -> a
.|.
(if Bool
ws'RSV3 then Word8
0x10 else Word8
0) forall a. Bits a => a -> a -> a
.|.
(WSOpcode -> Word8
encodeWSOpcode WSOpcode
ws'opcode)
, Word8 -> Builder
Builder.fromWord8 forall a b. (a -> b) -> a -> b
$!
(if forall a. Maybe a -> Bool
isJust Maybe Word32
ws'mask then Word8
0x80 else Word8
0) forall a. Bits a => a -> a -> a
.|. Word8
len7
, case Word8
len7 of
Word8
126 -> Word16 -> Builder
Builder.fromWord16be (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ws'length)
Word8
127 -> Word64 -> Builder
Builder.fromWord64be Word64
ws'length
Word8
_ -> forall a. Monoid a => a
Data.Monoid.mempty
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Word32 -> Builder
Builder.fromWord32be Maybe Word32
ws'mask
]
where
len7 :: Word8
len7 | Word64
ws'length forall a. Ord a => a -> a -> Bool
< Word64
126 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ws'length
| Word64
ws'length forall a. Ord a => a -> a -> Bool
<= Word64
0xffff = Word8
126
| Bool
otherwise = Word8
127
instance Bin.Binary WSFrameHdr where
put :: WSFrameHdr -> Put
put WSFrameHdr{Bool
Maybe Word32
Word64
WSOpcode
ws'mask :: Maybe Word32
ws'length :: Word64
ws'opcode :: WSOpcode
ws'RSV3 :: Bool
ws'RSV2 :: Bool
ws'RSV1 :: Bool
ws'FIN :: Bool
ws'mask :: WSFrameHdr -> Maybe Word32
ws'length :: WSFrameHdr -> Word64
ws'opcode :: WSFrameHdr -> WSOpcode
ws'RSV3 :: WSFrameHdr -> Bool
ws'RSV2 :: WSFrameHdr -> Bool
ws'RSV1 :: WSFrameHdr -> Bool
ws'FIN :: WSFrameHdr -> Bool
..} = do
Word8 -> Put
Bin.putWord8 forall a b. (a -> b) -> a -> b
$!
(if Bool
ws'FIN then Word8
0x80 else Word8
0) forall a. Bits a => a -> a -> a
.|.
(if Bool
ws'RSV1 then Word8
0x40 else Word8
0) forall a. Bits a => a -> a -> a
.|.
(if Bool
ws'RSV2 then Word8
0x20 else Word8
0) forall a. Bits a => a -> a -> a
.|.
(if Bool
ws'RSV3 then Word8
0x10 else Word8
0) forall a. Bits a => a -> a -> a
.|.
(WSOpcode -> Word8
encodeWSOpcode WSOpcode
ws'opcode)
Word8 -> Put
Bin.putWord8 forall a b. (a -> b) -> a -> b
$!
(if forall a. Maybe a -> Bool
isJust Maybe Word32
ws'mask then Word8
0x80 else Word8
0) forall a. Bits a => a -> a -> a
.|. Word8
len7
case Word8
len7 of
Word8
126 -> Word16 -> Put
Bin.putWord16be (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ws'length)
Word8
127 -> Word64 -> Put
Bin.putWord64be Word64
ws'length
Word8
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Word32 -> Put
Bin.putWord32be Maybe Word32
ws'mask
where
len7 :: Word8
len7 | Word64
ws'length forall a. Ord a => a -> a -> Bool
< Word64
126 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ws'length
| Word64
ws'length forall a. Ord a => a -> a -> Bool
<= Word64
0xffff = Word8
126
| Bool
otherwise = Word8
127
get :: Get WSFrameHdr
get = do
Word8
o0 <- Get Word8
Bin.getWord8
let ws'FIN :: Bool
ws'FIN = forall a. Bits a => a -> Int -> Bool
testBit Word8
o0 Int
7
ws'RSV1 :: Bool
ws'RSV1 = forall a. Bits a => a -> Int -> Bool
testBit Word8
o0 Int
6
ws'RSV2 :: Bool
ws'RSV2 = forall a. Bits a => a -> Int -> Bool
testBit Word8
o0 Int
5
ws'RSV3 :: Bool
ws'RSV3 = forall a. Bits a => a -> Int -> Bool
testBit Word8
o0 Int
4
ws'opcode :: WSOpcode
ws'opcode = Word8 -> WSOpcode
decodeWSOpcode Word8
o0
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
ws'FIN Bool -> Bool -> Bool
&& Bool -> Bool
not (WSOpcode -> Bool
wsIsDataFrame WSOpcode
ws'opcode)) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid fragmented control-frame"
Word8
o1 <- Get Word8
Bin.getWord8
let len7 :: Word8
len7 = Word8
o1 forall a. Bits a => a -> a -> a
.&. Word8
0x7f
msk :: Bool
msk = Word8
o1 forall a. Ord a => a -> a -> Bool
>= Word8
0x80
Word64
ws'length <- case Word8
len7 of
Word8
127 -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WSOpcode -> Bool
wsIsDataFrame WSOpcode
ws'opcode) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid 64-bit extended length (control-frame)"
Word64
v <- Get Word64
Bin.getWord64be
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word64
v forall a. Ord a => a -> a -> Bool
> Word64
0xffff) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid 64-bit extended length (<= 0xffff)"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word64
v forall a. Ord a => a -> a -> Bool
< Word64
0x8000000000000000) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid 64-bit extended length (MSB set)"
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
v
Word8
126 -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WSOpcode -> Bool
wsIsDataFrame WSOpcode
ws'opcode) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid 16-bit extended length (control-frame)"
Word16
v <- Get Word16
Bin.getWord16be
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word16
v forall a. Ord a => a -> a -> Bool
> Word16
125) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid 16-bit extended length (<= 0x7d)"
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v)
Word8
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len7)
Maybe Word32
ws'mask <- if Bool
msk
then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get Word32
Bin.getWord32be
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return WSFrameHdr{Bool
Maybe Word32
Word64
WSOpcode
ws'mask :: Maybe Word32
ws'length :: Word64
ws'opcode :: WSOpcode
ws'RSV3 :: Bool
ws'RSV2 :: Bool
ws'RSV1 :: Bool
ws'FIN :: Bool
ws'mask :: Maybe Word32
ws'length :: Word64
ws'opcode :: WSOpcode
ws'RSV3 :: Bool
ws'RSV2 :: Bool
ws'RSV1 :: Bool
ws'FIN :: Bool
..}
data WSOpcode
= WSOpcode'Continuation
| WSOpcode'Text
| WSOpcode'Binary
| WSOpcode'Close
| WSOpcode'Ping
| WSOpcode'Pong
| WSOpcode'Reserved !WSOpcodeReserved
deriving (WSOpcode -> WSOpcode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WSOpcode -> WSOpcode -> Bool
$c/= :: WSOpcode -> WSOpcode -> Bool
== :: WSOpcode -> WSOpcode -> Bool
$c== :: WSOpcode -> WSOpcode -> Bool
Eq,Int -> WSOpcode -> ShowS
[WSOpcode] -> ShowS
WSOpcode -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [WSOpcode] -> ShowS
$cshowList :: [WSOpcode] -> ShowS
show :: WSOpcode -> [Char]
$cshow :: WSOpcode -> [Char]
showsPrec :: Int -> WSOpcode -> ShowS
$cshowsPrec :: Int -> WSOpcode -> ShowS
Show)
data WSOpcodeReserved
= WSOpcode'Reserved3
| WSOpcode'Reserved4
| WSOpcode'Reserved5
| WSOpcode'Reserved6
| WSOpcode'Reserved7
| WSOpcode'Reserved11
| WSOpcode'Reserved12
| WSOpcode'Reserved13
| WSOpcode'Reserved14
| WSOpcode'Reserved15
deriving (WSOpcodeReserved -> WSOpcodeReserved -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WSOpcodeReserved -> WSOpcodeReserved -> Bool
$c/= :: WSOpcodeReserved -> WSOpcodeReserved -> Bool
== :: WSOpcodeReserved -> WSOpcodeReserved -> Bool
$c== :: WSOpcodeReserved -> WSOpcodeReserved -> Bool
Eq,Int -> WSOpcodeReserved -> ShowS
[WSOpcodeReserved] -> ShowS
WSOpcodeReserved -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [WSOpcodeReserved] -> ShowS
$cshowList :: [WSOpcodeReserved] -> ShowS
show :: WSOpcodeReserved -> [Char]
$cshow :: WSOpcodeReserved -> [Char]
showsPrec :: Int -> WSOpcodeReserved -> ShowS
$cshowsPrec :: Int -> WSOpcodeReserved -> ShowS
Show)
wsIsDataFrame :: WSOpcode -> Bool
wsIsDataFrame :: WSOpcode -> Bool
wsIsDataFrame WSOpcode
x = case WSOpcode
x of
WSOpcode
WSOpcode'Continuation -> Bool
True
WSOpcode
WSOpcode'Text -> Bool
True
WSOpcode
WSOpcode'Binary -> Bool
True
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved3 -> Bool
True
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved4 -> Bool
True
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved5 -> Bool
True
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved6 -> Bool
True
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved7 -> Bool
True
WSOpcode
WSOpcode'Close -> Bool
False
WSOpcode
WSOpcode'Ping -> Bool
False
WSOpcode
WSOpcode'Pong -> Bool
False
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved11 -> Bool
False
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved12 -> Bool
False
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved13 -> Bool
False
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved14 -> Bool
False
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved15 -> Bool
False
decodeWSOpcode :: Word8 -> WSOpcode
decodeWSOpcode :: Word8 -> WSOpcode
decodeWSOpcode Word8
x = case Word8
x forall a. Bits a => a -> a -> a
.&. Word8
0xf of
Word8
0x0 -> WSOpcode
WSOpcode'Continuation
Word8
0x1 -> WSOpcode
WSOpcode'Text
Word8
0x2 -> WSOpcode
WSOpcode'Binary
Word8
0x3 -> WSOpcodeReserved -> WSOpcode
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved3
Word8
0x4 -> WSOpcodeReserved -> WSOpcode
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved4
Word8
0x5 -> WSOpcodeReserved -> WSOpcode
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved5
Word8
0x6 -> WSOpcodeReserved -> WSOpcode
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved6
Word8
0x7 -> WSOpcodeReserved -> WSOpcode
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved7
Word8
0x8 -> WSOpcode
WSOpcode'Close
Word8
0x9 -> WSOpcode
WSOpcode'Ping
Word8
0xA -> WSOpcode
WSOpcode'Pong
Word8
0xB -> WSOpcodeReserved -> WSOpcode
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved11
Word8
0xC -> WSOpcodeReserved -> WSOpcode
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved12
Word8
0xD -> WSOpcodeReserved -> WSOpcode
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved13
Word8
0xE -> WSOpcodeReserved -> WSOpcode
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved14
Word8
0xF -> WSOpcodeReserved -> WSOpcode
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved15
Word8
_ -> forall a. HasCallStack => a
undefined
encodeWSOpcode :: WSOpcode -> Word8
encodeWSOpcode :: WSOpcode -> Word8
encodeWSOpcode WSOpcode
x = case WSOpcode
x of
WSOpcode
WSOpcode'Continuation -> Word8
0x0
WSOpcode
WSOpcode'Text -> Word8
0x1
WSOpcode
WSOpcode'Binary -> Word8
0x2
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved3 -> Word8
0x3
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved4 -> Word8
0x4
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved5 -> Word8
0x5
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved6 -> Word8
0x6
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved7 -> Word8
0x7
WSOpcode
WSOpcode'Close -> Word8
0x8
WSOpcode
WSOpcode'Ping -> Word8
0x9
WSOpcode
WSOpcode'Pong -> Word8
0xA
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved11 -> Word8
0xB
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved12 -> Word8
0xC
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved13 -> Word8
0xD
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved14 -> Word8
0xE
WSOpcode'Reserved WSOpcodeReserved
WSOpcode'Reserved15 -> Word8
0xF
wsKeyToAcceptB64 :: SecWebSocketKey -> ByteString
wsKeyToAcceptB64 :: SecWebSocketKey -> ByteString
wsKeyToAcceptB64 SecWebSocketKey
key = ByteString -> ByteString
B64.encode (ByteString -> ByteString
SHA1.hash (SecWebSocketKey -> ByteString
secWebSocketKeyToB64 SecWebSocketKey
key ByteString -> ByteString -> ByteString
`BS.append` ByteString
rfc6455Guid))
where
rfc6455Guid :: ByteString
rfc6455Guid :: ByteString
rfc6455Guid = ByteString
"258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
newtype SecWebSocketKey = WSKey ByteString deriving (SecWebSocketKey -> SecWebSocketKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecWebSocketKey -> SecWebSocketKey -> Bool
$c/= :: SecWebSocketKey -> SecWebSocketKey -> Bool
== :: SecWebSocketKey -> SecWebSocketKey -> Bool
$c== :: SecWebSocketKey -> SecWebSocketKey -> Bool
Eq,Eq SecWebSocketKey
SecWebSocketKey -> SecWebSocketKey -> Bool
SecWebSocketKey -> SecWebSocketKey -> Ordering
SecWebSocketKey -> SecWebSocketKey -> SecWebSocketKey
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 :: SecWebSocketKey -> SecWebSocketKey -> SecWebSocketKey
$cmin :: SecWebSocketKey -> SecWebSocketKey -> SecWebSocketKey
max :: SecWebSocketKey -> SecWebSocketKey -> SecWebSocketKey
$cmax :: SecWebSocketKey -> SecWebSocketKey -> SecWebSocketKey
>= :: SecWebSocketKey -> SecWebSocketKey -> Bool
$c>= :: SecWebSocketKey -> SecWebSocketKey -> Bool
> :: SecWebSocketKey -> SecWebSocketKey -> Bool
$c> :: SecWebSocketKey -> SecWebSocketKey -> Bool
<= :: SecWebSocketKey -> SecWebSocketKey -> Bool
$c<= :: SecWebSocketKey -> SecWebSocketKey -> Bool
< :: SecWebSocketKey -> SecWebSocketKey -> Bool
$c< :: SecWebSocketKey -> SecWebSocketKey -> Bool
compare :: SecWebSocketKey -> SecWebSocketKey -> Ordering
$ccompare :: SecWebSocketKey -> SecWebSocketKey -> Ordering
Ord,Int -> SecWebSocketKey -> ShowS
[SecWebSocketKey] -> ShowS
SecWebSocketKey -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SecWebSocketKey] -> ShowS
$cshowList :: [SecWebSocketKey] -> ShowS
show :: SecWebSocketKey -> [Char]
$cshow :: SecWebSocketKey -> [Char]
showsPrec :: Int -> SecWebSocketKey -> ShowS
$cshowsPrec :: Int -> SecWebSocketKey -> ShowS
Show)
secWebSocketKeyFromB64 :: ByteString -> Maybe SecWebSocketKey
secWebSocketKeyFromB64 :: ByteString -> Maybe SecWebSocketKey
secWebSocketKeyFromB64 ByteString
key
| ByteString -> Int
BS.length ByteString
key' forall a. Eq a => a -> a -> Bool
/= Int
24 = forall a. Maybe a
Nothing
| Left [Char]
_ <- ByteString -> Either [Char] ByteString
B64.decode ByteString
key' = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ByteString -> SecWebSocketKey
WSKey ByteString
key'
where
key' :: ByteString
key' = forall a b. (a, b) -> a
fst ((Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd Word8 -> Bool
isOWS ((Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isOWS ByteString
key))
isOWS :: Word8 -> Bool
isOWS :: Word8 -> Bool
isOWS Word8
0x09 = Bool
True
isOWS Word8
0x20 = Bool
True
isOWS Word8
_ = Bool
False
secWebSocketKeyToB64 :: SecWebSocketKey -> ByteString
secWebSocketKeyToB64 :: SecWebSocketKey -> ByteString
secWebSocketKeyToB64 (WSKey ByteString
bs) = ByteString
bs
secWebSocketKeyFromWords :: Word64 -> Word64 -> SecWebSocketKey
secWebSocketKeyFromWords :: Word64 -> Word64 -> SecWebSocketKey
secWebSocketKeyFromWords Word64
h Word64
l = ByteString -> SecWebSocketKey
WSKey (ByteString -> ByteString
B64.encode ByteString
key)
where
key :: ByteString
key = [ByteString] -> ByteString
BS.concat forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BL.toChunks forall a b. (a -> b) -> a -> b
$ Put -> ByteString
Bin.runPut (Word64 -> Put
Bin.putWord64be Word64
h forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
Bin.putWord64be Word64
l)
xor32InputStream :: Word32 -> InputStream ByteString -> IO (InputStream ByteString)
xor32InputStream :: Word32 -> InputStream ByteString -> IO (InputStream ByteString)
xor32InputStream Word32
0 InputStream ByteString
is = forall (m :: * -> *) a. Monad m => a -> m a
return InputStream ByteString
is
xor32InputStream Word32
msk0 InputStream ByteString
is = do
IORef Word32
mskref <- forall a. a -> IO (IORef a)
newIORef Word32
msk0
let go :: IO (Maybe ByteString)
go = do
Maybe ByteString
mchunk <- forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream ByteString
is
case Maybe ByteString
mchunk of
Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just ByteString
chunk -> do
Word32
msk <- forall a. IORef a -> IO a
readIORef IORef Word32
mskref
let (Word32
msk',ByteString
chunk') = Word32 -> ByteString -> (Word32, ByteString)
xor32StrictByteString' Word32
msk ByteString
chunk
forall a. IORef a -> a -> IO ()
writeIORef IORef Word32
mskref Word32
msk'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ByteString
chunk'
forall a. IO (Maybe a) -> IO (InputStream a)
Streams.makeInputStream IO (Maybe ByteString)
go
wsUpgradeConnection :: Connection
-> ByteString
-> RequestBuilder α
-> SecWebSocketKey
-> (Response -> InputStream ByteString -> IO b)
-> (Response -> Connection -> IO b)
-> IO b
wsUpgradeConnection :: forall α b.
Connection
-> ByteString
-> RequestBuilder α
-> SecWebSocketKey
-> (Response -> InputStream ByteString -> IO b)
-> (Response -> Connection -> IO b)
-> IO b
wsUpgradeConnection Connection
conn ByteString
resource RequestBuilder α
rqmod SecWebSocketKey
wskey Response -> InputStream ByteString -> IO b
failedToUpgrade Response -> Connection -> IO b
success = do
let rqToWS :: Request
rqToWS = forall α. RequestBuilder α -> Request
HC.buildRequest1 forall a b. (a -> b) -> a -> b
$ do
Method -> ByteString -> RequestBuilder ()
HC.http Method
HC.GET ByteString
resource
ByteString -> ByteString -> RequestBuilder ()
HC.setHeader ByteString
"upgrade" ByteString
"websocket"
ByteString -> ByteString -> RequestBuilder ()
HC.setHeader ByteString
"connection" ByteString
"Upgrade"
ByteString -> ByteString -> RequestBuilder ()
HC.setHeader ByteString
"sec-websocket-version" ByteString
"13"
ByteString -> ByteString -> RequestBuilder ()
HC.setHeader ByteString
"sec-websocket-key" (SecWebSocketKey -> ByteString
secWebSocketKeyToB64 SecWebSocketKey
wskey)
RequestBuilder α
rqmod
forall α.
Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
HC.sendRequest Connection
conn Request
rqToWS OutputStream Builder -> IO ()
HC.emptyBody
forall a.
Connection
-> (Response -> InputStream ByteString -> IO a)
-> (Response
-> InputStream ByteString -> OutputStream Builder -> IO a)
-> IO a
HC.receiveUpgradeResponse Connection
conn Response -> InputStream ByteString -> IO b
failedToUpgrade forall a b. (a -> b) -> a -> b
$ \Response
resp InputStream ByteString
_is OutputStream Builder
_os -> do
case forall s. FoldCase s => s -> CI s
CI.mk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Response -> ByteString -> Maybe ByteString
HC.getHeader Response
resp ByteString
"connection" of
Maybe (CI ByteString)
Nothing -> forall {a}. [Char] -> IO a
abort [Char]
"missing 'connection' header"
Just CI ByteString
"upgrade" -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just CI ByteString
_ -> forall {a}. [Char] -> IO a
abort [Char]
"'connection' header has non-'upgrade' value"
case forall s. FoldCase s => s -> CI s
CI.mk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Response -> ByteString -> Maybe ByteString
HC.getHeader Response
resp ByteString
"upgrade" of
Maybe (CI ByteString)
Nothing -> forall {a}. [Char] -> IO a
abort [Char]
"missing 'upgrade' header"
Just CI ByteString
"websocket" -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just CI ByteString
_ -> forall {a}. [Char] -> IO a
abort [Char]
"'upgrade' header has non-'websocket' value"
case Response -> ByteString -> Maybe ByteString
HC.getHeader Response
resp ByteString
"sec-websocket-accept" of
Maybe ByteString
Nothing -> forall {a}. [Char] -> IO a
abort [Char]
"missing 'sec-websocket-accept' header"
Just ByteString
wsacc
| ByteString
wsacc forall a. Eq a => a -> a -> Bool
/= SecWebSocketKey -> ByteString
wsKeyToAcceptB64 SecWebSocketKey
wskey -> forall {a}. [Char] -> IO a
abort [Char]
"sec-websocket-accept header mismatch"
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Response -> Connection -> IO b
success Response
resp Connection
conn
where
abort :: [Char] -> IO a
abort [Char]
msg = forall e a. Exception e => e -> IO a
throwIO ([Char] -> WsException
WsException ([Char]
"wsUpgradeConnection: "forall a. [a] -> [a] -> [a]
++[Char]
msg))