backend/fix: #172 added OTP attempst left in response

lib/mobility-core/src/Kernel/Types/Error.hs

@@ -31,7 +31,7 @@ import Servant.Client (BaseUrl, ClientError, ResponseF (responseStatusCode))
 -- TODO: sort out proper codes, namings and usages for Unauthorized and AccessDenied
 data AuthError
   = Unauthorized
-  | InvalidAuthData
+  | InvalidAuthData Int
   | TokenExpired
   | TokenIsNotVerified
   | TokenNotFound Text
@@ -51,12 +51,13 @@ instance IsBaseError AuthError where
     AuthBlocked reason -> Just $ "Authentication process blocked: " <> reason
     AccessDenied -> Just "You have no access to this operation."
     HitsLimitError hitsLimitResetTime -> Just $ "Hits limit reached. Try again in " <> show hitsLimitResetTime <> " sec."
+    InvalidAuthData remainingAttempts -> Just $ show remainingAttempts
     _ -> Nothing
 
 instance IsHTTPError AuthError where
   toErrorCode = \case
     Unauthorized -> "UNAUTHORIZED"
-    InvalidAuthData -> "INVALID_AUTH_DATA"
+    InvalidAuthData _ -> "INVALID_AUTH_DATA"
     TokenExpired -> "TOKEN_EXPIRED"
     TokenIsNotVerified -> "TOKEN_IS_NOT_VERIFIED"
     TokenNotFound _ -> "TOKEN_NOT_FOUND"

lib/mobility-core/src/Kernel/Utils/SlidingWindowLimiter.hs

@@ -29,7 +29,7 @@ checkSlidingWindowLimit ::
     HasFlowEnv m r '["apiRateLimitOptions" ::: APIRateLimitOptions]
   ) =>
   Text ->
-  m ()
+  m Int
 checkSlidingWindowLimit key = do
   limitOptions <- asks (.apiRateLimitOptions)
   checkSlidingWindowLimitWithOptions key limitOptions
@@ -40,24 +40,26 @@ checkSlidingWindowLimitWithOptions ::
   ) =>
   Text ->
   APIRateLimitOptions ->
-  m ()
+  m Int
 checkSlidingWindowLimitWithOptions key APIRateLimitOptions {..} = do
-  unlessM (slidingWindowLimiter key limit limitResetTimeInSec) $
+  (res, remainingAttempts) <- slidingWindowLimiter key limit limitResetTimeInSec
+  unless res $
     throwError $ HitsLimitError limitResetTimeInSec
+  return remainingAttempts
 
 -- Sliding window rate limiter.
 -- Returns True if limit is not exceed and further
 -- actions should be allowed. False otherwise.
 
-slidingWindowLimiter :: (Redis.HedisFlow m r, MonadTime m) => Text -> Int -> Int -> m Bool
+slidingWindowLimiter :: (Redis.HedisFlow m r, MonadTime m) => Text -> Int -> Int -> m (Bool, Int)
 slidingWindowLimiter key frameHitsLim frameLen = do
   currTime <- getCurrentTime
   hits <- fromMaybe [] <$> Redis.get key
-  let (filtHits, ret) = slidingWindowLimiterPure currTime hits frameHitsLim frameLen
+  let ((filtHits, ret), remainingAttempts) = slidingWindowLimiterPure currTime hits frameHitsLim frameLen
   when ret $ Redis.setExp key filtHits frameLen
-  return ret
+  return (ret, remainingAttempts)
 
-slidingWindowLimiterPure :: UTCTime -> [Integer] -> Int -> Int -> ([Integer], Bool)
+slidingWindowLimiterPure :: UTCTime -> [Integer] -> Int -> Int -> (([Integer], Bool), Int)
 slidingWindowLimiterPure currTime hits frameHitsLim frameLen = do
   -- How it works:
   -- We convert UTCTime value to Integer and `div` it by frameLen to
@@ -73,7 +75,7 @@ slidingWindowLimiterPure currTime hits frameHitsLim frameLen = do
       prevFrameWeight = 1 - (fromIntegral (getTimeWithinFrame currTime) :: Double) / frameLen'
       currFrameHitsLen = length $ filter (currFrameHitsFilter currFrame) filtHits
       res = floor (fromIntegral prevFrameHitsLen * prevFrameWeight) + currFrameHitsLen < frameHitsLim
