{-# LANGUAGE CPP #-}
import           Control.Monad
import           Data.List
import           Data.Maybe
import           Network
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.TrackBack
import           Rakka.Storage
import           Subversion
import           System.Console.GetOpt
import           System.Directory
import           System.Environment
import           System.Exit
import           System.IO
import           System.Log.Handler.Simple
import           System.Log.Logger
import           System.Posix.Files
import           System.Posix.Types
import           System.Posix.User


logger :: String
logger = "Main"


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


defaultPort :: PortNumber
defaultPort = toEnum 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 . toEnum . read) "NUM")
                   ("Port number to listen. (default: " ++ show 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 [] ["disable-stderr-log"]
                   (NoArg OptDisableStderrLog)
                   ("Disable logging to stderr.")

          , Option [] ["rebuild-index"]
                   (NoArg OptRebuildIndex)
                   ("Rebuild the index database.")

          , 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

          when (not $ null errors)
                   $ do mapM_ putStr errors
                        exitWith $ ExitFailure 1

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

          when (not $ null nonOpts)
                   $ do printUsage
                        exitWith $ ExitFailure 1

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

          createLocalStateDir lsdir uid gid

          setGroupID gid
          setUserID  uid

          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)
                , (["trackback"   ], resTrackBack    env)
                ]


getPortNum :: [CmdOpt] -> IO PortNumber
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 disableStderrLog = find (== OptDisableStderrLog) opts /= Nothing
             logHandlers      = if disableStderrLog then
                                    []
                                else
                                    [verboseStreamHandler stderr DEBUG]
             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)