{-# LANGUAGE OverloadedStrings #-}

module Server.Auth.PasswordResetUtil
    ( generateResetToken
    , hashToken
    , validateTokenFormat
    , createResetUrl
    , sendPasswordResetEmail
    , getTokenExpirationTime
    , TokenValidationResult (..)
    ) where

import Crypto.Hash.SHA1 (hash)
import qualified Data.ByteString as BS
import Data.ByteString.Base64 (decode, encode)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as LT
import Data.Time
    ( UTCTime
    , addUTCTime
    , defaultTimeLocale
    , formatTime
    , getCurrentTime
    )
import qualified Mail
import Network.Mail.Mime (Address (..), htmlPart, plainPart)

-- | Result of token validation
data TokenValidationResult
    = TokenValid
    | TokenInvalid
    | TokenExpired
    | TokenAlreadyUsed
    deriving (TokenValidationResult -> TokenValidationResult -> Bool
(TokenValidationResult -> TokenValidationResult -> Bool)
-> (TokenValidationResult -> TokenValidationResult -> Bool)
-> Eq TokenValidationResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TokenValidationResult -> TokenValidationResult -> Bool
== :: TokenValidationResult -> TokenValidationResult -> Bool
$c/= :: TokenValidationResult -> TokenValidationResult -> Bool
/= :: TokenValidationResult -> TokenValidationResult -> Bool
Eq, Int -> TokenValidationResult -> ShowS
[TokenValidationResult] -> ShowS
TokenValidationResult -> String
(Int -> TokenValidationResult -> ShowS)
-> (TokenValidationResult -> String)
-> ([TokenValidationResult] -> ShowS)
-> Show TokenValidationResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenValidationResult -> ShowS
showsPrec :: Int -> TokenValidationResult -> ShowS
$cshow :: TokenValidationResult -> String
show :: TokenValidationResult -> String
$cshowList :: [TokenValidationResult] -> ShowS
showList :: [TokenValidationResult] -> ShowS
Show)

-- | Generate a cryptographically secure random token
generateResetToken :: IO Text
generateResetToken :: IO Text
generateResetToken = do
    -- Generate 32 random bytes (256 bits of entropy) using current time as seed
    UTCTime
now <- IO UTCTime
getCurrentTime
    let timeStr :: String
timeStr = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%s%q" UTCTime
now
    let tokenData :: ByteString
tokenData = Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"reset_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
timeStr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"_token"
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode ByteString
tokenData

-- | Hash a token for secure storage
hashToken :: Text -> Text
hashToken :: Text -> Text
hashToken Text
token =
    let bytes :: ByteString
bytes = Text -> ByteString
Text.encodeUtf8 Text
token
        hashedBytes :: ByteString
hashedBytes = ByteString -> ByteString
hash ByteString
bytes
     in ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode ByteString
hashedBytes

-- | Validate token format (base64 encoded, appropriate length)
validateTokenFormat :: Text -> Bool
validateTokenFormat :: Text -> Bool
validateTokenFormat Text
token =
    case ByteString -> Either String ByteString
decode (Text -> ByteString
Text.encodeUtf8 Text
token) of
        Left String
_ -> Bool
False
        Right ByteString
decoded -> ByteString -> Int
BS.length ByteString
decoded Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10 Bool -> Bool -> Bool
&& ByteString -> Int
BS.length ByteString
decoded Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
200

-- | Create a password reset URL with the given token
createResetUrl :: Text -> Text -> Text
createResetUrl :: Text -> Text -> Text
createResetUrl Text
baseUrl Text
token =
    Text
baseUrl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/reset-password?token=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
token

-- | Send password reset email to user
sendPasswordResetEmail :: Text -> Text -> Text -> IO ()
sendPasswordResetEmail :: Text -> Text -> Text -> IO ()
sendPasswordResetEmail Text
userEmail Text
userName Text
resetUrl = do
    let mail :: Mail
mail =
            Mail.Mail
                { receiver :: Address
Mail.receiver = Maybe Text -> Text -> Address
Address (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
userName) Text
userEmail
                , subject :: Text
Mail.subject = Text
"Password Reset - Fachprüfungsordnung"
                , body :: [Part]
Mail.body =
                    [ Text -> Part
plainPart (Text -> Text
LT.fromStrict Text
plainBody)
                    , Text -> Part
htmlPart (Text -> Text
LT.fromStrict Text
htmlBody)
                    ]
                }
    Mail -> IO ()
Mail.sendMailTo Mail
mail
  where
    plainBody :: Text
plainBody =
        [Text] -> Text
Text.unlines
            [ Text
"Hello " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
userName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
","
            , Text
""
            , Text
"You have requested a password reset for your Fachprüfungsordnung account."
            , Text
""
            , Text
"Please click on the following link to reset your password:"
            , Text
resetUrl
            , Text
""
            , Text
"This link will expire in 1 hour for security reasons."
            , Text
""
            , Text
"If you did not request this password reset, please ignore this email."
            , Text
"Your password will remain unchanged."
            , Text
""
            , Text
"Note: The UI is currently not implemented, so use the /password-reset/confirm endpoint manually (https://batailley.informatik.uni-kiel.de/swagger/)."
            , Text
""
            , Text
"Best regards,"
            , Text
"The Fachprüfungsordnung Team"
            ]

    htmlBody :: Text
htmlBody =
        [Text] -> Text
Text.unlines
            [ Text
"<html><body>"
            , Text
"<h2>Password Reset Request</h2>"
            , Text
"<p>Hello <strong>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
userName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</strong>,</p>"
            , Text
"<p>You have requested a password reset for your Fachprüfungsordnung account.</p>"
            , Text
"<p>Please click on the button below to reset your password:</p>"
            , Text
"<div style='margin: 20px 0;'>"
            , Text
"  <a href='"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
resetUrl
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' style='background-color: #007bff; color: white; padding: 12px 24px; text-decoration: none; border-radius: 4px; display: inline-block;'>Reset Password</a>"
            , Text
"</div>"
            , Text
"<p>Or copy and paste this link into your browser:</p>"
            , Text
"<p><a href='" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
resetUrl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
resetUrl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</a></p>"
            , Text
"<p><strong>Important:</strong> This link will expire in 1 hour for security reasons.</p>"
            , Text
"<p>If you did not request this password reset, please ignore this email. Your password will remain unchanged.</p>"
            , Text
"<hr>"
            , Text
"<p><small>Best regards,<br>The Fachprüfungsordnung Team</small></p>"
            , Text
"</body></html>"
            ]

-- | Calculate token expiration time (1 hour from now)
getTokenExpirationTime :: IO UTCTime
getTokenExpirationTime :: IO UTCTime
getTokenExpirationTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime
60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
60) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime