content: {-# LANGUAGE OverloadedStrings   #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  module TCPStreams (tests) where
  
  ------------------------------------------------------------------------------
  import           Control.Concurrent             (forkIO, newEmptyMVar, putMVar,
                                                   takeMVar)
  import qualified Network.Socket                 as N
  import           System.Timeout                 (timeout)
  import           Test.Tasty
  import           Test.Tasty.HUnit
  import qualified Data.ByteString                as B
  import qualified Data.ByteString.Lazy           as L
  ------------------------------------------------------------------------------
  import qualified Data.TLSSetting                as TLS
  import           Data.Connection
  import qualified System.IO.Streams              as Stream
  import qualified System.IO.Streams.TCP          as TCP
  import qualified System.IO.Streams.TLS          as TLS
  ------------------------------------------------------------------------------
  
  import Test.Tasty.ExpectedFailure (ignoreTestBecause)
  
  tests :: TestTree
  tests = testGroup "tests" [ testGroup "TCP" tcpTests
          , testGroup "TLS"  tlsTests
          , testGroup "HTTPS" [testHTTPS]
          ]
  
  ------------------------------------------------------------------------------
  
  tcpTests :: [TestTree]
  tcpTests = [ testTCPSocket ]
  
  testTCPSocket :: TestTree
  testTCPSocket = testCase "network/socket" $
      N.withSocketsDo $ do
      x <- timeout (10 * 10^(6::Int)) go
      assertEqual "ok" (Just ()) x
  
    where
      go = do
          portMVar   <- newEmptyMVar
          resultMVar <- newEmptyMVar
          _ <- forkIO $ client portMVar resultMVar
          server portMVar
          l <- takeMVar resultMVar
          assertEqual "testSocket" l ["ok"]
  
      client mvar resultMVar = do
          _ <- takeMVar mvar
          conn <- TCP.connect "127.0.0.1" 8888
          send conn "ok"
          Stream.toList (source conn) >>= putMVar resultMVar
          close conn
  
      server mvar = do
          sock <- TCP.bindAndListen 1024 8888
          putMVar mvar ()
          conn <- TCP.accept sock
          req <- Stream.readExactly 2 (source conn)
          send conn (L.fromStrict req)
          close conn
  
  ------------------------------------------------------------------------------
  
  tlsTests :: [TestTree]
  tlsTests = [ testTLSSocket
               -- TODO disabled because won't work in a  nix container
               -- , testHTTPS
             ]
  
  testTLSSocket :: TestTree
  testTLSSocket = testCase "network/socket" $
      N.withSocketsDo $ do
      x <- timeout (10 * 10^(6::Int)) go
      assertEqual "ok" (Just ()) x
  
    where
      go = do
          portMVar   <- newEmptyMVar
          resultMVar <- newEmptyMVar
          _ <- forkIO $ client portMVar resultMVar
          server portMVar
          l <- takeMVar resultMVar
          assertEqual "testSocket" l ["ok"]
  
      client mvar resultMVar = do
          _ <- takeMVar mvar
          cp <- TLS.makeClientParams (TLS.CustomCAStore "./test/cert/ca.pem")
          conn <- TLS.connect cp (Just "Winter") "127.0.0.1" 8889
          send conn "ok"
          Stream.toList (source conn) >>= putMVar resultMVar
          close conn
  
      server mvar = do
          sp <- TLS.makeServerParams "./test/cert/server-cert.pem" [] "./test/cert/server-key.pem"
          sock <- TCP.bindAndListen 1024 8889
          putMVar mvar ()
          conn <- TLS.accept sp sock
          req <- Stream.readExactly 2 (source conn)
          send conn (L.fromStrict req)
          close conn
  
  testHTTPS :: TestTree
  testHTTPS =
    ignoreTestBecause "can't connect to socket in a nix container, the build becomes no longer reproducible." $
    testCase "network/https" $
      N.withSocketsDo $ do
      x <- timeout (10 * 10^(6::Int)) go
      assertEqual "ok" (Just 1024) x
    where
      go = do
          cp <- TLS.makeClientParams TLS.MozillaCAStore
          conn <- TLS.connect cp Nothing "www.bing.com" 443
          send conn ("GET / HTTP/1.1\r\n")
          send conn ("Host: www.bing.com\r\n")
          send conn ("\r\n")
          bs <- Stream.readExactly 1024 (source conn)
          close conn
          return (B.length bs)
  