module Network.Greskell.WebSocket.Codec
(
Codec(..),
encodeBinaryWith,
messageHeader,
decodeBinary
) where
import Control.Monad (when)
import qualified Data.ByteString.Lazy as BSL
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8, decodeUtf8')
import Network.Greskell.WebSocket.Request (RequestMessage)
import Network.Greskell.WebSocket.Response (ResponseMessage)
data Codec s =
Codec
{ mimeType :: Text,
encodeWith :: RequestMessage -> BSL.ByteString,
decodeWith :: BSL.ByteString -> Either String (ResponseMessage s)
}
instance Functor Codec where
fmap f c = c { decodeWith = (fmap . fmap . fmap) f $ decodeWith c }
messageHeader :: Text
-> BSL.ByteString
messageHeader mime = BSL.singleton size <> mime_bin
where
size = fromIntegral $ BSL.length mime_bin
mime_bin = BSL.fromStrict $ encodeUtf8 mime
encodeBinaryWith :: Codec s -> RequestMessage -> BSL.ByteString
encodeBinaryWith c req = messageHeader (mimeType c) <> encodeWith c req
decodeBinary :: BSL.ByteString
-> Either String (Text, BSL.ByteString)
decodeBinary raw_msg = do
case BSL.uncons raw_msg of
Nothing -> Left "Length of MIME type is missing in the header."
Just (mime_len, rest) -> decodeMimeAndPayload mime_len rest
where
decodeMimeAndPayload mime_lenw msg = do
when (BSL.length mime_field /= mime_len) $ Left ("Too short MIME field: " <> show mime_field)
mime_text <- either (Left . show) Right $ decodeUtf8' $ BSL.toStrict $ mime_field
return (mime_text, payload)
where
(mime_field, payload) = BSL.splitAt mime_len msg
mime_len = fromIntegral mime_lenw