-- |
-- Module: Network.Greskell.WebSocket.Connection.Type
-- Description: common types for Connection
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- This is an internal module. This defines and exports common types
-- used by Connection modules. The upper module is responsible to
-- limit exports from this module.
module Network.Greskell.WebSocket.Connection.Type
  ( RawReq,
    RawRes,
    ReqID,
    ResPack,
    ReqPack(..),
    ConnectionState(..),
    Connection(..),
    GeneralException(..)
  ) where

import Control.Concurrent.Async (Async)
import Control.Exception.Safe (SomeException, Typeable, Exception)
import Control.Concurrent.STM (TQueue, TBQueue, TVar)
import qualified Data.ByteString.Lazy as BSL
import Data.UUID (UUID)

import Network.Greskell.WebSocket.Response (ResponseMessage)
import Network.Greskell.WebSocket.Codec (Codec)

type RawReq = BSL.ByteString
type RawRes = BSL.ByteString
type ReqID = UUID

-- | Package of Response data and related stuff.
type ResPack s = Either SomeException (ResponseMessage s)

-- | Package of request data and related stuff. It's passed from the
-- caller thread into WS handling thread.
data ReqPack s = 
  ReqPack
  { ReqPack s -> RawReq
reqData :: !RawReq,
    -- ^ Encoded request data
    ReqPack s -> ReqID
reqId :: !ReqID,
    -- ^ request ID
    ReqPack s -> TQueue (ResPack s)
reqOutput :: !(TQueue (ResPack s))
    -- ^ the output queue for incoming response for this request.
  }

-- | State of the 'Connection'.
data ConnectionState =
    ConnOpen
    -- ^ Connection is open and ready to use.
  | ConnClosing
    -- ^ Connection is closing. It rejects new requests, but keeps
    -- receiving responses for pending requests. When there is no
    -- pending requests, it goes to 'ConnClosed'.
  | ConnClosed
    -- ^ Connection is closed. It rejects requests, and it doesn't
    -- expect any responses. It can close the underlying WebSocket
    -- connection.
  deriving (Int -> ConnectionState -> ShowS
[ConnectionState] -> ShowS
ConnectionState -> String
(Int -> ConnectionState -> ShowS)
-> (ConnectionState -> String)
-> ([ConnectionState] -> ShowS)
-> Show ConnectionState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionState] -> ShowS
$cshowList :: [ConnectionState] -> ShowS
show :: ConnectionState -> String
$cshow :: ConnectionState -> String
showsPrec :: Int -> ConnectionState -> ShowS
$cshowsPrec :: Int -> ConnectionState -> ShowS
Show,ConnectionState -> ConnectionState -> Bool
(ConnectionState -> ConnectionState -> Bool)
-> (ConnectionState -> ConnectionState -> Bool)
-> Eq ConnectionState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionState -> ConnectionState -> Bool
$c/= :: ConnectionState -> ConnectionState -> Bool
== :: ConnectionState -> ConnectionState -> Bool
$c== :: ConnectionState -> ConnectionState -> Bool
Eq,Eq ConnectionState
Eq ConnectionState
-> (ConnectionState -> ConnectionState -> Ordering)
-> (ConnectionState -> ConnectionState -> Bool)
-> (ConnectionState -> ConnectionState -> Bool)
-> (ConnectionState -> ConnectionState -> Bool)
-> (ConnectionState -> ConnectionState -> Bool)
-> (ConnectionState -> ConnectionState -> ConnectionState)
-> (ConnectionState -> ConnectionState -> ConnectionState)
-> Ord ConnectionState
ConnectionState -> ConnectionState -> Bool
ConnectionState -> ConnectionState -> Ordering
ConnectionState -> ConnectionState -> ConnectionState
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 :: ConnectionState -> ConnectionState -> ConnectionState
$cmin :: ConnectionState -> ConnectionState -> ConnectionState
max :: ConnectionState -> ConnectionState -> ConnectionState
$cmax :: ConnectionState -> ConnectionState -> ConnectionState
>= :: ConnectionState -> ConnectionState -> Bool
$c>= :: ConnectionState -> ConnectionState -> Bool
> :: ConnectionState -> ConnectionState -> Bool
$c> :: ConnectionState -> ConnectionState -> Bool
<= :: ConnectionState -> ConnectionState -> Bool
$c<= :: ConnectionState -> ConnectionState -> Bool
< :: ConnectionState -> ConnectionState -> Bool
$c< :: ConnectionState -> ConnectionState -> Bool
compare :: ConnectionState -> ConnectionState -> Ordering
$ccompare :: ConnectionState -> ConnectionState -> Ordering
$cp1Ord :: Eq ConnectionState
Ord,Int -> ConnectionState
ConnectionState -> Int
ConnectionState -> [ConnectionState]
ConnectionState -> ConnectionState
ConnectionState -> ConnectionState -> [ConnectionState]
ConnectionState
-> ConnectionState -> ConnectionState -> [ConnectionState]
(ConnectionState -> ConnectionState)
-> (ConnectionState -> ConnectionState)
-> (Int -> ConnectionState)
-> (ConnectionState -> Int)
-> (ConnectionState -> [ConnectionState])
-> (ConnectionState -> ConnectionState -> [ConnectionState])
-> (ConnectionState -> ConnectionState -> [ConnectionState])
-> (ConnectionState
    -> ConnectionState -> ConnectionState -> [ConnectionState])
