{-# LANGUAGE
    CPP
  , UnicodeSyntax
  #-}
import           Control.Exception
import           Control.Monad
import           Data.List
import           Data.Maybe
import Network.Socket
import           Network.HTTP.Lucu
import OpenSSL
import           Rakka.Environment
import           Rakka.Resource.CheckAuth
import           Rakka.Resource.DumpRepos
import           Rakka.Resource.Index
import           Rakka.Resource.JavaScript
import           Rakka.Resource.PageEntity
import           Rakka.Resource.Object
import           Rakka.Resource.Render
import           Rakka.Resource.Search
import           Rakka.Resource.SystemConfig
import           Rakka.Resource.Users
import           Rakka.Storage
import           Subversion
import           System.Console.GetOpt -- FIXME: Use better library than this.
import           System.Directory
import           System.Environment
import           System.Exit
import           System.FilePath
import           System.IO
import           System.Log.Handler.Simple
import           System.Log.Logger
import           System.Posix.Files
import           System.Posix.IO
import           System.Posix.Process
import           System.Posix.Types
import           System.Posix.User


logger :: String
logger = "Main"


data CmdOpt
    = OptPortNum   ServiceName
    | OptLSDir     FilePath
    | OptUserName  String
    | OptGroupName String
    | OptLogLevel  Priority
    | OptVerbose
    | OptRebuildIndex
    | OptHelp
    deriving (Eq, Show)


defaultPort ∷ ServiceName
defaultPort = "8080"

defaultLocalStateDir :: FilePath
defaultLocalStateDir = LOCALSTATEDIR -- replaced by CPP

defaultUserName :: String
defaultUserName = "daemon"

defaultGroupName :: String
defaultGroupName = "daemon"


defaultLogLevel :: Priority
defaultLogLevel = NOTICE


options :: [OptDescr CmdOpt]
options = [ Option ['p'] ["port"]
                   (ReqArg OptPortNum "NUM")
                   ("Port number to listen. (default: " ++ defaultPort ++ ")")

          , Option ['d'] ["localstatedir"]
                   (ReqArg OptLSDir "DIR")
                   ("Path to the database directory. (default: " ++ defaultLocalStateDir ++ ")")

          , Option ['u'] ["user"]
                   (ReqArg OptUserName "USER")
                   ("Which user to setuid. (default: " ++ defaultUserName ++ ")")

          , Option ['g'] ["group"]
                   (ReqArg OptGroupName "GROUP")
                   ("Which user to setgid. (default: " ++ defaultGroupName ++ ")")

          , Option ['l'] ["log-level"]
                   (ReqArg (OptLogLevel . read) "LEVEL")
                   ("The lowest log level to show. (default: " ++ show defaultLogLevel ++ ")")

          , Option ['v'] ["verbose"]
                   (NoArg OptVerbose)
                   "Enable logging to stderr."

          , Option ['r'] ["rebuild-index"]
                   (NoArg OptRebuildIndex)
                   "Rebuild the index database. (Only for debug purposes)"

          , Option ['h'] ["help"]
                   (NoArg OptHelp)
                   "Print this message."
          ]


printUsage :: IO ()
printUsage = do putStrLn "Usage:"
                putStrLn "  rakka [OPTIONS...]"
                putStrLn ""
                putStr $ usageInfo "Options:" options


main :: IO ()
main = withOpenSSL $
       withSubversion $
       do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs

          unless (null errors)
                   $ do mapM_ putStr errors
                        exitWith $ ExitFailure 1

          when (any (\ x -> x == OptHelp) opts)
                   $ do printUsage
                        exitWith ExitSuccess

          unless (null nonOpts)
                   $ do printUsage
                        exitWith $ ExitFailure 1

          portNum <- getPortNum opts
          uid     <- getUserID  opts
          gid     <- getGroupID opts
          lsdir   <- getLocalStateDir opts

          -- Create our localstatedir *before* dropping privileges.
          createLocalStateDir lsdir uid gid

          setGroupID gid
          setUserID  uid

          -- Now that we have our localstatedir. Let's acquire a lock
          -- on the lockfile. Then create other files.
          withSystemLock (lsdir </> "lock") $
            withPidFile (lsdir </> "pid") $
              do setupLogger opts
                 env ← setupEnv lsdir portNum

                 rebuildIndexIfRequested env opts

                 infoM logger ("Listening to " ++ show portNum ++ "/tcp...")
                 runHttpd (envLucuConf env) (resTree env) [fallbackPageEntity env]

          
resTree :: Environment -> ResTree
resTree env
    = mkResTree [ ([]              , resIndex        env)
                , (["checkAuth"   ], resCheckAuth    env)
                , (["dumpRepos"   ], resDumpRepos    env)
                , (["js"          ], javaScript         )
                , (["object"      ], resObject       env)
                , (["render"      ], resRender       env)
                , (["search"      ], resSearch       env)
                , (["search.html" ], resSearch       env)
                , (["search.xml"  ], resSearch       env)
                , (["systemConfig"], resSystemConfig env)
		, (["users"       ], resUsers        env)
                ]

getPortNum ∷ [CmdOpt] → IO ServiceName
getPortNum opts
    = do let xs = mapMaybe (\x → case x of
                                   OptPortNum n → Just n
                                   _            → Nothing) opts
         case xs of
           []     → return defaultPort
           (x:[]) → return x
           _      → error "too many --port options."

getUserID :: [CmdOpt] -> IO UserID
getUserID opts
    = do let xs   = mapMaybe (\ x -> case x of
                                       OptUserName n -> Just n
                                       _             -> Nothing) opts
             name = case xs of
                      []     -> defaultUserName
                      (x:[]) -> x
                      _      -> error "too many --user options."

         userEnt <- getUserEntryForName name
         return $ userID userEnt


getGroupID :: [CmdOpt] -> IO GroupID
getGroupID opts
    = do let xs   = mapMaybe (\ x -> case x of
                                       OptGroupName n -> Just n
                                       _              -> Nothing) opts
             name = case xs of
                      []     -> defaultGroupName
                      (x:[]) -> x
                      _      -> error "too many --group options."

         groupEnt <- getGroupEntryForName name
         return $ groupID groupEnt


getLocalStateDir :: [CmdOpt] -> IO FilePath
getLocalStateDir opts
    = do let xs   = mapMaybe (\ x -> case x of
                                       OptLSDir n -> Just n
                                       _          -> Nothing) opts
             path = case xs of
                      []     -> defaultLocalStateDir
                      (x:[]) -> x
                      _      -> error "too many --localstatedir options."
         
         return path


setupLogger :: [CmdOpt] -> IO ()
setupLogger opts
    = do let verbose     = find (== OptVerbose) opts /= Nothing
             logHandlers = if verbose then
                               [verboseStreamHandler stderr DEBUG]
                           else
                               [] -- FIXME: enable file log
             logLevel    = fromMaybe defaultLogLevel
                           $ do OptLogLevel l <- find (\ x -> case x of
                                                                OptLogLevel _ -> True
                                                                _             -> False) opts
                                return l

         logHandlers' <- sequence logHandlers
         updateGlobalLogger rootLoggerName (setHandlers logHandlers' . setLevel logLevel)


createLocalStateDir :: FilePath -> UserID -> GroupID -> IO ()
createLocalStateDir path uid gid
    = do createDirectoryIfMissing True path
         setOwnerAndGroup path uid gid


rebuildIndexIfRequested :: Environment -> [CmdOpt] -> IO ()
rebuildIndexIfRequested env opts
    = do let rebuild = isJust $ find (\ x -> case x of
                                               OptRebuildIndex -> True
                                               _               -> False) opts
         when rebuild
                  $ rebuildIndex (envStorage env)

withSystemLock :: FilePath -> IO a -> IO a
withSystemLock lockfile = bracket lock' unlock' . const
    where
      lock' :: IO Fd
      lock' = do fd <- openFd
                       lockfile
                       ReadWrite
                       (Just 420) -- 0644, -rw-r--r--
                       defaultFileFlags
                 setLock fd (WriteLock, AbsoluteSeek, 0, 0)
                 return fd

      unlock' :: Fd -> IO ()
      unlock' = closeFd

withPidFile :: FilePath -> IO a -> IO a
withPidFile lockfile = bracket_ mkPid' delPid'
    where
      mkPid' :: IO ()
      mkPid' = withFile lockfile WriteMode $ \ h ->
               do pid <- getProcessID
                  hPutStrLn h (show pid)

      delPid' :: IO ()
      delPid' = removeFile lockfile