{-# LANGUAGE OverloadedStrings #-}
module Pirandello.IncomingSpec where

import Test.Hspec (Spec, shouldBe, shouldReturn, shouldContain, describe, it)

import Control.Applicative ((<$>))
import Control.Concurrent.Async (withAsync)
import Control.Concurrent.Async.UIO (asyncE, cancel)
import Control.Concurrent.STM (atomically, newTQueue, readTQueue)
import Control.Monad.Trans.Class (lift)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL
import Network.Socket ( socket, socketPair, getSocketName, connect, close
                      , Family (AF_UNIX), SocketType (Stream), defaultProtocol )
import Network.Socket.ByteString (sendAll, recv)
import Pirandello.Events (Event (IncomingConnection))
import Pirandello.Frames (asFrame)
import Pirandello.Incoming (incoming, echo, service)
import Pirandello.SocketUtil (tempSocket, unlinkUnixSocket)
import System.Directory.UIO (getTemporaryDirectory)
import UnexceptionalIO (runUnexceptionalIO)
import UnexceptionalIO.ExceptT (throwEUIO)

spec ∷ Spec
spec = do
    describe "echo" $
        it "echos back two messages" $ do
            let msg1 = "hello world!"
            let msg2 = "goodbye"
            (s1, s2) ← socketPair AF_UNIX Stream defaultProtocol
            a ← runUnexceptionalIO . asyncE $ echo s2
            sendAll s1 $ B.pack msg1
            B.unpack <$> recv s1 4096 `shouldReturn` msg1
            sendAll s1 $ B.pack msg2
            B.unpack <$> recv s1 4096 `shouldReturn` msg2
            throwEUIO $ cancel a
            sequence_ $ close <$> [s1, s2]

    describe "dispatchConnections" $
        it "works with echo" $ do
            let msg1 = "hello world!"
            s2 ← throwEUIO $ tempSocket =<< lift getTemporaryDirectory
            a ← runUnexceptionalIO . asyncE $ service echo s2
            s1 ← socket AF_UNIX Stream defaultProtocol
            getSocketName s2 >>= connect s1
            sendAll s1 $ B.pack msg1
            B.unpack <$> recv s1 4096 `shouldReturn` msg1
            close s1
            throwEUIO $ cancel a
            throwEUIO $ unlinkUnixSocket s2

    describe "incoming" $
        it "creates Unix sockets for incoming connections" $ do
            incomingSock ← throwEUIO $ tempSocket =<< lift getTemporaryDirectory
            locals ← atomically newTQueue
            IncomingConnection _id name path ← withAsync (throwEUIO $ incoming locals incomingSock) $ \_ → do
                connSock ← socket AF_UNIX Stream defaultProtocol
                connect connSock =<< getSocketName incomingSock
                let Right fr = asFrame "name"
                sendAll connSock $ BL.toStrict fr
                atomically $ readTQueue locals
            throwEUIO $ unlinkUnixSocket incomingSock
            name `shouldBe` "name"
            path `shouldContain` "/tmp"
