{-# LANGUAGE OverloadedStrings #-}
module Main where

------------------------------------------------------------------------------
import           Control.Concurrent
import           Data.ByteString.Char8          ()
import qualified Network.Socket                 as N
import qualified OpenSSL                        as SSL
import qualified OpenSSL.Session                as SSL
import qualified System.IO.Streams              as Streams
import qualified System.IO.Streams.SSL          as SSLStreams
import           System.Timeout                 (timeout)
import           Test.Framework
import           Test.Framework.Providers.HUnit
import           Test.HUnit                     hiding (Test)
------------------------------------------------------------------------------


main :: IO ()
main = defaultMain [sanityCheck]


------------------------------------------------------------------------------
sanityCheck :: Test
sanityCheck = testCase "sanitycheck" $ N.withSocketsDo $
              SSL.withOpenSSL $ do
    ctx1 <- setupContext
    ctx2 <- setupContext
    x <- timeout (10 * 10^(6::Int)) $ go ctx1 ctx2
    assertEqual "ok" (Just ()) x

  where
    setupContext = do
        ctx <- SSL.context
        SSL.contextSetDefaultCiphers ctx
        SSL.contextSetCertificateFile ctx "test/cert.pem"
        SSL.contextSetPrivateKeyFile ctx "test/key.pem"
        SSL.contextSetVerificationMode ctx SSL.VerifyNone

        certOK <- SSL.contextCheckPrivateKey ctx
        assertBool "private key is bad" certOK
        return ctx

    go ctx1 ctx2 = do
        portMVar   <- newEmptyMVar
        resultMVar <- newEmptyMVar
        forkIO $ client ctx1 portMVar resultMVar
        server ctx2 portMVar
        l <- takeMVar resultMVar
        assertEqual "testSocket" l ["ok"]

    client ctx mvar resultMVar = do
        port <- takeMVar mvar
        (is, os, ssl) <- SSLStreams.connect ctx "127.0.0.1" port
        Streams.fromList ["ok"] >>= Streams.connectTo os
        SSL.shutdown ssl SSL.Unidirectional
        Streams.toList is >>= putMVar resultMVar
        maybe (return ()) N.sClose $ SSL.sslSocket ssl

    server ctx mvar = do
        sock  <- N.socket N.AF_INET N.Stream N.defaultProtocol
        addr  <- N.inet_addr "127.0.0.1"
        let saddr = N.SockAddrInet N.aNY_PORT addr
        N.bind sock saddr
        N.listen sock 5
        port  <- N.socketPort sock
        putMVar mvar port
        (csock, _) <- N.accept sock
        ssl <- SSL.connection ctx csock
        SSL.accept ssl
        (is, os) <- SSLStreams.sslToStreams ssl
        Streams.toList is >>= flip Streams.writeList os
        SSL.shutdown ssl SSL.Unidirectional
        maybe (return ()) N.close $ SSL.sslSocket ssl
        N.close sock