-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.VerificationCodeSubsystem.InterpreterSpec where

import Data.Time
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.State
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
import Wire.MockInterpreters
import Wire.Sem.Now
import Wire.Sem.Random
import Wire.VerificationCode
import Wire.VerificationCodeGen
import Wire.VerificationCodeStore
import Wire.VerificationCodeSubsystem as Subsystem
import Wire.VerificationCodeSubsystem.Interpreter

spec :: Spec
spec = describe "Wire.VerificationCodeSubsystem.Interpreter" $ do
  describe "createCode/verifyCode" $ do
    prop "should be able to create and verify codes" $
      \gen scope retries (abs -> timeout) mId throttle ->
        let eitherProp =
              runDependencies throttle
                . interpretVerificationCodeSubsystem
                $ do
                  c <- createCode gen scope retries timeout mId
                  case c of
                    Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code
                    Right code -> do
                      mCode <- verifyCode gen.genKey scope code.codeValue
                      pure $ retries > 0 ==> mCode === Just code
         in assertRightProp eitherProp

    prop "should only allow verification with the same scope" $
      \gen scope retries (abs -> timeout) mId throttle arbitraryScope ->
        let eitherProp =
              runDependencies throttle
                . interpretVerificationCodeSubsystem
                $ do
                  c <- createCode gen scope retries timeout mId
                  case c of
                    Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code
                    Right code -> do
                      mCode <- verifyCode gen.genKey arbitraryScope code.codeValue
                      pure $ retries > 0 && arbitraryScope /= scope ==> mCode === Nothing
         in assertRightProp eitherProp

    prop "should only allow verification with correct value" $
      \gen scope retries (abs -> timeout) mId throttle arbitraryVal ->
        let eitherProp =
              runDependencies throttle
                . interpretVerificationCodeSubsystem
                $ do
                  c <- createCode gen scope retries timeout mId
                  case c of
                    Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code
                    Right code -> do
                      mCode <- verifyCode gen.genKey scope arbitraryVal
                      pure $ retries > 0 && arbitraryVal /= code.codeValue ==> mCode === Nothing
         in assertRightProp eitherProp

    prop "should allow retries" $
      \gen scope retries (abs -> timeout) mId throttle arbitraryVal ->
        let eitherProp =
              runDependencies throttle
                . interpretVerificationCodeSubsystem
                $ do
                  c <- createCode gen scope retries timeout mId
                  case c of
                    Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code
                    Right code -> do
                      codesWithArbitraryVal <-
                        catMaybes
                          <$> replicateM
                            (fromIntegral retries - 1)
                            (verifyCode gen.genKey scope arbitraryVal)
                      mCodeWithCorrectVal <- verifyCode gen.genKey scope code.codeValue
                      pure $
                        retries > 1 && arbitraryVal /= code.codeValue ==>
                          codesWithArbitraryVal === []
                            .&&. mCodeWithCorrectVal === Just (code {codeRetries = 1})
         in assertRightProp eitherProp

    prop "should only allow given number of retries" $
      \gen scope retries (abs -> timeout) mId throttle arbitraryVal ->
        let eitherProp =
              runDependencies throttle
                . interpretVerificationCodeSubsystem
                $ do
                  c <- createCode gen scope retries timeout mId
                  case c of
                    Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code
                    Right code -> do
                      codesWithArbitraryVal <-
                        catMaybes
                          <$> replicateM
                            (fromIntegral retries)
                            (verifyCode gen.genKey scope arbitraryVal)
                      mCodeWithCorrectVal <- verifyCode gen.genKey scope code.codeValue
                      pure $
                        retries > 0 && arbitraryVal /= code.codeValue ==>
                          codesWithArbitraryVal === []
                            .&&. mCodeWithCorrectVal === Nothing
         in assertRightProp eitherProp

  describe "createCode" $ do
    prop "should only allow one code at a time per (key, scope)" $ do
      \gen scope retries (abs -> timeout) mId throttle ->
        let eitherProp =
              runDependencies throttle
                . interpretVerificationCodeSubsystem
                $ do
                  c1 <- createCode gen scope retries timeout mId
                  case c1 of
                    Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code
                    Right code -> do
                      c2 <- createCode gen scope retries timeout mId
                      pure $ c2 === Left (CodeAlreadyExists code)
         in assertRightProp eitherProp

  describe "createCode/deleteCode/verifyCode" $ do
    prop "should not allow verification using a deleted code" $ do
      \gen scope retries (abs -> timeout) mId throttle ->
        let eitherProp =
              runDependencies throttle
                . interpretVerificationCodeSubsystem
                $ do
                  c <- createCode gen scope retries timeout mId
                  case c of
                    Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code
                    Right code -> do
                      Subsystem.deleteCode gen.genKey scope
                      mCode <- verifyCode gen.genKey scope code.codeValue
                      pure $ mCode === Nothing
         in assertRightProp eitherProp

  describe "createCodeOverwritePrevious/verifyCode" $ do
    prop "should allow creating code for the same scope and key, making previous code invalid" $ do
      \gen scope retries (abs -> timeout) mId throttle ->
        let eitherProp =
              runDependencies throttle
                . interpretVerificationCodeSubsystem
                $ do
                  code1 <- createCodeOverwritePrevious gen scope retries timeout mId
                  passTime (fromIntegral throttle + 1)
                  code2 <- createCodeOverwritePrevious gen scope retries timeout mId
                  mCode1 <- verifyCode gen.genKey scope code1.codeValue
                  mCode2 <- verifyCode gen.genKey scope code2.codeValue
                  pure $ retries > 1 ==> mCode1 === Nothing .&&. mCode2 === Just (code2 {codeRetries = retries - 1})
         in assertRightProp eitherProp

    prop "should throttle creating codes " $ do
      \gen scope retries (abs -> timeout) mId ((+ 1) -> throttle) ->
        let eitherProp =
              runDependencies throttle
                . interpretVerificationCodeSubsystem
                $ do
                  code <- createCodeOverwritePrevious gen scope retries timeout mId
                  mErrThrottled1 <- catchExpectedError $ createCodeOverwritePrevious gen scope retries timeout mId
                  mCode1 <- verifyCode gen.genKey scope code.codeValue
                  Subsystem.deleteCode gen.genKey scope
                  mErrThrottled2 <- catchExpectedError $ createCodeOverwritePrevious gen scope retries timeout mId
                  let expectedErr = Just $ VerificationCodeThrottled $ fromIntegral throttle
                  pure $
                    mErrThrottled1 === expectedErr
                      .&&. mErrThrottled2 === expectedErr
                      .&&. (retries > 1 ==> mCode1 === Just code)
         in assertRightProp eitherProp

  describe "internalLookupCode" $ do
    prop "should allow looking up code by scope and key" $ do
      \gen scope retries (abs -> timeout) mId throttle ->
        let eitherProp =
              runDependencies throttle
                . interpretVerificationCodeSubsystem
                $ do
                  code1 <- createCodeOverwritePrevious gen scope retries timeout mId
                  lookedUpCode <- internalLookupCode gen.genKey scope
                  pure $ lookedUpCode === Just code1
         in assertRightProp eitherProp

runDependencies :: VerificationCodeThrottleTTL -> Sem '[Input VerificationCodeThrottleTTL, VerificationCodeStore, Now, State UTCTime, Random, Error e] a -> Either e a
runDependencies throttle =
  run
    . runError
    . runRandomPure
    . evalState defaultTime
    . interpretNowAsState
    . runInMemoryVerificationCodeStore
    . runInputConst throttle

assertRightProp :: (Show e) => Either e Property -> Property
assertRightProp = either (\e -> counterexample ("unexpected error: " <> show e) False) id

unexpectedCodeAlreadyExists :: Code -> Property
unexpectedCodeAlreadyExists code = counterexample ("code shouldn't already exist, but exists: " <> show code) False
