{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
import Test.Hspec hiding (shouldReturn,shouldBe)
import Test.Hspec.Expectations.Lifted
import Test.QuickCheck
import Test.QuickCheck.Monadic (assert,monadicIO)
import Test.Sandbox
import qualified Test.Sandbox.Internals as I
import Text.Heredoc
import qualified Text.Mustache as H
import qualified Data.Text.Lazy as TL
import qualified Data.Text as T
import qualified Data.Map as M
import System.Posix.Files
import System.Exit (ExitCode(..))
import Data.IORef
import Data.Char
import Control.Concurrent
import Data.String.Conversions

import Network.Socket
import Network.Socket.ByteString (sendAll,recv)
import Network.Run.TCP
import System.IO
import Control.Monad
import Data.Aeson
import Data.Aeson.Types (Pair)


a2b :: String -> String
a2b [] = []
a2b ('a':xs) = 'b':xs
a2b (x:xs) = x:a2b xs

a2btest :: I.SandboxStateRef -> [Char] -> Property
a2btest ref str' = a2btest' ref $ filter isAlphaNum str'

a2btest' :: I.SandboxStateRef -> [Char] -> Property
a2btest' ref str' =
  monadicIO $ do
    v <- liftIO $ runSandbox' ref $ interactWith "sed_regex" (str' ++ "\n") 1
    assert $ v == ((a2b str') ++ "\n")

mainEcho :: IO ()
mainEcho = do
  let val = "hoge\n"
  runTCPServer Nothing "12181" (talk val)
  where
    talk val s = do
      sendAll s val
      msg <- recv s 1024
      sendAll s msg

main :: IO ()
main = withSandbox $ \gref -> do
  hspec $ do
    describe "Basic Test" $ do
      it "Run server like nc : port 12181" $ do
        runSandbox' gref $ do
          file <- setFile "ncfile1"
                  [str|{-# LANGUAGE OverloadedStrings #-}
                      |import qualified Data.ByteString as B
                      |import Network.Socket.ByteString
                      |import Network.Socket
                      |import Network.Run.TCP
                      |main = do
                      |  let val = "hoge\n"
                      |  runTCPServer Nothing "12181" (talk val)
                      |  where
                      |    talk val s = do
                      |      sendAll s val
                      |      msg <- recv s 1024
                      |      B.putStr msg
                      |]
          --liftIO $ setExecuteMode file
          start =<< register "ncserver1" "runghc" [file] def { psCapture = Just CaptureStdout }
      it "isBinable' 12181" $ do
        I.isBindable' 12181 `shouldReturn` False
      it "isBinable' 12180" $ do
        I.isBindable' 12180 `shouldReturn` True
      it "Test isBinable 12181" $ do
        I.isBindable 12181 `shouldReturn` False
      it "Test isBinable 12180" $ do
        I.isBindable 12180 `shouldReturn` True
      it "Test sendTo" $ do
        runSandbox' gref $ do
          p <- getPort "ncport"
          file <- setFile' "ncfile"
                  [("port",toJSON p)]
                  [str|{-# LANGUAGE OverloadedStrings #-}
                      |import qualified Data.ByteString as B
                      |import Network.Socket.ByteString
                      |import Network.Socket
                      |import Network.Run.TCP
                      |main = do
                      |  let val = "hoge\n"
                      |  runTCPServer Nothing "{{port}}" (talk val)
                      |  where
                      |    talk val s = do
                      |      sendAll s val
                      |      msg <- recv s 1024
                      |      B.putStr msg
                      |]
          liftIO $ I.isBindable p `shouldReturn` True
          -- liftIO $ setExecuteMode file
          start =<< register "ncserver" "runghc" [file] def { psCapture = Just CaptureStdout }
          liftIO $ I.isBindable p `shouldReturn` False
          sendTo "ncport" "hogehoge\n" 1 `shouldReturn` "hoge\n"
      it "interactive Test by sandbox" $ do
        sandbox "hogehoge" $ do
          start =<< register "sed_regex" "sed" [ "-u", "s/a/b/" ] def { psCapture = Just CaptureStdout }
          v <- interactWith "sed_regex" "a\n" 1
          liftIO $ v `shouldBe` "b\n"
      it "interactive Test by withSandbox" $ do
        withSandbox $ \ref -> do
          val <- runSandbox' ref $ do
            start =<< register "sed_regex" "sed" [ "-u", "s/a/b/" ] def { psCapture = Just CaptureStdout }
            interactWith "sed_regex" "a\n" 1
          val `shouldBe` "b\n"
      it "interactive Test : QuickCheck(setup)" $ do
        val <- runSandbox' gref $ do
          start =<< register "sed_regex" "sed" [ "-u", "s/a/b/" ] def { psCapture = Just CaptureStdout }
          interactWith "sed_regex" "a\n" 1
        val `shouldBe` "b\n"
--     ToDo: This test fails in local linux. 
--      it "interactive Test : QuickCheck(run)" $
--        property $ a2btest gref
      it "setFile" $ do
        withSandbox $ \ref -> do
          let content =
                  [str|#!/bin/env bash
                      |while true ; do echo hhh ; sleep 1;done
                      |]
          putStr content
          file <- runSandbox' ref $ setFile "str1" content
          readFile file `shouldReturn`  content
      it "set/getVariable" $ do
        withSandbox $ \ref -> do
          runSandbox' ref $ do
            v <- I.isVerbose
            liftIO $ v `shouldBe` True
            _ <- setVariable I.verbosityKey False
            v' <- I.isVerbose
            liftIO $ v' `shouldBe` False
          runSandbox' ref I.isVerbose `shouldReturn` False
          _ <- runSandbox' ref $ setVariable I.verbosityKey True
          runSandbox' ref I.isVerbose `shouldReturn` True
      it ": run" $ do
        withSandbox $ \ref -> runSandbox' ref $ do
          file <- setFile "echoecho"
                  [str|#!/usr/bin/env bash
                      |echo "echoecho"
                      |]
          liftIO $ setExecuteMode file

          pname1 <- register "echo1" file [] def
          (exitCode1, mStr1) <- run pname1 1
          liftIO $ exitCode1 `shouldBe` ExitSuccess
          liftIO $ mStr1 `shouldBe` Nothing

          pname2 <- register "echo2" file [] def { psCapture = Just CaptureStdout }
          (exitCode2, mStr2) <- run pname2 1
          liftIO $ exitCode2 `shouldBe` ExitSuccess
          liftIO $ mStr2 `shouldBe` Just "echoecho\n"

#if defined(__MACOSX__) ||  defined(__WIN32__)
#else
    describe "signal test" $ do
      it "send kill signal for process groups" $ do
        val <- newIORef $ error "do not eval this"
        withSandbox $ \ref -> runSandbox' ref $ do
          file <- setFile "str1"
                  [str|#!/usr/bin/env bash
                      |trap "echo catch signal" 1 2 3 15
                      |while true ; do echo hhh ; sleep 1;done
                      |]
          liftIO $ setExecuteMode file
          fil2 <- setFile' "str2"
                  [("file",toJSON file)]
                  [str|#!/usr/bin/env bash
                      |trap "echo catch signal" 1 2 3 15
                      |{{file}}&
                      |{{file}}&
                      |{{file}}&
                      |while true ; do echo hhh ; sleep 1;done
                      |]
          liftIO $ setExecuteMode fil2
          _ <- register "scr1" fil2 [] def
          startAll
          liftIO $ writeIORef val ref
          pids <- I.getAvailablePids
          liftIO $ threadDelay $ 1 * 1000 * 1000
          liftIO $ (length pids >= 4) `shouldBe` True
        ref' <- readIORef val
        let chkpid  :: IO Int
            chkpid = do
              threadDelay (5 * 1000 * 1000)
              pids <- runSandbox' ref' $ I.getAvailablePids
              return $ length pids
        chkpid `shouldReturn` 0

      it "send kill signal for process groups" $ do
        sandbox "test" $ do
          file <- setFile "str1"
                  [str|#!/usr/bin/env bash
                      |trap "echo catch signal" 1 2 3 15
                      |while true ; do echo hhh ; sleep 1;done
                      |]
          liftIO $ setExecuteMode file
          fil2 <- setFile' "str2"
                  [("file",toJSON file)]
                  [str|#!/usr/bin/env bash
                      |trap "echo catch signal" 1 2 3 15
                      |{{file}}&
                      |{{file}}&
                      |{{file}}&
                      |while true ; do echo hhh ; sleep 1;done
                      |]
          liftIO $ setExecuteMode fil2
          _ <- register "scr1" fil2 [] def
          startAll
          pids <- I.getAvailablePids
          liftIO $ (length pids >= 4) `shouldBe` True
      it "not send kill signal for process groups" $ do
        val <- newIORef $ error "do not eval this"
        withSandbox $ \ref -> runSandbox' ref $ do
          file <- setFile "str1"
                  [str|#!/usr/bin/env bash
                      |trap "echo catch signal" 1 2 3 15
                      |while true ; do echo hhh ; sleep 1;done
                      |]
          liftIO $ setExecuteMode file
          fil2 <- setFile' "str2"
                  [("file",toJSON file)]
                  [str|#!/usr/bin/env bash
                      |trap "echo catch signal" 1 2 3 15
                      |{{file}}&
                      |{{file}}&
                      |{{file}}&
                      |while true ; do echo hhh ; sleep 1;done
                      |]
          liftIO $ setExecuteMode fil2
          _ <- register "scr1" fil2 [] def
          startAll
          _ <- setVariable I.cleanUpKey False
          pids <- I.getAvailablePids
          liftIO $ writeIORef val ref
          liftIO $ do
            (length pids >= 4) `shouldBe` True
        ref' <- readIORef val
        pids <- runSandbox' ref' $ I.getAvailablePids
        (length pids > 0 ) `shouldBe` True
        pids' <- runSandbox' ref' $ do
          I.cleanUpProcesses
          I.getAvailablePids
        length pids' `shouldBe` 0
#endif

setFile' :: String
         -> [Pair]
         -> String
         -> Sandbox FilePath
setFile' filename keyValues template  = do
  str' <- case (H.compileMustacheText (H.PName (cs filename)) (cs template)) of 
    Left err -> fail $ show err
    Right template -> do
      return $ H.renderMustache template (object keyValues)
  setFile filename $ cs str'

setExecuteMode :: FilePath -> IO ()
setExecuteMode file = do
  stat <- getFileStatus file
  setFileMode file (fileMode stat `unionFileModes` ownerExecuteMode)