module Servant.Server.Auth.Token.SingleUse(
makeSingleUseExpire
, registerSingleUseCode
, invalidateSingleUseCode
, validateSingleUseCode
, generateSingleUsedCodes
) where
import Control.Monad
import Control.Monad.IO.Class
import Data.Aeson.WithField
import Data.Time
import Servant.API.Auth.Token
import Servant.Server.Auth.Token.Common
import Servant.Server.Auth.Token.Model
makeSingleUseExpire :: MonadIO m => NominalDiffTime
-> m UTCTime
makeSingleUseExpire dt = do
t <- liftIO getCurrentTime
return $ dt `addUTCTime` t
registerSingleUseCode :: HasStorage m => UserImplId
-> SingleUseCode
-> Maybe UTCTime
-> m ()
registerSingleUseCode uid code expire = void $ insertSingleUseCode
$ UserSingleUseCode code uid expire Nothing
invalidateSingleUseCode :: HasStorage m => UserSingleUseCodeId
-> m ()
invalidateSingleUseCode i = do
t <- liftIO getCurrentTime
setSingleUseCodeUsed i $ Just t
validateSingleUseCode :: HasStorage m => UserImplId
-> SingleUseCode
-> m Bool
validateSingleUseCode uid code = do
t <- liftIO getCurrentTime
mcode <- getUnusedCode code uid t
whenJust mcode $ invalidateSingleUseCode . (\(WithField i _) -> i)
return $ maybe False (const True) mcode
generateSingleUsedCodes :: HasStorage m => UserImplId
-> IO SingleUseCode
-> Word
-> m [SingleUseCode]
generateSingleUsedCodes uid gen n = do
t <- liftIO getCurrentTime
invalidatePermamentCodes uid t
replicateM (fromIntegral n) $ do
code <- liftIO gen
_ <- insertSingleUseCode $ UserSingleUseCode code uid Nothing Nothing
return code