-> Enum ConnectionState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ConnectionState
-> ConnectionState -> ConnectionState -> [ConnectionState]
$cenumFromThenTo :: ConnectionState
-> ConnectionState -> ConnectionState -> [ConnectionState]
enumFromTo :: ConnectionState -> ConnectionState -> [ConnectionState]
$cenumFromTo :: ConnectionState -> ConnectionState -> [ConnectionState]
enumFromThen :: ConnectionState -> ConnectionState -> [ConnectionState]
$cenumFromThen :: ConnectionState -> ConnectionState -> [ConnectionState]
enumFrom :: ConnectionState -> [ConnectionState]
$cenumFrom :: ConnectionState -> [ConnectionState]
fromEnum :: ConnectionState -> Int
$cfromEnum :: ConnectionState -> Int
toEnum :: Int -> ConnectionState
$ctoEnum :: Int -> ConnectionState
pred :: ConnectionState -> ConnectionState
$cpred :: ConnectionState -> ConnectionState
succ :: ConnectionState -> ConnectionState
$csucc :: ConnectionState -> ConnectionState
Enum,ConnectionState
ConnectionState -> ConnectionState -> Bounded ConnectionState
forall a. a -> a -> Bounded a
maxBound :: ConnectionState
$cmaxBound :: ConnectionState
minBound :: ConnectionState
$cminBound :: ConnectionState
Bounded)

-- | A WebSocket connection to a Gremlin Server.
--
-- Type @s@ is the body of Response, as in 'ResponseMessage'.
data Connection s =
  Connection
  { Connection s -> TBQueue (ReqPack s)
connQReq :: !(TBQueue (ReqPack s)),
    -- ^ Request queue to WS (Mux) thread.
    Connection s -> TVar ConnectionState
connState :: !(TVar ConnectionState),
    Connection s -> Async ()
connWSThread :: !(Async ()),
    -- ^ WS (Mux) thread. It keeps the underlying WebSocket
    -- connection, watches various types of events and responds to
    -- those events.
    Connection s -> Codec s
connCodec :: !(Codec s)
  }

-- | Exception general to a 'Connection'. It's not related to specific
-- requests.
data GeneralException =
    UnexpectedRequestId UUID
    -- ^ Server sends a 'ResponseMessage' with unknown requestId, which
    -- is kept in this exception.
  | ResponseParseFailure String
    -- ^ The 'Connection' fails to parse a data from the server. The
    -- error message is kept in this exception.
  deriving (Int -> GeneralException -> ShowS
[GeneralException] -> ShowS
GeneralException -> String
(Int -> GeneralException -> ShowS)
-> (GeneralException -> String)
-> ([GeneralException] -> ShowS)
-> Show GeneralException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeneralException] -> ShowS
$cshowList :: [GeneralException] -> ShowS
show :: GeneralException -> String
$cshow :: GeneralException -> String
showsPrec :: Int -> GeneralException -> ShowS
$cshowsPrec :: Int -> GeneralException -> ShowS
Show,GeneralException -> GeneralException -> Bool
(GeneralException -> GeneralException -> Bool)
-> (GeneralException -> GeneralException -> Bool)
-> Eq GeneralException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeneralException -> GeneralException -> Bool
$c/= :: GeneralException -> GeneralException -> Bool
== :: GeneralException -> GeneralException -> Bool
$c== :: GeneralException -> GeneralException -> Bool
Eq,Typeable)

instance Exception GeneralException