module Main where

import Network.CGI
import Data.Maybe
import System.IO

import DB
import Session
import LoginPage
import Process
import ByteStrHelpers
import FancyHtml

main = runCGI $ handleErrors cgiMain

cgiMain = do
    username  <- getInput "username"
    challenge <- getInput "challenge"
    signature <- getInput "signature"
    let user  = fromJust username
    let chall = fromJust challenge
    let sig   = fromJust signature
    pubkey <- liftIO $ db_firstvalue $ "SELECT pubkey FROM users WHERE username LIKE '" ++ user ++ "'"
    revocation_info <- liftIO $ db_firstvalue $ "SELECT revocation FROM users WHERE username LIKE '" ++ user ++ "'"
    sig_ok <- liftIO $ check_challenge_sig chall pubkey sig
    if (sig_ok && length revocation_info == 0)
        then do
            sessId <- liftIO $ new_session_id user
            output $ loggedInPage sessId
        else if length revocation_info > 0
            then output $ header ++ errorBox "Key compromised." ++ footer
            else output $ header ++ errorBox "Incorrect challenge signature." ++ footer

check_challenge_sig challenge pubkey signature = do
    (keyfile, keyhandle) <- liftIO $ openTempFile "/tmp" "pubkey"
    liftIO $ hPutStr keyhandle pubkey
    liftIO $ hClose keyhandle
    verification <- liftIO $ run_with_stdin ("openssl rsautl -verify -raw -pubin -inkey " ++ keyfile) $ hexsigToByteStr signature
    return (hexsigToByteStr challenge == verification)

hexsigToByteStr =
    intToByteStr . hexStrToInt . evenLength . clearColons
