module IHP.AuthSupport.Lockable where import IHP.Prelude lock :: forall user. (?modelContext :: ModelContext, CanUpdate user, UpdateField "lockedAt" user user (Maybe UTCTime) (Maybe UTCTime)) => user -> IO user lock :: forall user. (?modelContext::ModelContext, CanUpdate user, UpdateField "lockedAt" user user (Maybe UTCTime) (Maybe UTCTime)) => user -> IO user lock user user = do UTCTime now <- IO UTCTime getCurrentTime let Maybe UTCTime currentLockedAt :: Maybe UTCTime = user user.lockedAt let user user' :: user = forall (field :: Symbol) model model' value value'. UpdateField field model model' value value' => value' -> model -> model' updateField @"lockedAt" (UTCTime -> Maybe UTCTime forall a. a -> Maybe a Just UTCTime now) user user user -> IO user forall a. (CanUpdate a, ?modelContext::ModelContext) => a -> IO a updateRecord user user' lockDuration :: NominalDiffTime lockDuration :: NominalDiffTime lockDuration = let timeInSecs :: Pico timeInSecs = Pico 60 Pico -> Pico -> Pico forall a. Num a => a -> a -> a * Pico 60 in Pico -> NominalDiffTime secondsToNominalDiffTime Pico timeInSecs isLocked :: forall user. (HasField "lockedAt" user (Maybe UTCTime)) => user -> IO Bool isLocked :: forall user. HasField "lockedAt" user (Maybe UTCTime) => user -> IO Bool isLocked user user = do UTCTime now <- IO UTCTime getCurrentTime Bool -> IO Bool forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (UTCTime -> user -> Bool forall user. HasField "lockedAt" user (Maybe UTCTime) => UTCTime -> user -> Bool isLocked' UTCTime now user user) isLocked' :: forall user. (HasField "lockedAt" user (Maybe UTCTime)) => UTCTime -> user -> Bool isLocked' :: forall user. HasField "lockedAt" user (Maybe UTCTime) => UTCTime -> user -> Bool isLocked' UTCTime now user user = case user user.lockedAt of Just UTCTime lockedAt -> let diff :: NominalDiffTime diff = UTCTime -> UTCTime -> NominalDiffTime diffUTCTime UTCTime now UTCTime lockedAt in NominalDiffTime diff NominalDiffTime -> NominalDiffTime -> Bool forall a. Ord a => a -> a -> Bool < NominalDiffTime lockDuration Maybe UTCTime Nothing -> Bool False