content: {-# LANGUAGE CPP #-}
  {-
  test client/server interaction
  -}
  import Test.HUnit
  import ProjectM36.Client
  import qualified ProjectM36.Client as C
  import ProjectM36.Server
  import ProjectM36.Server.Config
  import ProjectM36.Relation
  import ProjectM36.TupleSet
  import ProjectM36.IsomorphicSchema
  import ProjectM36.Base
  
  import System.Exit
  import Network.Socket (SockAddr(..))
  import Control.Concurrent
  import Data.Either (isRight)
  import Control.Exception
  import System.IO.Temp
  import System.FilePath
  import Control.Monad (void)
  #if defined(linux_HOST_OS)
  import System.Directory
  #endif
  
  type Timeout = Int
  
  testList :: SessionId -> Connection -> MVar () -> Test
  testList sessionId conn notificationTestMVar = TestList $ serverTests ++ sessionTests
    where
      sessionTests = map (\t -> t sessionId conn) [
        testRelationalExpr,
        testSchemaExpr,
        testTypeForRelationalExpr,  
        testDatabaseContextExpr,
        testGraphExpr,
        testPlanForDatabaseContextExpr,
        testTransactionGraphAsRelation,
        testHeadTransactionId,
        testHeadName,
        testSession,
        testRelationVariableSummary,
        testNotification notificationTestMVar
        ] 
      serverTests = [testRequestTimeout, testFileDescriptorCount, testClientConnectFail]
  
  main :: IO ()
  main = do
    (serverAddress, _) <- launchTestServer 0
    notificationTestMVar <- newEmptyMVar 
    eTestConn <- testConnection serverAddress notificationTestMVar
    case eTestConn of
      Left err -> print err >> exitFailure
      Right (session, testConn) -> do
        tcounts <- runTestTT (testList session testConn notificationTestMVar)
        if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
  
  {-main = do
      tcounts <- runTestTT (TestList [testRequestTimeout])
      if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess-}
                                                                       
  testDatabaseName :: DatabaseName
  testDatabaseName = "test"
  
  testConnection :: Port -> MVar () -> IO (Either ConnectionError (SessionId, Connection))
  testConnection serverPort mvar = do
    let connInfo = RemoteConnectionInfo testDatabaseName (RemoteServerHostAddress "127.0.0.1" serverPort) (testNotificationCallback mvar)
    --putStrLn ("testConnection: " ++ show serverAddress)
    eConn <- connectProjectM36 connInfo
    case eConn of 
      Left err -> pure $ Left err
      Right conn -> do
        eSessionId <- createSessionAtHead conn defaultHeadName
        case eSessionId of
          Left _ -> error "failed to create session"
          Right sessionId -> pure $ Right (sessionId, conn)
  
  -- | A version of 'launchServer' which returns the port on which the server is listening on a secondary thread
  launchTestServer :: Timeout -> IO (Port, ThreadId)
  launchTestServer ti = do
    addressMVar <- newEmptyMVar
    tid <- forkIO $ 
      withSystemTempDirectory "projectm36test" $ \tempdir -> do
        let config = defaultServerConfig { databaseName = testDatabaseName, 
                                           persistenceStrategy = CrashSafePersistence (tempdir </> "db"),
                                           perRequestTimeout = ti,
                                           testMode = True,
                                           bindAddress = RemoteServerHostAddress "127.0.0.1" 0,
                                           checkFS = False --not stricly needed for these tests
                                         }
      
        void $ launchServer config (Just addressMVar)
    (SockAddrInet port _) <- takeMVar addressMVar
    --liftIO $ putStrLn ("launched server on " ++ show endPointAddress)
    pure (fromIntegral port, tid)
    
  testRelationalExpr :: SessionId -> Connection -> Test  
  testRelationalExpr sessionId conn = TestCase $ do
    relResult <- executeRelationalExpr sessionId conn (RelationVariable "true" ())
    assertEqual "invalid relation result" (Right relationTrue) relResult
    
  eitherFail :: (Show e) => Either e a -> IO ()
  eitherFail (Left err) = assertFailure (show err)
  eitherFail (Right _) = pure ()
    
  -- test adding an removing a schema against true/false relations  
  testSchemaExpr :: SessionId -> Connection -> Test
  testSchemaExpr sessionId conn = TestCase $ do
    result <- executeSchemaExpr sessionId conn (AddSubschema "test-schema" [IsoRename "table_dee" "true", IsoRename "table_dum" "false"])
    assertEqual "executeSchemaExpr" (Right ()) result
    result' <- executeSchemaExpr sessionId conn (RemoveSubschema "test-schema")
    assertEqual "executeSchemaExpr2" (Right ()) result'  
    
  testDatabaseContextExpr :: SessionId -> Connection -> Test
  testDatabaseContextExpr sessionId conn = TestCase $ do 
    let attrExprs = [AttributeAndTypeNameExpr "x" (PrimitiveTypeConstructor "Text" TextAtomType) ()]
        attrs = attributesFromList [Attribute "x" TextAtomType]
        testrv = "testrv"
    executeDatabaseContextExpr sessionId conn (Define testrv attrExprs) >>= eitherFail
    eRel <- executeRelationalExpr sessionId conn (RelationVariable testrv ())
    let expected = mkRelation attrs emptyTupleSet
    case eRel of
      Left err -> assertFailure (show err)
      Right rel -> assertEqual "dbcontext definition failed" expected (Right rel)
          
  testGraphExpr :: SessionId -> Connection -> Test        
  testGraphExpr sessionId conn = TestCase (executeGraphExpr sessionId conn (JumpToHead "master") >>= eitherFail)
      
  testTypeForRelationalExpr :: SessionId -> Connection -> Test
  testTypeForRelationalExpr sessionId conn = TestCase $ do
    relResult <- typeForRelationalExpr sessionId conn (RelationVariable "true" ())
    case relResult of
      Left err -> assertFailure (show err)
      Right rel -> assertEqual "typeForRelationalExpr failure" relationFalse rel
      
  testPlanForDatabaseContextExpr :: SessionId -> Connection -> Test    
  testPlanForDatabaseContextExpr sessionId conn = TestCase $ do
    let attrExprs = [AttributeAndTypeNameExpr "x" (PrimitiveTypeConstructor "Int" IntAtomType) ()]
        testrv = "testrv"
        dbExpr = Define testrv attrExprs
        expected = Define testrv [AttributeAndTypeNameExpr "x" (PrimitiveTypeConstructor "Int" IntAtomType) UncommittedContextMarker]
    planResult <- planForDatabaseContextExpr sessionId conn dbExpr
    case planResult of
      Left err -> assertFailure (show err)
      Right plan -> assertEqual "planForDatabaseContextExpr failure" expected plan
          
  testTransactionGraphAsRelation :: SessionId -> Connection -> Test    
  testTransactionGraphAsRelation sessionId conn = TestCase $ do
    eGraph <- transactionGraphAsRelation sessionId conn
    case eGraph of
      Left err -> assertFailure (show err)
      Right _ -> pure ()
      
  testHeadTransactionId :: SessionId -> Connection -> Test    
  testHeadTransactionId sessionId conn = TestCase $ do
    uuid <- headTransactionId sessionId conn
    assertBool "invalid head transaction uuid" (isRight uuid)
    pure ()
    
  testHeadName :: SessionId -> Connection -> Test
  testHeadName sessionId conn = TestCase $ do
    eHeadName <- headName sessionId conn
    assertEqual "headName failure" (Right "master") eHeadName
    
  testRelationVariableSummary :: SessionId -> Connection -> Test  
  testRelationVariableSummary sessionId conn = TestCase $ do
    eRel <- C.relationVariablesAsRelation sessionId conn
    case eRel of 
      Left err -> assertFailure ("relvar summary failed " ++ show err)
      Right rel -> assertBool "invalid tuple count in relvar summary" (cardinality rel == Finite 2)
    
  testSession :: SessionId -> Connection -> Test
  testSession _ conn = TestCase $ do
    -- create and close a new session using AtHead and AtCommit
    eSessionId1 <- createSessionAtHead conn defaultHeadName
    case eSessionId1 of
      Left _ -> assertFailure "invalid session" 
      Right sessionId1 -> do
        eHeadId <- headTransactionId sessionId1 conn
        case eHeadId of
          Left err -> assertFailure ("invalid head id: " ++ show err)
          Right headId -> do
            eSessionId2 <- createSessionAtCommit conn headId
            assertBool ("invalid session: " ++ show eSessionId2) (isRight eSessionId2)
            closeSession sessionId1 conn
  
  testNotificationCallback :: MVar () -> NotificationCallback
  testNotificationCallback mvar _ _ = putMVar mvar ()
  
  -- create a relvar x, add a notification on x, update x and wait for the notification
  testNotification :: MVar () -> SessionId -> Connection -> Test
  testNotification mvar sess conn = TestCase $ do
    let relvarx = RelationVariable "x" ()
    executeDatabaseContextExpr sess conn (Assign "x" (ExistingRelation relationTrue)) >>= eitherFail
    executeDatabaseContextExpr sess conn (AddNotification "test notification" relvarx relvarx relvarx) >>= eitherFail
    commit sess conn >>= eitherFail
    executeDatabaseContextExpr sess conn (Assign "x" (ExistingRelation relationFalse)) >>= eitherFail
    commit sess conn >>= eitherFail
    takeMVar mvar
  
  testRequestTimeout :: Test
  testRequestTimeout = TestCase $ do
    (serverAddress, serverTid) <- launchTestServer 1000
    unusedMVar <- newEmptyMVar       
    eTestConn <- testConnection serverAddress unusedMVar  
    --eTestConn <- testConnection (encodeEndPointAddress "127.0.0.1" "10000" 1) unusedMVar
    case eTestConn of
      Left err -> putStrLn ("failed to connect: " ++ show err) >> exitFailure
      Right (session, testConn) -> do
        res <- catchJust (\exc -> if exc == RequestTimeoutException then Just exc else Nothing) (callTestTimeout_ session testConn) (const (pure False))
        assertBool "timeout exception was not thrown" (not res)
        killThread serverTid
        
  testFileDescriptorCount :: Test
  #if defined(linux_HOST_OS)
  --validate that creating a server, connecting a client, and then disconnecting doesn't leak file descriptors
  testFileDescriptorCount = TestCase $ do
    (serverAddress, serverTid) <- launchTestServer 0
    unusedMVar <- newEmptyMVar
    startCount <- fdCount  
    Right (sess, testConn) <- testConnection serverAddress unusedMVar
    --add a test commit to trigger the fsync machinery
    executeDatabaseContextExpr sess testConn (Assign "x" (ExistingRelation relationFalse)) >>= eitherFail
    commit sess testConn >>= eitherFail
    close testConn
    endCount <- fdCount
    let fd_diff = endCount - startCount
    assertBool ("fd leak: " ++ show fd_diff) (fd_diff <= 0)
    killThread serverTid
  
    
  -- returns the number of open file descriptors -- linux only /proc usage
  fdCount :: IO Int
  fdCount = do
    fds <- getDirectoryContents "/proc/self/fd"
    pure (length fds)
  #else 
  --pass on non-linux platforms
  testFileDescriptorCount = TestCase (pure ())
  #endif
  
  testClientConnectFail :: Test
  testClientConnectFail = TestCase $ do
    let connInfo = RemoteConnectionInfo "nonexistentdb" (RemoteServerHostAddress "127.0.0.1" 7777) emptyNotificationCallback
    eConn <- connectProjectM36 connInfo
    case eConn of
      Left (IOExceptionError _) -> pure ()
      _ -> assertFailure "connection failure failed"
  