    --------------------------------------------------------------------------------
    module Network.WebSockets.Extensions.StrictUnicode
        ( strictUnicode
        ) where

    --------------------------------------------------------------------------------
    import           Control.Exception             (throwIO)
    import qualified Data.ByteString.Lazy          as BL
    import           Network.WebSockets.Extensions
    import           Network.WebSockets.Types

    --------------------------------------------------------------------------------
    strictUnicode :: Extension
    strictUnicode :: Extension
    strictUnicode = Extension
        { extHeaders :: Headers
    extHeaders = []
        , extParse :: IO (Maybe Message) -> IO (IO (Maybe Message))
    extParse   = \IO (Maybe Message)
    parseRaw -> IO (Maybe Message) -> IO (IO (Maybe Message))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO (Maybe Message)
    parseRaw IO (Maybe Message)
    -> (Maybe Message -> IO (Maybe Message)) -> IO (Maybe Message)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe Message -> IO (Maybe Message)
    strictParse)
        , extWrite :: ([Message] -> IO ()) -> IO ([Message] -> IO ())
    extWrite   = ([Message] -> IO ()) -> IO ([Message] -> IO ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        }

    --------------------------------------------------------------------------------
    strictParse :: Maybe Message -> IO (Maybe Message)
    strictParse :: Maybe Message -> IO (Maybe Message)
    strictParse Maybe Message
    Nothing = Maybe Message -> IO (Maybe Message)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Message
    forall a. Maybe a
    Nothing
    strictParse (Just (DataMessage Bool
    rsv1 Bool
    rsv2 Bool
    rsv3 (Text ByteString
    bl Maybe Text
    _))) =
        case ByteString -> Either ConnectionException Text
    decodeUtf8Strict ByteString
    bl of
            Left ConnectionException
    err   -> ConnectionException -> IO (Maybe Message)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO ConnectionException
    err
            Right Text
    txt ->
                Maybe Message -> IO (Maybe Message)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Message -> Maybe Message
    forall a. a -> Maybe a
    Just (Bool -> Bool -> Bool -> DataMessage -> Message
    DataMessage Bool
    rsv1 Bool
    rsv2 Bool
    rsv3 (ByteString -> Maybe Text -> DataMessage
    Text ByteString
    bl (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    txt))))
    strictParse (Just msg :: Message
    msg@(ControlMessage (Close Word16
    _ ByteString
    bl))) =
        -- If there is a body, the first two bytes of the body MUST be a 2-byte
        -- unsigned integer (in network byte order) representing a status code with
        -- value /code/ defined in Section 7.4.  Following the 2-byte integer, the
        -- body MAY contain UTF-8-encoded data with value /reason/, the
        -- interpretation of which is not defined by this specification.
        case ByteString -> Either ConnectionException Text
    decodeUtf8Strict (Int64 -> ByteString -> ByteString
    BL.drop Int64
    2 ByteString
    bl) of
            Left ConnectionException
    err -> ConnectionException -> IO (Maybe Message)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO ConnectionException
    err
            Right Text
    _  -> Maybe Message -> IO (Maybe Message)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Message -> Maybe Message
    forall a. a -> Maybe a
    Just Message
    msg)
    strictParse (Just Message
    msg) = Maybe Message -> IO (Maybe Message)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Message -> Maybe Message
    forall a. a -> Maybe a
    Just Message
    msg)