{-# LANGUAGE CPP #-}
import           Control.Monad
import           Data.Maybe
import           Network
import           Network.HTTP.Lucu
import           Rakka.Environment
import           Rakka.Resource.Index
import           Rakka.Resource.Object
import           Rakka.Resource.Render
import           Subversion
import           System.Console.GetOpt
import           System.Directory
import           System.Environment
import           System.Exit
import           System.Posix.Files
import           System.Posix.Types
import           System.Posix.User


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


defaultPort :: PortNumber
defaultPort = fromIntegral 8080

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

defaultUserName :: String
defaultUserName = "daemon"

defaultGroupName :: String
defaultGroupName = "daemon"


options :: [OptDescr CmdOpt]
options = [ Option ['p'] ["port"]
                   (ReqArg (OptPortNum . fromIntegral . 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 ['h'] ["help"]
                   (NoArg OptHelp)
                   "Print this message."
          ]


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


main :: IO ()
main = 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

          env     <- setupEnv lsdir portNum
          runHttpd (envLucuConf env) (resTree env) [fallbackRender env]

          
resTree :: Environment -> ResTree
resTree env
    = mkResTree [ ([]        , resIndex  env)
                , (["object"], resObject 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


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