--  This Source Code Form is subject to the terms of the Mozilla Public
--  License, v. 2.0. If a copy of the MPL was not distributed with this
--  file, You can obtain one at http://mozilla.org/MPL/2.0/.

-- | Extras for working with websockets & JSON.
--
-- This module allows to write simple websocket clients following a request/response pattern over some
-- JSON encoded data.
module Network.WebSockets.Json where

import Prelude

import Control.Exception
    ( Exception
    )
import Control.Monad.Catch
    ( MonadThrow (..)
    )
import Control.Monad.IO.Class
    ( MonadIO (..)
    )
import Data.ByteString.Lazy
    ( ByteString
    )

import qualified Data.Aeson as Json
import qualified Data.Aeson.Encoding as Json
import qualified Data.Aeson.Internal as Json
import qualified Data.Aeson.Parser.Internal as Json
import qualified Data.Aeson.Types as Json
import qualified Network.WebSockets as WS

-- | Send some JSON encoding through the given connection.
sendJson
    :: forall m.
        ( MonadIO m
        )
    => WS.Connection
    -> Json.Encoding
    -> m ()
sendJson :: forall (m :: * -> *). MonadIO m => Connection -> Encoding -> m ()
sendJson Connection
ws =
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendTextData Connection
ws forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoding' a -> ByteString
Json.encodingToLazyByteString

-- | Synchronously receive some JSON-encoded bytes through the given connection.
--
-- Throws 'MalformedOrUnexpectedResponseException' upon failure.
receiveJson
    :: forall m a.
        ( MonadThrow m
        , MonadIO m
        )
    => WS.Connection
    -> (Json.Value -> Json.Parser a)
    -> m a
receiveJson :: forall (m :: * -> *) a.
(MonadThrow m, MonadIO m) =>
Connection -> (Value -> Parser a) -> m a
receiveJson Connection
ws Value -> Parser a
decoder =  do
    ByteString
bytes <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. WebSocketsData a => Connection -> IO a
WS.receiveData Connection
ws)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (\(JSONPath
path, String
err) -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ ByteString
-> JSONPath -> String -> MalformedOrUnexpectedResponseException
MalformedOrUnexpectedResponse ByteString
bytes JSONPath
path String
err)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (forall a.
Parser Value
-> (Value -> IResult a)
-> ByteString
-> Either (JSONPath, String) a
Json.eitherDecodeWith Parser Value
Json.jsonEOF (forall a b. (a -> Parser b) -> a -> IResult b
Json.iparse Value -> Parser a
decoder) ByteString
bytes)

-- | An exception thrown when failing to decode a JSON payload.
data MalformedOrUnexpectedResponseException =
    MalformedOrUnexpectedResponse
        { MalformedOrUnexpectedResponseException -> ByteString
bytesReceived :: !ByteString
            -- ^ Actual bytes received from the websocket
        , MalformedOrUnexpectedResponseException -> JSONPath
errorPath :: !Json.JSONPath
            -- ^ JSON path at which the decoding error occured
        , MalformedOrUnexpectedResponseException -> String
hint :: !String
            -- ^ A explanation of what's going on.
        }
    deriving (Int -> MalformedOrUnexpectedResponseException -> ShowS
[MalformedOrUnexpectedResponseException] -> ShowS
MalformedOrUnexpectedResponseException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MalformedOrUnexpectedResponseException] -> ShowS
$cshowList :: [MalformedOrUnexpectedResponseException] -> ShowS
show :: MalformedOrUnexpectedResponseException -> String
$cshow :: MalformedOrUnexpectedResponseException -> String
showsPrec :: Int -> MalformedOrUnexpectedResponseException -> ShowS
$cshowsPrec :: Int -> MalformedOrUnexpectedResponseException -> ShowS
Show)

instance Exception MalformedOrUnexpectedResponseException