module Eventloop.Utility.Websockets
    ( module Eventloop.Utility.Websockets
    , S.Socket
    , Connection
    ) where

import qualified Network.Socket as S
import qualified Data.Text as T
import Network.WebSockets hiding (Message)
import Control.Concurrent.MVar
import Control.Concurrent
import Control.Exception
import Data.ByteString.Lazy

type Host = [Char]
type Port = Int
type Message = [Char]
type ReceiveBuffer = MVar Message

                                    
createBindListenServerSocket :: Host -> Port -> IO S.Socket
createBindListenServerSocket host port = do
                                        host' <- S.inet_addr host
                                        socket <- S.socket S.AF_INET S.Stream S.defaultProtocol
                                        S.setSocketOption socket S.ReuseAddr 1
                                        S.bindSocket socket (S.SockAddrInet (fromIntegral port) host')
                                        S.listen socket 5
                                        return socket

                                        
acceptFirstConnection :: S.Socket -> IO Connection
acceptFirstConnection serverSocket = do
                                        (clientSocket, clientAddr) <- S.accept serverSocket
                                        pendingConnection <- makePendingConnection clientSocket defaultConnectionOptions
                                        connection <- acceptRequest pendingConnection
                                        return connection

                                        
setupWebsocketConnection :: Host -> Port -> IO (ReceiveBuffer, Connection, S.Socket)
setupWebsocketConnection host port = S.withSocketsDo $ do
                                                        serverSocket <- createBindListenServerSocket host port
                                                        clientConnection <- acceptFirstConnection serverSocket
                                                        recvBuffer <- newEmptyMVar
                                                        spawnReader recvBuffer clientConnection
                                                        return (recvBuffer, clientConnection, serverSocket)
                                        
                                        
spawnReader :: ReceiveBuffer -> Connection -> IO ThreadId
spawnReader recvBuffer conn = do
                                forkIO (readIntoBuffer recvBuffer conn)
                                
                                
readIntoBuffer :: ReceiveBuffer -> Connection -> IO ()
readIntoBuffer recvBuffer conn = handle handleCloseRequestException $ do
                                                                        textMessage <- receiveData conn
                                                                        let
                                                                            message = T.unpack textMessage
                                                                        putMVar recvBuffer message
                                                                        readIntoBuffer recvBuffer conn
                            
handleCloseRequestException :: ConnectionException -> IO ()
handleCloseRequestException (CloseRequest i reason) | i == 1000 = return ()
                                                    | otherwise = Prelude.putStrLn ("Connection was closed but reason unknown: " ++ show i ++ show reason)
handleCloseRequestException (ConnectionClosed)    = Prelude.putStrLn ("Connection was closed unexpectedly")
handleCloseRequestException (ParseException text) = Prelude.putStrLn ("Parse exception on message: " ++ text)
                            
                            
hasMessage :: ReceiveBuffer -> IO Bool
hasMessage recvBuffer = do
                            buffer <- tryReadMVar recvBuffer
                            return (buffer /= Nothing)
                            
                            
takeMessage :: ReceiveBuffer -> IO Message
takeMessage recvBuffer = do
                            message <- takeMVar recvBuffer
                            return message
                                
                                
writeMessage :: Connection -> Message -> IO ()
writeMessage conn message = sendTextData conn (T.pack message)
                            

writeBinaryMessage :: Connection -> ByteString -> IO ()
writeBinaryMessage conn message = sendBinaryData conn message


closeWebsocketConnection :: S.Socket -> Connection -> IO ()
closeWebsocketConnection serverSocket clientConnection = do
                                                            S.sClose serverSocket
                                                            sendClose clientConnection (T.pack "Shutting down..")