module Database.TinkerPop.Internal where
import Database.TinkerPop.Types
import Prelude hiding (putStrLn)
import Data.Text (Text, pack, append)
import Data.Text.IO
import Data.Text.Encoding
import Control.Exception
import qualified Data.Map.Strict as M
import qualified Control.Monad.STM as S
import qualified Control.Concurrent.STM.TChan as S
import qualified Control.Concurrent.STM.TVar as S
import Control.Concurrent
import Control.Monad
import Control.Lens
import Data.Aeson (eitherDecodeStrict)
import qualified Network.WebSockets as WS
inStatus2xx :: Int -> Bool
inStatus2xx x = (x `quot` 100) == 2
handler :: Connection -> MVar () -> IO ()
handler conn done = do
void $ forkIO $ do
handle (wsExceptionHandler "child thread") $ forever $ do
msg <- (WS.receiveData (conn ^. socket) :: IO Text)
case eitherDecodeStrict (encodeUtf8 msg) of
Right r -> do
cs <- S.readTVarIO (conn ^. chans)
case M.lookup (r ^. requestId) cs of
Just chan -> S.atomically $ S.writeTChan chan (Right r)
Nothing -> putStrLn $ "ERROR: chan not found"
Left s -> putStrLn $ "ERROR: parse response message: " `append` (pack s)
putMVar done ()
wsExceptionHandler :: Text -> SomeException -> IO ()
wsExceptionHandler label e = do
case fromException e of
Just WS.ConnectionClosed -> return ()
_ -> do
putStrLn $ "unexpect exception[" `append` label `append` "]: " `append` (pack $ show e)
throw e
close :: Connection -> IO ()
close conn = do
WS.sendClose (conn ^. socket) ("Bye!" :: Text)