content: {-# LANGUAGE OverloadedStrings #-}
  
  module Network.Socket.ByteStringSpec (main, spec) where
  
  import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
  import Data.Bits
  import Data.Maybe
  import Control.Monad
  import qualified Data.ByteString as S
  import qualified Data.ByteString.Char8 as C
  import Network.Socket
  import Network.Socket.ByteString
  import Network.Test.Common
  
  import System.Environment
  
  import Test.Hspec
  
  main :: IO ()
  main = hspec spec
  
  spec :: Spec
  spec = do
      describe "send" $ do
          it "works well" $ do
              let server sock = recv sock 1024 `shouldReturn` testMsg
                  client sock = send sock testMsg
              tcpTest client server
  
          it "throws when closed" $ do
              let server _ = return ()
                  client sock = do
                      close sock
                      send sock testMsg `shouldThrow` anyException
              tcpTest client server
  
          it "checks -1 correctly on Windows" $ do
              sock <- socket AF_INET Stream defaultProtocol
              send sock "hello world" `shouldThrow` anyException
  
      describe "sendAll" $ do
          it "works well" $ do
              let server sock = recv sock 1024 `shouldReturn` testMsg
                  client sock = sendAll sock testMsg
              tcpTest client server
  
          it "throws when closed" $ do
              let server _ = return ()
                  client sock = do
                      close sock
                      sendAll sock testMsg `shouldThrow` anyException
              tcpTest client server
  
      describe "sendTo" $ do
          it "works well" $ do
              let server sock = recv sock 1024 `shouldReturn` testMsg
                  client sock addr = sendTo sock testMsg addr
              udpTest client server
  
          it "throws when closed" $ do
              let server _ = return ()
                  client sock addr = do
                      close sock
                      sendTo sock testMsg addr `shouldThrow` anyException
              udpTest client server
  
      describe "sendAllTo" $ do
          it "works well" $ do
              let server sock = recv sock 1024 `shouldReturn` testMsg
                  client sock addr = sendAllTo sock testMsg addr
              udpTest client server
  
          it "throws when closed" $ do
              let server _ = return ()
                  client sock addr = do
                      close sock
                      sendAllTo sock testMsg addr `shouldThrow` anyException
              udpTest client server
  
      describe "sendMany" $ do
          it "works well" $ do
              let server sock = recv sock 1024 `shouldReturn` S.append seg1 seg2
                  client sock = sendMany sock [seg1, seg2]
  
                  seg1 = C.pack "This is a "
                  seg2 = C.pack "test message."
              tcpTest client server
  
          it "throws when closed" $ do
              let server _ = return ()
                  client sock = do
                      close sock
                      sendMany sock [seg1, seg2] `shouldThrow` anyException
  
                  seg1 = C.pack "This is a "
                  seg2 = C.pack "test message."
              tcpTest client server
  
      describe "sendManyTo" $ do
          it "works well" $ do
              let server sock = recv sock 1024 `shouldReturn` S.append seg1 seg2
                  client sock addr = sendManyTo sock [seg1, seg2] addr
  
                  seg1 = C.pack "This is a "
                  seg2 = C.pack "test message."
              udpTest client server
  
          it "throws when closed" $ do
              let server _ = return ()
                  client sock addr = do
                      close sock
                      sendManyTo sock [seg1, seg2] addr `shouldThrow` anyException
  
                  seg1 = C.pack "This is a "
                  seg2 = C.pack "test message."
              udpTest client server
  
      describe "recv" $ do
          it "works well" $ do
              let server sock = recv sock 1024 `shouldReturn` testMsg
                  client sock = send sock testMsg
              tcpTest client server
  
          it "throws when closed" $ do
              let server sock = do
                      close sock
                      recv sock 1024 `shouldThrow` anyException
                  client sock = send sock testMsg
              tcpTest client server
  
          it "can treat overflow" $ do
              let server sock = do
                      seg1 <- recv sock (S.length testMsg - 3)
                      seg2 <- recv sock 1024
                      let msg = S.append seg1 seg2
                      msg `shouldBe` testMsg
                  client sock = send sock testMsg
              tcpTest client server
  
          it "returns empty string at EOF" $ do
              let client s = recv s 4096 `shouldReturn` S.empty
                  server s = shutdown s ShutdownSend
              tcpTest client server
  
          it "checks -1 correctly on Windows" $ do
              sock <- socket AF_INET Stream defaultProtocol
              recv sock 1024 `shouldThrow` anyException
  
      describe "recvFrom" $ do
          it "works well" $ do
              let server sock = do
                      (msg, _) <- recvFrom sock 1024
                      testMsg `shouldBe` msg
                  client sock = do
                      addr <- getPeerName sock
                      sendTo sock testMsg addr
              tcpTest client server
  
          it "throws when closed" $ do
              let server sock = do
                      close sock
                      recvFrom sock 1024 `shouldThrow` anyException
                  client sock = do
                      addr <- getPeerName sock
                      sendTo sock testMsg addr
              tcpTest client server
  
          it "can treat overflow" $ do
              let server sock = do
                      (seg1, _) <- recvFrom sock (S.length testMsg - 3)
                      (seg2, _) <- recvFrom sock 1024
                      let msg = S.append seg1 seg2
                      testMsg `shouldBe` msg
                  client sock = send sock testMsg
              tcpTest client server
  
          it "returns empty string at EOF" $ do
              let server sock = do
                      (seg1, _) <- recvFrom sock (S.length testMsg - 3)
                      seg1 `shouldBe` S.empty
                  client sock = shutdown sock ShutdownSend
              tcpTest client server
  
      describe "sendMsg" $ do
          it "works well" $ do
              let server sock = recv sock 1024 `shouldReturn` S.append seg1 seg2
                  client sock addr = sendMsg sock addr [seg1, seg2] [] mempty
  
                  seg1 = C.pack "This is a "
                  seg2 = C.pack "test message."
              udpTest client server
  
          it "throws when closed" $ do
              let server _ = return ()
                  client sock addr = do
                      close sock
                      sendMsg sock addr [seg1, seg2] [] mempty `shouldThrow` anyException
  
                  seg1 = C.pack "This is a "
                  seg2 = C.pack "test message."
              udpTest client server
  
      describe "recvMsg" $ do
          it "works well" $ do
              let server sock = do
                      (_, msg, cmsgs, flags) <- recvMsg sock 1024 0 mempty
                      msg `shouldBe` seg
                      cmsgs `shouldBe` []
                      flags `shouldBe` mempty
                  client sock addr = sendTo sock seg addr
  
                  seg = C.pack "This is a test message"
              udpTest client server
  
          it "receives truncated flag" $ do
              let server sock = do
                      (_, _, _, flags) <- recvMsg sock (S.length seg - 2) 0 mempty
                      flags .&. MSG_TRUNC `shouldBe` MSG_TRUNC
                  client sock addr = sendTo sock seg addr
  
                  seg = C.pack "This is a test message"
              udpTest client server
  
          it "peek" $ do
              let server sock = do
                      (_, msgs, _, _flags) <- recvMsg sock 1024 0 MSG_PEEK
                      -- flags .&. MSG_PEEK `shouldBe` MSG_PEEK -- Mac only
                      (_, msgs', _, _) <- recvMsg sock 1024 0 mempty
                      msgs `shouldBe` msgs'
                  client sock addr = sendTo sock seg addr
  
                  seg = C.pack "This is a test message"
              udpTest client server
  
          it "receives control messages for IPv4" $ do
              -- This test behaves strange on AppVeyor and I don't know why so skip
              -- TOS for now.
              isAppVeyor <- isJust <$> lookupEnv "APPVEYOR"
  
              -- Avoid race condition between the client sending the message and
              -- the server finishing its socket configuration.  Otherwise the
              -- message may be received with default socket options!
              serverReady <- newEmptyMVar
  
              let server sock = do
                      whenSupported RecvIPv4TTL     $ setSocketOption sock RecvIPv4TTL 1
                      whenSupported RecvIPv4PktInfo $ setSocketOption sock RecvIPv4PktInfo 1
                      whenSupported RecvIPv4TOS     $ setSocketOption sock RecvIPv4TOS 1
                      putMVar serverReady ()
  
                      (_, _, cmsgs, _) <- recvMsg sock 1024 128 mempty
  
                      whenSupported RecvIPv4PktInfo $
                        ((lookupCmsg CmsgIdIPv4PktInfo cmsgs >>= decodeCmsg) :: Maybe IPv4PktInfo) `shouldNotBe` Nothing
                      when (not isAppVeyor) $ do
                        whenSupported RecvIPv4TTL $
                          ((lookupCmsg CmsgIdIPv4TTL cmsgs >>= decodeCmsg) :: Maybe IPv4TTL) `shouldNotBe` Nothing
                        whenSupported RecvIPv4TOS $
                          ((lookupCmsg CmsgIdIPv4TOS cmsgs >>= decodeCmsg) :: Maybe IPv4TOS) `shouldNotBe` Nothing
                  client sock addr = takeMVar serverReady >> sendTo sock seg addr
  
                  seg = C.pack "This is a test message"
              udpTest client server
  
          it "receives control messages for IPv6" $ do
              -- Avoid race condition between the client sending the message and
              -- the server finishing its socket configuration.  Otherwise the
              -- message may be received with default socket options!
              serverReady <- newEmptyMVar
  
              let server sock = do
                      whenSupported RecvIPv6HopLimit $ setSocketOption sock RecvIPv6HopLimit 1
                      whenSupported RecvIPv6TClass   $ setSocketOption sock RecvIPv6TClass 1
                      whenSupported RecvIPv6PktInfo  $ setSocketOption sock RecvIPv6PktInfo 1
                      putMVar serverReady ()
  
                      (_, _, cmsgs, _) <- recvMsg sock 1024 128 mempty
  
                      whenSupported RecvIPv6HopLimit $
                        ((lookupCmsg CmsgIdIPv6HopLimit cmsgs >>= decodeCmsg) :: Maybe IPv6HopLimit) `shouldNotBe` Nothing
                      whenSupported RecvIPv6TClass $
                        ((lookupCmsg CmsgIdIPv6TClass cmsgs >>= decodeCmsg) :: Maybe IPv6TClass) `shouldNotBe` Nothing
                      whenSupported RecvIPv6PktInfo $
                        ((lookupCmsg CmsgIdIPv6PktInfo cmsgs >>= decodeCmsg) :: Maybe IPv6PktInfo) `shouldNotBe` Nothing
                  client sock addr = takeMVar serverReady >> sendTo sock seg addr
  
                  seg = C.pack "This is a test message"
              udpTest6 client server
  
          it "receives truncated control messages" $ do
              -- Avoid race condition between the client sending the message and
              -- the server finishing its socket configuration.  Otherwise the
              -- message may be received with default socket options!
              serverReady <- newEmptyMVar
  
              let server sock = do
                      whenSupported RecvIPv4TTL     $ setSocketOption sock RecvIPv4TTL 1
                      whenSupported RecvIPv4TOS     $ setSocketOption sock RecvIPv4TOS 1
                      whenSupported RecvIPv4PktInfo $ setSocketOption sock RecvIPv4PktInfo 1
                      putMVar serverReady ()
  
                      (_, _, _, flags) <- recvMsg sock 1024 10 mempty
                      flags .&. MSG_CTRUNC `shouldBe` MSG_CTRUNC
  
                  client sock addr = takeMVar serverReady >> sendTo sock seg addr
  
                  seg = C.pack "This is a test message"
              udpTest client server
  