-  (if res then currFrame : filtHits else filtHits, res)
+  ((if res then currFrame : filtHits else filtHits, res), (frameHitsLim - (floor (fromIntegral prevFrameHitsLen * prevFrameWeight) + currFrameHitsLen)))
   where
     frameLen' :: Num a => a
     frameLen' = fromIntegral frameLen

lib/mobility-core/test/src/SlidingWindowLimiter.hs

@@ -41,24 +41,24 @@ frame2 = posixSecondsToUTCTime $ secondsToNominalDiffTime (fromIntegral frameLen
 
 emptyList :: TestTree
 emptyList = testCase "Empty list" $ do
-  slidingWindowLimiterPure frame0 [] hitsLimit frameLen @?= ([0], True)
-  slidingWindowLimiterPure frame1 [] hitsLimit frameLen @?= ([1], True)
-  slidingWindowLimiterPure frame2 [] hitsLimit frameLen @?= ([2], True)
+  slidingWindowLimiterPure frame0 [] hitsLimit frameLen @?= (([0], True), 4)
+  slidingWindowLimiterPure frame1 [] hitsLimit frameLen @?= (([1], True), 4)
+  slidingWindowLimiterPure frame2 [] hitsLimit frameLen @?= (([2], True), 4)
 
 successful :: TestTree
 successful = testCase "Successful tests" $ do
-  slidingWindowLimiterPure frame0 [0, 0] hitsLimit frameLen @?= ([0, 0, 0], True)
-  slidingWindowLimiterPure frame1 [0, 0, 0] hitsLimit frameLen @?= ([1, 0, 0, 0], True)
-  slidingWindowLimiterPure frame1 [0, 0, 0, 0] hitsLimit frameLen @?= ([1, 0, 0, 0, 0], True)
-  slidingWindowLimiterPure frame1Late [0, 0, 0, 0, 1] hitsLimit frameLen @?= ([1, 0, 0, 0, 0, 1], True)
-  slidingWindowLimiterPure frame2 [0, 0, 1, 1, 0, 0, 1] hitsLimit frameLen @?= ([2, 1, 1, 1], True)
+  slidingWindowLimiterPure frame0 [0, 0] hitsLimit frameLen @?= (([0, 0, 0], True), 2)
+  slidingWindowLimiterPure frame1 [0, 0, 0] hitsLimit frameLen @?= (([1, 0, 0, 0], True), 2)
+  slidingWindowLimiterPure frame1 [0, 0, 0, 0] hitsLimit frameLen @?= (([1, 0, 0, 0, 0], True), 1)
+  slidingWindowLimiterPure frame1Late [0, 0, 0, 0, 1] hitsLimit frameLen @?= (([1, 0, 0, 0, 0, 1], True), 3)
+  slidingWindowLimiterPure frame2 [0, 0, 1, 1, 0, 0, 1] hitsLimit frameLen @?= (([2, 1, 1, 1], True), 2)
 
 failing :: TestTree
 failing = testCase "Failing tests" $ do
-  slidingWindowLimiterPure frame0 [0, 0, 0, 0] hitsLimit frameLen @?= ([0, 0, 0, 0], False)
-  slidingWindowLimiterPure frame1 [0, 0, 0, 0, 1] hitsLimit frameLen @?= ([0, 0, 0, 0, 1], False)
-  slidingWindowLimiterPure frame1 [0, 0, 0, 0, 1, 1, 1, 1] hitsLimit frameLen @?= ([0, 0, 0, 0, 1, 1, 1, 1], False)
-  slidingWindowLimiterPure frame2 [0, 0, 1, 1, 0, 2, 1, 1] hitsLimit frameLen @?= ([1, 1, 2, 1, 1], False)
+  slidingWindowLimiterPure frame0 [0, 0, 0, 0] hitsLimit frameLen @?= (([0, 0, 0, 0], False), 0)
+  slidingWindowLimiterPure frame1 [0, 0, 0, 0, 1] hitsLimit frameLen @?= (([0, 0, 0, 0, 1], False), 0)
+  slidingWindowLimiterPure frame1 [0, 0, 0, 0, 1, 1, 1, 1] hitsLimit frameLen @?= (([0, 0, 0, 0, 1, 1, 1, 1], False), -3)
+  slidingWindowLimiterPure frame2 [0, 0, 1, 1, 0, 2, 1, 1] hitsLimit frameLen @?= (([1, 1, 2, 1, 1], False), 0)
 
 slidingWindowLimiterTests :: TestTree
 slidingWindowLimiterTests =