socket-unix-0.2.0.0: test/Internal.hs

{-# language OverloadedStrings #-}
module Internal where

import Control.Concurrent.Async (async, wait)
import Control.Exception (bracket, throwIO, try)
import Control.Monad (when)
import Data.Maybe (fromJust)
import Data.String (IsString)
import Data.ByteString (ByteString)
import System.Posix.Files.ByteString (removeLink, fileExist)
import Test.Tasty
import Test.Tasty.HUnit

import System.Socket
import System.Socket.Type.Stream
import System.Socket.Type.Datagram
import System.Socket.Protocol.Default
import System.Socket.Family.Unix

groupUnixPathname :: TestTree
groupUnixPathname = testGroup "Unix path name"
    [ testCase "connect to non-existing path name" $ bracket
        unixSocketStream
        close
        (\s -> do
            r <- try $ connect s addr
            case r of
                Left e | e == eNoEntry -> return ()
                       | otherwise     -> throwIO e
                Right () -> assertFailure "connection should have failed"
        )

    , testCase "server\\client stream" $ bracket
        ( (,) <$> unixSocketStream <*> unixSocketStream)
        closeSockets
        (testServerClientStream addr)

    , testCase "server\\client datagram" $ bracket
        ((,) <$> unixSocketDatagram <*> unixSocketDatagram)
        closeSockets
        (testServerClientDatagram addr cAddr)
    ]
  where
    addr = fromJust $ socketAddressUnixPath unixPath
    cAddr = fromJust $ socketAddressUnixPath clientUnixPath
    closeSockets (server, client) = do
        close server
        close client
        unlink unixPath
        unlink clientUnixPath
    -- Sockets with real pathname should be unlinked after closing
    unlink path = fileExist path >>= flip when (removeLink path)

clientMessage :: ByteString
clientMessage = "client message"

serverMessage :: ByteString
serverMessage = "server message"

unixPath :: ByteString
unixPath = "Woum5ag3oohuaLee.socket"

clientUnixPath :: ByteString
clientUnixPath = "Io4meo0epoquashi.socket"

abstractPath :: ByteString
abstractPath = "/tmp/uth4Aechiereejae.socket"

clientAbstractPath :: ByteString
clientAbstractPath = "/tmp/FieNg4shamo4Thie.socket"

unixSocketStream :: IO (Socket Unix Stream Default)
unixSocketStream = socket

unixSocketDatagram :: IO (Socket Unix Datagram Default)
unixSocketDatagram = socket

testServerClientStream
    :: SocketAddress Unix
    -> (Socket Unix Stream Default, Socket Unix Stream Default)
    -> IO ()
testServerClientStream addr (server, client) = do
    bind server addr
    listen server 5
    serverRecv <- async $ do
        (peerSock, peerAddr) <- accept server
        r <- receive peerSock 4096 mempty
        send peerSock serverMessage mempty
        pure r
    connect client addr
    send client clientMessage mempty

    clientMessageReceived <- wait serverRecv
    serverMessageReceived <- receive client 4096 mempty
    clientMessageReceived @?= clientMessage
    serverMessageReceived @?= serverMessage

testServerClientDatagram
    :: SocketAddress Unix
    -> SocketAddress Unix
    -> (Socket Unix Datagram Default, Socket Unix Datagram Default)
    -> IO ()
testServerClientDatagram sAddr cAddr (server, client) = do
    bind server sAddr
    bind client cAddr
    serverRecv <- async $ do
        (r, peerAddr) <- receiveFrom server 4096 mempty
        sendTo server serverMessage mempty peerAddr
        pure r
    sendTo client clientMessage mempty sAddr

    clientMessageReceived <- wait serverRecv
    serverMessageReceived <- receive client 4096 mempty
    clientMessageReceived @?= clientMessage
    serverMessageReceived @?= serverMessage