packages feed

linear-socket-0.3.3.0: test/Spec.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Main (linear-socket-spec)
-- Copyright   :  Copyright (C) 2017 Allele Dev
-- License     :  GPL-3 (see the file LICENSE)
-- Maintainer  :  allele.dev@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-- This is the primary test suite.
-----------------------------------------------------------------------------
{-# OPTIONS_GHC -Wall #-}
module Main where

import Prelude (IO, ($))
import Control.Monad
import Control.Concurrent

import Test.Tasty.Hspec

import Network.Typed.Socket
import qualified Network.Socket as NS

serverAddr :: SockAddr 'InetV4
serverAddr = SockAddrInet 2291 (NS.tupleToHostAddress (127,0,0,1))

serverTest :: SSocket 'InetV4 'Tcp 'Listening 'Available -> IO ()
serverTest server = do
  (client, _) <- accept server
  bs <- recv 32 client
  n <- send bs client
  n `shouldBe` 4
  return ()

runServer :: SSocket 'InetV4 'Tcp 'Unconnected 'Available -> MVar () -> IO ()
runServer s serverWaitLock =
  makeAddrReusable s
    >>= bind serverAddr
    >>= listen 1
    >>= (\server -> putMVar serverWaitLock () >> serverTest server)

runClient :: SSocket 'InetV4 'Tcp 'Unconnected 'Available -> IO ()
runClient s = do
  client <- connect serverAddr s
  n <- send "fish" client
  bs <- recv 32 client
  n `shouldBe` 4
  bs `shouldBe` "fish"

main :: IO ()
main = hspec $ do

  describe "Network.Typed.Socket" $ do

    it "can open and close a tcp4 socket" $ do
      tcp4Socket
        >>= close
        >> return ()


    it "can open and close a tcp6 socket" $ do
      tcp6Socket
        >>= close
        >> return ()

    it "can open and close a udp4 socket" $ do
      udp4Socket
        >>= close
        >> return ()

    it "can open and close a udp6 socket" $ do
      udp6Socket
        >>= close
        >> return ()

    it "can echo server (TCP)" $ do
      withTcp4Socket $ \server -> do
        withTcp4Socket $ \client -> do
          serverWaitLock <- newEmptyMVar
          void (forkIO (runServer server serverWaitLock))
          void (takeMVar serverWaitLock)
          runClient client