{- Copyright 2011, John Billings <john@monkeynut.org>.
   All rights reserved.

   Redistribution and use in source and binary forms, with or without
   modification, are permitted provided that the following conditions are met:

    - Redistributions of source code must retain the above copyright notice,
      this list of conditions and the following disclaimer.

    - Redistributions in binary form must reproduce the above copyright notice,
      this list of conditions and the following disclaimer in the documentation
      and/or other materials provided with the distribution.

   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
   AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
   IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
   DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
   FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
   DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
   SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
   OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}

{-# LANGUAGE NamedFieldPuns, NoImplicitPrelude #-}

module Main where

import Prelude           hiding ( init )
import Test.HUnit        hiding ( State, Path )
import Control.Exception hiding ( assert )
import Control.Concurrent.MVar  ( newEmptyMVar, putMVar, takeMVar )
import System.Timeout           ( timeout )
import System.Directory         ( removeFile )
import Zookeeper.Core
import qualified Zookeeper.Utils as U


{-------------------------------------------------------------------------------
  Utilities
 -------------------------------------------------------------------------------}

timeoutS :: Int
timeoutS = 10

timeoutMs :: Int
timeoutMs = 1000 * timeoutS

timeoutUs :: Int
timeoutUs = 1000 * timeoutMs

-- FIXME Catch all exceptions
assertThrowsBadVersion :: IO a -> IO ()
assertThrowsBadVersion a = do
  v <- try a
  case v of
    Left BadVersion -> return ()
    Right _         -> assertFailure "yyy"

setup :: IO Handle
setup = do
  setLogLevel Error
  connected <- newEmptyMVar
  let f _ Session Connected _ = putMVar connected ()
      f _ e       s         p = print (e, s, p)
  h <- init "127.0.0.1:2181" (Just f) timeoutUs Nothing
  c <- timeout timeoutUs $ takeMVar connected
  c @?= Just ()  -- Make sure we didn't timeout
  return h

teardown :: Handle -> IO ()
teardown h = do
  U.deletePath h "/test"
  close h

withHandle :: (Handle -> IO ()) -> IO ()
withHandle = bracket setup teardown


{-------------------------------------------------------------------------------
  Tests
 -------------------------------------------------------------------------------}

watcher :: Handle -> Event -> State -> Path -> IO ()
watcher _ e s p = print (e, s, p)

nullWatcher :: Handle -> Event -> State -> Path -> IO ()
nullWatcher _ _ _ _ = return ()

testInitClose = "testInitp" ~:
  withHandle $ \_ -> return ()

testGetClientId = "testGetClientId" ~:
  withHandle $ \h -> do
  cid <- getClientId h
  assert $ clientId cid /= 0
  assert $ passwd   cid /= ""

testGetRecvTimeout = "testGetRecvTimeout" ~:
  withHandle $ \h -> do
  t <- getRecvTimeout h
  assert $ t >= timeoutMs

testAddAuth = "testAddAuth" ~:
  withHandle $ \h -> addAuth h "digest" ""

testIsUnrecoverable = "testIsUnrecoverable" ~:
  withHandle $ \h -> do
  r <- isUnrecoverable h
  assert $ not r

testSetDebugLevel = "testSetDebugLevel" ~:
  setLogLevel Error

-- TODO Check that log file is non-empty.
testSetLogFile = "testSetLogFile" ~: do
  setLogFile "log"
  withHandle (const $ setLogLevel Debug) `finally`
    (try $ removeFile "log" :: IO (Either IOError ()))

testSetDeterministicConnOrderTrue = "testSetDeterministicConnOrderTrue" ~:
  setDeterministicConnOrder True

testSetDeterministicConnOrderFalse = "testSetDeterministicConnOrderFalse" ~:
  setDeterministicConnOrder False

testCreate = "testCreate" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  return ()

testCreateEphemeral = "testCreateEphemeral" ~:
  let f = bracket setup close $
            \h -> create h "/test" "foo" [Ephemeral] openAclUnsafe
      g = withHandle $ \h -> do
          e <- exists h "/test" Nothing
          e @?= Nothing in
  finally (f >> g) $ withHandle $ flip U.deletePath "/test"

testCreateSequence = "testCreateSequence" ~:
  withHandle $ \h -> do
  _  <- create h "/test"   "foo" []         openAclUnsafe
  p0 <- create h "/test/c" "bar" [Sequence] openAclUnsafe
  p0 @?= "/test/c0000000000"
  p1 <- create h "/test/c" "bar" [Sequence] openAclUnsafe
  p1 @?= "/test/c0000000001"

testCreateEphemeralSequence = "testCreateEphemeralSequence" ~:
  let f = bracket setup close $ \h -> do
          _  <- create h "/test"   "foo" []                    openAclUnsafe
          p0 <- create h "/test/c" "bar" [Ephemeral, Sequence] openAclUnsafe
          p0 @?= "/test/c0000000000"
          p1 <- create h "/test/c" "bar" [Ephemeral, Sequence] openAclUnsafe
          p1 @?= "/test/c0000000001"
      g = withHandle $ \h -> do
          e0 <- exists h "/test/c0000000000" Nothing
          e0 @?= Nothing
          e1 <- exists h "/test/c0000000001" Nothing
          e1 @?= Nothing in
  finally (f >> g) $ withHandle $ flip U.deletePath "/test"

testDeleteUnversioned = "testDeleteUnversioned" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  delete h "/test" Nothing
  e <- exists h "/test" Nothing
  e @?= Nothing

testDeleteVersionedPass = "testDeleteVersionedPass" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  delete h "/test" $ Just 0

testDeleteVersionedFail = "testDeleteVersionedFail" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  assertThrowsBadVersion $ delete h "/test" $ Just 42

testExists = "testExists" ~:
  withHandle $ \h -> do
  e0 <- exists h "/test" Nothing
  e0 @?= Nothing
  _ <- create h "/test" "foo" [] openAclUnsafe
  e1 <- exists h "/test" Nothing
  case e1 of
    Nothing -> assert False
    Just s  ->
      assert $ and
        [ version     s == 0
        , cversion    s == 0
        , aversion    s == 0
        , dataLength  s == 3
        , numChildren s == 0
        ]

testExistsWatcherCreated = "testExistsWatcherCreated" ~:
  withHandle $ \h -> do
  state <- newEmptyMVar
  _     <- exists h "/test" $ Just $ \_ e s p -> putMVar state (e, s, p)
  _ <- create h "/test" "foo" [] openAclUnsafe
  s <- timeout timeoutUs $ takeMVar state
  s @?= Just (Created, Connected, "/test")

testExistsWatcherDeleted = "testExistsWatcherDeleted" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  state <- newEmptyMVar
  _     <- exists h "/test" $ Just $ \_ e s p -> putMVar state (e, s, p)
  delete h "/test" Nothing
  s <- timeout timeoutUs $ takeMVar state
  s @?= Just (Deleted, Connected, "/test")

testExistsWatcherChanged = "testExistsWatcherChanged" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  state <- newEmptyMVar
  _     <- exists h "/test" $ Just $ \_ e s p -> putMVar state (e, s, p)
  set h "/test" "bar" Nothing
  s <- timeout timeoutUs $ takeMVar state
  s @?= Just (Changed, Connected, "/test")

testGet = "testGet" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  (v, s) <- get h "/test" Nothing
  v @?= "foo"
  assert $ and
    [ version     s == 0
    , cversion    s == 0
    , aversion    s == 0
    , dataLength  s == 3
    , numChildren s == 0
    ]

testGetWatcherDeleted = "testGetWatcherDeleted" ~:
  withHandle $ \h -> do
  state <- newEmptyMVar
  _ <- create h "/test" "foo" [] openAclUnsafe
  _ <- get h "/test" $ Just $ \_ e s p -> putMVar state (e, s, p)
  delete h "/test" Nothing
  s <- timeout timeoutUs $ takeMVar state
  s @?= Just (Deleted, Connected, "/test")

testGetWatcherChanged = "testGetWatcherChanged" ~:
  withHandle $ \h -> do
  state <- newEmptyMVar
  _ <- create h "/test" "foo" [] openAclUnsafe
  _ <- get h "/test" $ Just $ \_ e s p -> putMVar state (e, s, p)
  set h "/test" "bar" Nothing
  s <- timeout timeoutUs $ takeMVar state
  s @?= Just (Changed, Connected, "/test")

testSetUnversioned = "testSetUnversioned" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "test" [] openAclUnsafe
  set h "/test" "foo" Nothing
  (v, s) <- get h "/test" Nothing
  v @?= "foo"
  assert $ and
    [ version     s == 1
    , cversion    s == 0
    , aversion    s == 0
    , dataLength  s == 3
    , numChildren s == 0
    ]

testSetVersionedPass = "testSetVersionedPass" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  _ <- set h "/test" "bar" $ Just 0
  return ()

testSetVersionedFail = "testSetVersionedFail" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  assertThrowsBadVersion $ set h "/test" "bar" $ Just 42

testSet2 = "testSet2" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  s       <- set2 h "/test" "bar" $ Just 0
  (v, s') <- get  h "/test" Nothing
  v @?= "bar"
  assert $ s == s'
  assert $ and
    [ version     s == 1
    , cversion    s == 0
    , aversion    s == 0
    , dataLength  s == 3
    , numChildren s == 0
    ]

testGetChildren = "testGetChildren" ~:
  withHandle $ \h -> do
  _ <- create h "/test"    "foo"  [] openAclUnsafe
  _ <- create h "/test/c0" "bar"  [] openAclUnsafe
  _ <- create h "/test/c1" "baz"  [] openAclUnsafe
  _ <- create h "/test/c2" "quux" [] openAclUnsafe
  cs <- getChildren h "/test" Nothing
  length cs @?= 3
  assert $ "c0" `elem` cs
  assert $ "c1" `elem` cs
  assert $ "c2" `elem` cs

testGetChildrenWatcherCreated = "testGetChildrenWatcherCreated" ~:
  withHandle $ \h -> do
  state <- newEmptyMVar
  _ <- create h "/test" "foo" [] openAclUnsafe
  _ <- getChildren h "/test" $ Just $ \_ e s p -> putMVar state (e, s, p)
  _ <- create h "/test/c0" "bar" [] openAclUnsafe
  s <- timeout timeoutUs $ takeMVar state
  s @?= Just (Child, Connected, "/test")

testGetChildrenWatcherDeleted = "testGetChildrenWatcherDeleted" ~:
  withHandle $ \h -> do
  state <- newEmptyMVar
  _ <- create h "/test"    "foo" [] openAclUnsafe
  _ <- create h "/test/c0" "bar" [] openAclUnsafe
  _ <- getChildren h "/test" $ Just $ \_ e s p -> putMVar state (e, s, p)
  delete h "/test/c0" Nothing
  s <- timeout timeoutUs $ takeMVar state
  s @?= Just (Child, Connected, "/test")

testGetChildren2 = "testGetChildren2" ~:
  withHandle $ \h -> do
  _ <- create h "/test"    "foo"  [] openAclUnsafe
  _ <- create h "/test/c0" "bar"  [] openAclUnsafe
  _ <- create h "/test/c1" "baz"  [] openAclUnsafe
  _ <- create h "/test/c2" "quux" [] openAclUnsafe
  (cs, stat) <- getChildren2 h "/test" Nothing
  length cs @?= 3
  assert $ "c0" `elem` cs
  assert $ "c1" `elem` cs
  assert $ "c2" `elem` cs
  assert $ and
    [ version     stat == 0
    , cversion    stat == 3
    , aversion    stat == 0
    , dataLength  stat == 3
    , numChildren stat == 3
    ]

testGetChildren2WatcherCreated = "testGetChildren2WatcherCreated" ~:
  withHandle $ \h -> do
  state <- newEmptyMVar
  _ <- create h "/test" "foo" [] openAclUnsafe
  _ <- getChildren2 h "/test" $ Just $ \_ e s p -> putMVar state (e, s, p)
  _ <- create h "/test/c0" "bar" [] openAclUnsafe
  s <- timeout timeoutUs $ takeMVar state
  s @?= Just (Child, Connected, "/test")

testGetChildren2WatcherDeleted = "testGetChildren2WatcherDeleted" ~:
  withHandle $ \h -> do
  state <- newEmptyMVar
  _ <- create h "/test"    "foo" [] openAclUnsafe
  _ <- create h "/test/c0" "bar" [] openAclUnsafe
  _ <- getChildren2 h "/test" $ Just $ \_ e s p -> putMVar state (e, s, p)
  delete h "/test/c0" Nothing
  s <- timeout timeoutUs $ takeMVar state
  s @?= Just (Child, Connected, "/test")

testGetAcl = "testGetAcl" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  (acls, stat) <- getAcl h "/test"
  assert $ acls == openAclUnsafe
  assert $ and
    [ version     stat == 0
    , cversion    stat == 0
    , aversion    stat == 0
    , dataLength  stat == 3
    , numChildren stat == 0
    ]

testSetAclUnversioned = "testSetAclUnversioned" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  setAcl h "/test" Nothing readAclUnsafe
  (acls, stat) <- getAcl h "/test"
  assert $ acls == readAclUnsafe
  assert $ and
    [ version     stat == 0
    , cversion    stat == 0
    , aversion    stat == 1
    , dataLength  stat == 3
    , numChildren stat == 0
    ]

testSetAclVersionedPass = "testSetAclVersionedPass" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  setAcl h "/test" (Just 0) readAclUnsafe

testSetAclVersionedFail = "testSetAclVersionedFail" ~:
  withHandle $ \h -> do
  _ <- create h "/test" "foo" [] openAclUnsafe
  assertThrowsBadVersion $ setAcl h "/test" (Just 42) readAclUnsafe

main :: IO ()
main = do
  let tests = [ testInitClose
              , testGetClientId
              , testGetRecvTimeout
              , testAddAuth
              , testIsUnrecoverable
              , testSetDebugLevel
              , testSetLogFile
              , testSetDeterministicConnOrderTrue
              , testSetDeterministicConnOrderFalse
              , testCreate
              , testCreateEphemeral
              , testCreateSequence
              , testCreateEphemeralSequence
              , testDeleteUnversioned
              , testDeleteVersionedPass
              , testDeleteVersionedFail
              , testExists
              , testExistsWatcherCreated
              , testExistsWatcherDeleted
              , testExistsWatcherChanged
              , testGet
              , testGetWatcherDeleted
              , testGetWatcherChanged
              , testSetUnversioned
              , testSetVersionedPass
              , testSetVersionedFail
              , testSet2
              , testGetChildren
              , testGetChildrenWatcherCreated
              , testGetChildrenWatcherDeleted
              , testGetChildren2
              , testGetChildren2WatcherCreated
              , testGetChildren2WatcherDeleted
              , testGetAcl
              , testSetAclUnversioned
              , testSetAclVersionedPass
              , testSetAclVersionedFail
              ]
  _ <- runTestTT $ TestList tests
  return ()
