module Main where

import           Control.Monad
import           Control.Monad.Trans
import           OpenSSL
import           OpenSSL.PEM
import           OpenSSL.RSA
import           OpenSSL.X509.Request
import           System.Console.Haskeline
import           System.Console.ParseArgs
import           System.IO
import           System.Posix.Files
import           System.Posix.Uname


data Options
    = Help
    | Command
    deriving (Show, Eq, Ord)

arginfo :: [Arg Options]
arginfo = [ Arg {
              argIndex = Help
            , argAbbr  = Just 'h'
            , argName  = Nothing
            , argData  = Nothing
            , argDesc  = "print this help."
            }
          , Arg {
              argIndex = Command
            , argAbbr  = Nothing
            , argName  = Nothing
            , argData  = argDataDefaulted "COMMAND" ArgtypeString "update"
            , argDesc  = "command to the client (default: \"update\")."
            }
          ]

main :: IO ()
main = withOpenSSL $
       do m <- parseArgsIO ArgsComplete arginfo
          when (gotArg m Help)
                   $ usageError m ""

          case getRequiredArg m Command of
            "makereq"
                -> makeReq
            _   -> usageError m ""


makeReq :: IO ()
makeReq
    = do fqdn <- runInputT defaultSettings $
                 do defaultFqdn <- liftM uNodeName $ liftIO uname
                    fqdn        <- getInputLine ("What's your FQDN? (default: " ++ defaultFqdn ++ "): ")
                    case fqdn of
                      Just s@(_:_) -> return s
                      _            -> return defaultFqdn

         putStrLn "Generating RSA keypair..."
         key <- generateRSAKey 1024 3 Nothing

         let pubFile = fqdn ++ ".pub"
         withFile pubFile WriteMode $ \ h ->
             writePublicKey key >>= hPutStr h
         putStrLn ("Wrote " ++ pubFile)

         let keyFile = fqdn ++ ".key"
         withFile keyFile WriteMode $ \ h ->
             writePKCS8PrivateKey key Nothing >>= hPutStr h
         setFileMode keyFile ownerReadMode
         putStrLn ("Wrote " ++ keyFile ++ " (with no encryption)")

         req <- newX509Req
         setVersion     req 2
         setSubjectName req [("CN", fqdn)]
         setPublicKey   req key
         signX509Req    req key Nothing
         let reqFile = fqdn ++ ".req"
         withFile reqFile WriteMode $ \ h ->
             writeX509Req req ReqNewFormat >>= hPutStr h
         putStrLn ("Wrote " ++ reqFile)
         putStrLn ("Now send " ++ reqFile ++ " to the server operator and tell him/her to sign it.")