[backend/enhace] add retry merchanism for source down issues in docum…

…ent verification

Backend/app/dashboard/CommonAPIs/src/Dashboard/ProviderPlatform/Merchant.hs

@@ -476,6 +476,7 @@ data OnboardingDocumentConfigItem = OnboardingDocumentConfigItem
     vehicleClassCheckType :: VehicleClassCheckType,
     rcNumberPrefix :: Text,
     rcNumberPrefixList :: Maybe [Text],
+    maxRetryCount :: Int,
     createdAt :: UTCTime,
     updatedAt :: UTCTime
   }
@@ -557,6 +558,7 @@ data OnboardingDocumentConfigUpdateReq = OnboardingDocumentConfigUpdateReq
     supportedVehicleClasses :: Maybe SupportedVehicleClasses, -- value wrapper make no sense for lists and objects
     rcNumberPrefix :: Maybe (MandatoryValue Text),
     rcNumberPrefixList :: Maybe (MandatoryValue [Text]),
+    maxRetryCount :: Maybe (MandatoryValue Int),
     vehicleClassCheckType :: Maybe (MandatoryValue VehicleClassCheckType)
   }
   deriving stock (Show, Generic)
@@ -582,6 +584,7 @@ data OnboardingDocumentConfigCreateReq = OnboardingDocumentConfigCreateReq
     supportedVehicleClasses :: SupportedVehicleClasses,
     rcNumberPrefix :: Text,
     rcNumberPrefixList :: Maybe [Text],
+    maxRetryCount :: Int,
     vehicleClassCheckType :: VehicleClassCheckType
   }
   deriving stock (Show, Generic)

Backend/app/provider-platform/dynamic-offer-driver-app/Allocator/src/App.hs

@@ -36,6 +36,7 @@ import Kernel.Utils.Servant.SignatureAuth
 import Lib.Scheduler
 import qualified Lib.Scheduler.JobStorageType.SchedulerType as QAllJ
 import SharedLogic.Allocator
+import SharedLogic.Allocator.Jobs.Document.VerificationRetry
 import SharedLogic.Allocator.Jobs.DriverFeeUpdates.BadDebtCalculationScheduler
 import SharedLogic.Allocator.Jobs.DriverFeeUpdates.DriverFee
 import SharedLogic.Allocator.Jobs.Mandate.Execution (startMandateExecutionForDriver)
@@ -71,6 +72,7 @@ allocatorHandle flowRt env =
           & putJobHandlerInList (liftIO . runFlowR flowRt env . notificationAndOrderStatusUpdate)
           & putJobHandlerInList (liftIO . runFlowR flowRt env . sendOverlayToDriver)
           & putJobHandlerInList (liftIO . runFlowR flowRt env . badDebtCalculation)
+          & putJobHandlerInList (liftIO . runFlowR flowRt env . retryDocumentVerificationJob)
     }
 
 runDriverOfferAllocator ::

Backend/app/provider-platform/dynamic-offer-driver-app/Main/dynamic-offer-driver-app.cabal

@@ -287,6 +287,7 @@ library
       Lib.Mesh
       Lib.Schema
       SharedLogic.Allocator
+      SharedLogic.Allocator.Jobs.Document.VerificationRetry
       SharedLogic.Allocator.Jobs.DriverFeeUpdates.BadDebtCalculationScheduler
       SharedLogic.Allocator.Jobs.DriverFeeUpdates.DriverFee
       SharedLogic.Allocator.Jobs.Mandate.Execution

Backend/app/provider-platform/dynamic-offer-driver-app/Main/src/Domain/Action/Dashboard/Merchant.hs

@@ -460,7 +460,8 @@ onboardingDocumentConfigUpdate merchantShortId opCity reqDocumentType req = do
                supportedVehicleClasses = maybe config.supportedVehicleClasses castSupportedVehicleClasses req.supportedVehicleClasses,
                vehicleClassCheckType = maybe config.vehicleClassCheckType (castVehicleClassCheckType . (.value)) req.vehicleClassCheckType,
                rcNumberPrefix = maybe config.rcNumberPrefix (.value) req.rcNumberPrefix,
-               rcNumberPrefixList = maybe config.rcNumberPrefixList (.value) req.rcNumberPrefixList
+               rcNumberPrefixList = maybe config.rcNumberPrefixList (.value) req.rcNumberPrefixList,
+               maxRetryCount = maybe config.maxRetryCount (.value) req.maxRetryCount
               }
   _ <- CQODC.update updConfig
   CQODC.clearCache merchantOpCityId

Backend/app/provider-platform/dynamic-offer-driver-app/Main/src/Domain/Action/UI/DriverOnboarding/DriverLicense.hs

@@ -172,6 +172,7 @@ verifyDLFlow person merchantOpCityId onboardingDocumentConfig dlNumber driverDat
             idfyResponse = Nothing,
             multipleRC = Nothing, -- added for backward compatibility
             dashboardPassedVehicleVariant = Nothing,
+            retryCount = 0,
             createdAt = now,
             updatedAt = now
           }

Backend/app/provider-platform/dynamic-offer-driver-app/Main/src/Domain/Action/UI/DriverOnboarding/IdfyWebhook.hs

@@ -21,9 +21,11 @@ module Domain.Action.UI.DriverOnboarding.IdfyWebhook
   )
 where
 
+import Control.Applicative ((<|>))
 import qualified Domain.Action.UI.DriverOnboarding.DriverLicense as DL
 import qualified Domain.Action.UI.DriverOnboarding.Status as Status
 import qualified Domain.Action.UI.DriverOnboarding.VehicleRegistrationCertificate as RC
+import qualified Domain.Types.DriverOnboarding.IdfyVerification as IV
 import qualified Domain.Types.Merchant as DM
 import qualified Domain.Types.Merchant.MerchantServiceConfig as DMSC
 import Environment
@@ -36,6 +38,8 @@ import Kernel.Types.Beckn.Context as Context
 import Kernel.Types.Error
 import Kernel.Types.Id
 import Kernel.Utils.Common
+import Lib.Scheduler.JobStorageType.SchedulerType (createJobIn)
+import SharedLogic.Allocator
 import SharedLogic.Merchant (findMerchantByShortId)
 import qualified Storage.CachedQueries.Merchant.MerchantOperatingCity as CQMOC
 import qualified Storage.CachedQueries.Merchant.MerchantServiceConfig as CQMSC
@@ -111,18 +115,37 @@ idfyWebhookV2Handler merchantShortId opCity secret val = do
 onVerify :: Idfy.VerificationResponse -> Text -> Flow AckResponse
 onVerify resp respDump = do
   verificationReq <- IVQuery.findByRequestId resp.request_id >>= fromMaybeM (InternalError "Verification request not found")
-  _ <- IVQuery.updateResponse resp.request_id resp.status respDump
-
-  ack_ <- maybe (pure Ack) (verifyDocument verificationReq) resp.result
-  person <- runInReplica $ QP.findById verificationReq.driverId >>= fromMaybeM (PersonDoesNotExist verificationReq.driverId.getId)
-  -- running statusHandler to enable Driver
-  _ <- Status.statusHandler (verificationReq.driverId, person.merchantId, person.merchantOperatingCityId) verificationReq.multipleRC
-
-  return ack_
+  IVQuery.updateResponse resp.request_id resp.status respDump
+  let resultStatus = getResultStatus resp.result
+  if resultStatus == (Just "source_down")
+    then do
+      scheduleRetryVerificationJob verificationReq
+      return Ack
+    else do
+      ack_ <- maybe (pure Ack) (verifyDocument verificationReq) resp.result
+      person <- runInReplica $ QP.findById verificationReq.driverId >>= fromMaybeM (PersonDoesNotExist verificationReq.driverId.getId)
+      -- running statusHandler to enable Driver
+      void $ Status.statusHandler (verificationReq.driverId, person.merchantId, person.merchantOperatingCityId) verificationReq.multipleRC
+      return ack_
   where
+    getResultStatus mbResult = mbResult >>= (\rslt -> (rslt.extraction_output >>= (.status)) <|> (rslt.source_output >>= (.status)))
     verifyDocument verificationReq rslt
       | isJust rslt.extraction_output =
         maybe (pure Ack) (RC.onVerifyRC verificationReq) rslt.extraction_output
       | isJust rslt.source_output =
         maybe (pure Ack) (DL.onVerifyDL verificationReq) rslt.source_output
       | otherwise = pure Ack
+
+scheduleRetryVerificationJob :: IV.IdfyVerification -> Flow ()
+scheduleRetryVerificationJob verificationReq = do
+  maxShards <- asks (.maxShards)
+  let scheduleTime = calculateScheduleTime verificationReq.retryCount
+  createJobIn @_ @'RetryDocumentVerification scheduleTime maxShards $
+    RetryDocumentVerificationJobData
+      { requestId = verificationReq.requestId
+      }
+  where
+    calculateScheduleTime retryCount = do
+      let retryInterval = 60 * 60 * 1000 -- 1 hour
+      let retryTime = retryInterval * (3 ^ retryCount)
+      retryTime

Backend/app/provider-platform/dynamic-offer-driver-app/Main/src/Domain/Action/UI/DriverOnboarding/VehicleRegistrationCertificate.hs

@@ -243,6 +243,7 @@ verifyRCFlow person merchantOpCityId imageExtraction rcNumber imageId dateOfRegi
             idfyResponse = Nothing,
             multipleRC,
             dashboardPassedVehicleVariant = mbVariant,
+            retryCount = 0,
             createdAt = now,
             updatedAt = now
           }

Backend/app/provider-platform/dynamic-offer-driver-app/Main/src/Domain/Types/DriverOnboarding/IdfyVerification.hs

@@ -52,6 +52,7 @@ data IdfyVerificationE e = IdfyVerification
     idfyResponse :: Maybe Text,
     multipleRC :: Maybe Bool,
     dashboardPassedVehicleVariant :: Maybe Vehicle.Variant,
+    retryCount :: Int,
     createdAt :: UTCTime,
     updatedAt :: UTCTime
   }

Backend/app/provider-platform/dynamic-offer-driver-app/Main/src/Domain/Types/Merchant/OnboardingDocumentConfig.hs

@@ -50,6 +50,7 @@ data OnboardingDocumentConfig = OnboardingDocumentConfig
     vehicleClassCheckType :: VehicleClassCheckType,
     rcNumberPrefix :: Text,
     rcNumberPrefixList :: [Text],
+    maxRetryCount :: Int,
     createdAt :: UTCTime,
     updatedAt :: UTCTime
   }

Backend/app/provider-platform/dynamic-offer-driver-app/Main/src/SharedLogic/Allocator.hs

@@ -42,6 +42,7 @@ data AllocatorJobType
   | OrderAndNotificationStatusUpdate
   | SendOverlay
   | BadDebtCalculation
+  | RetryDocumentVerification
   deriving (Generic, FromDhall, Eq, Ord, Show, Read, FromJSON, ToJSON)
 
 genSingletons [''AllocatorJobType]
@@ -59,6 +60,7 @@ instance JobProcessor AllocatorJobType where
   restoreAnyJobInfo SOrderAndNotificationStatusUpdate jobData = AnyJobInfo <$> restoreJobInfo SOrderAndNotificationStatusUpdate jobData
   restoreAnyJobInfo SSendOverlay jobData = AnyJobInfo <$> restoreJobInfo SSendOverlay jobData
   restoreAnyJobInfo SBadDebtCalculation jobData = AnyJobInfo <$> restoreJobInfo SBadDebtCalculation jobData
+  restoreAnyJobInfo SRetryDocumentVerification jobData = AnyJobInfo <$> restoreJobInfo SRetryDocumentVerification jobData
 
 data SendSearchRequestToDriverJobData = SendSearchRequestToDriverJobData
   { searchTryId :: Id DST.SearchTry,
@@ -142,6 +144,15 @@ instance JobInfoProcessor 'CalculateDriverFees
 
 type instance JobContent 'CalculateDriverFees = CalculateDriverFeesJobData
 
+data RetryDocumentVerificationJobData = RetryDocumentVerificationJobData
+  { requestId :: Text
+  }
+  deriving (Generic, Show, Eq, FromJSON, ToJSON)
+
+instance JobInfoProcessor 'RetryDocumentVerification
+
+type instance JobContent 'RetryDocumentVerification = RetryDocumentVerificationJobData
+
 data OrderAndNotificationStatusUpdateJobData = OrderAndNotificationStatusUpdateJobData
   { merchantId :: Id DM.Merchant,
     merchantOperatingCityId :: Maybe (Id DMOC.MerchantOperatingCity)

Backend/app/provider-platform/dynamic-offer-driver-app/Main/src/SharedLogic/Allocator/Jobs/Document/VerificationRetry.hs

@@ -0,0 +1,90 @@
+{-
+ Copyright 2022-23, Juspay India Pvt Ltd
+
+ 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 SharedLogic.Allocator.Jobs.Document.VerificationRetry
+  ( retryDocumentVerificationJob,
+  )
+where
+
+import Domain.Types.DriverOnboarding.IdfyVerification
+import qualified Domain.Types.DriverOnboarding.Image as Image
+import qualified Domain.Types.Merchant.OnboardingDocumentConfig as DTO
+import Kernel.Beam.Functions as B
+import Kernel.External.Encryption (decrypt)
+import Kernel.Prelude
+import Kernel.Storage.Esqueleto.Config
+import Kernel.Types.Error
+import Kernel.Utils.Common
+import Lib.Scheduler
+import SharedLogic.Allocator (AllocatorJobType (..))
+import SharedLogic.GoogleTranslate (TranslateFlow)
+import qualified Storage.CachedQueries.Merchant.OnboardingDocumentConfig as QODC
+import qualified Storage.Queries.DriverOnboarding.IdfyVerification as IVQuery
+import qualified Storage.Queries.Person as QP
+import Tools.Error
+import qualified Tools.Verification as Verification
+
+retryDocumentVerificationJob ::
+  ( TranslateFlow m r,
+    EsqDBReplicaFlow m r,
+    CacheFlow m r,
+    EsqDBFlow m r
+  ) =>
+  Job 'RetryDocumentVerification ->
+  m ExecutionResult
+retryDocumentVerificationJob Job {id, jobInfo} = withLogTag ("JobId-" <> id.getId) do
+  let jobData = jobInfo.jobData
+  verificationReq <- IVQuery.findByRequestId jobData.requestId >>= fromMaybeM (InternalError "Verification request not found")
+  person <- runInReplica $ QP.findById verificationReq.driverId >>= fromMaybeM (PersonDoesNotExist verificationReq.driverId.getId)
+  onboardingDocumentConfig <- QODC.findByMerchantOpCityIdAndDocumentType person.merchantOperatingCityId (castDoctype verificationReq.docType) >>= fromMaybeM (OnboardingDocumentConfigNotFound person.merchantOperatingCityId.getId (show verificationReq.docType))
+  let maxRetryCount = onboardingDocumentConfig.maxRetryCount
+  if verificationReq.retryCount <= maxRetryCount
+    then do
+      documentNumber <- decrypt verificationReq.documentNumber
+      IVQuery.updateStatus verificationReq.requestId "source_down_retried"
+      case verificationReq.docType of
+        Image.VehicleRegistrationCertificate -> do
+          verifyRes <-
+            Verification.verifyRCAsync person.merchantId person.merchantOperatingCityId $
+              Verification.VerifyRCAsyncReq {rcNumber = documentNumber, driverId = person.id.getId}
+          mkNewVerificationEntity verificationReq verifyRes.requestId
+        Image.DriverLicense -> do
+          whenJust verificationReq.driverDateOfBirth $ \dob -> do
+            verifyRes <-
+              Verification.verifyDLAsync person.merchantId person.merchantOperatingCityId $
+                Verification.VerifyDLAsyncReq {dlNumber = documentNumber, dateOfBirth = dob, driverId = person.id.getId}
+            mkNewVerificationEntity verificationReq verifyRes.requestId
+    else do
+      IVQuery.updateStatus verificationReq.requestId "source_down_failed"
+  return Complete
+  where
+    castDoctype :: Image.ImageType -> DTO.DocumentType
+    castDoctype docType =
+      case docType of
+        Image.VehicleRegistrationCertificate -> DTO.RC
+        Image.DriverLicense -> DTO.DL
+
+    mkNewVerificationEntity verificationReq requestId = do
+      now <- getCurrentTime
+      newId <- generateGUID
+      let newVerificationReq =
+            verificationReq
+              { id = newId,
+                retryCount = verificationReq.retryCount + 1,
+                status = "source_down_retrying",
+                requestId,
+                createdAt = now,
+                updatedAt = now
+              }
+      IVQuery.create newVerificationReq

Backend/app/provider-platform/dynamic-offer-driver-app/Main/src/Storage/Beam/DriverOnboarding/IdfyVerification.hs

@@ -41,6 +41,7 @@ data IdfyVerificationT f = IdfyVerificationT
     idfyResponse :: B.C f (Maybe Text),
     multipleRC :: B.C f (Maybe Bool),
     dashboardPassedVehicleVariant :: B.C f (Maybe Vehicle.Variant),
+    retryCount :: B.C f (Maybe Int),
     createdAt :: B.C f UTCTime,
     updatedAt :: B.C f UTCTime
   }

Backend/app/provider-platform/dynamic-offer-driver-app/Main/src/Storage/Beam/Merchant/OnboardingDocumentConfig.hs

@@ -33,6 +33,7 @@ data OnboardingDocumentConfigT f = OnboardingDocumentConfigT
     supportedVehicleClassesJSON :: B.C f A.Value,
     rcNumberPrefix :: B.C f Text,
     rcNumberPrefixList :: B.C f [Text],
+    maxRetryCount :: B.C f Int,
     vehicleClassCheckType :: B.C f Domain.VehicleClassCheckType,
     createdAt :: B.C f UTCTime,
     updatedAt :: B.C f UTCTime

Backend/app/provider-platform/dynamic-offer-driver-app/Main/src/Storage/Queries/DriverOnboarding/IdfyVerification.hs

@@ -51,6 +51,13 @@ updateResponse requestId status resp = do
     [Se.Set BeamIV.status status, Se.Set BeamIV.idfyResponse $ Just resp, Se.Set BeamIV.updatedAt now]
     [Se.Is BeamIV.requestId (Se.Eq requestId)]
 
+updateStatus :: (MonadFlow m, EsqDBFlow m r, CacheFlow m r) => Text -> Text -> m ()
+updateStatus requestId status = do
+  now <- getCurrentTime
+  updateWithKV
+    [Se.Set BeamIV.status status, Se.Set BeamIV.updatedAt now]
+    [Se.Is BeamIV.requestId (Se.Eq requestId)]
+
 updateExtractValidationStatus :: (MonadFlow m, EsqDBFlow m r, CacheFlow m r) => Text -> ImageExtractionValidation -> m ()
 updateExtractValidationStatus requestId status = do
   now <- getCurrentTime
@@ -70,6 +77,7 @@ instance FromTType' BeamIV.IdfyVerification IdfyVerification where
             documentImageId1 = Id documentImageId1,
             documentImageId2 = Id <$> documentImageId2,
             dashboardPassedVehicleVariant = dashboardPassedVehicleVariant,
+            retryCount = fromMaybe 0 retryCount,
             driverId = Id driverId,
             requestId = requestId,
             docType = docType,
@@ -91,6 +99,7 @@ instance ToTType' BeamIV.IdfyVerification IdfyVerification where
         BeamIV.documentImageId1 = getId documentImageId1,
         BeamIV.documentImageId2 = getId <$> documentImageId2,
         BeamIV.dashboardPassedVehicleVariant = dashboardPassedVehicleVariant,
+        BeamIV.retryCount = Just retryCount,
         BeamIV.driverId = getId driverId,
         BeamIV.requestId = requestId,
         BeamIV.docType = docType,

Backend/app/provider-platform/dynamic-offer-driver-app/Main/src/Storage/Queries/Merchant/OnboardingDocumentConfig.hs

@@ -51,6 +51,7 @@ update config = do
       Se.Set BeamODC.vehicleClassCheckType (config.vehicleClassCheckType),
       Se.Set BeamODC.rcNumberPrefix (config.rcNumberPrefix),
       Se.Set BeamODC.rcNumberPrefixList (config.rcNumberPrefixList),
+      Se.Set BeamODC.maxRetryCount (config.maxRetryCount),
       Se.Set BeamODC.updatedAt now
     ]
     [Se.Is BeamODC.merchantOperatingCityId $ Se.Eq $ getId config.merchantOperatingCityId, Se.Is BeamODC.documentType $ Se.Eq config.documentType]
@@ -73,6 +74,7 @@ instance FromTType' BeamODC.OnboardingDocumentConfig OnboardingDocumentConfig wh
             vehicleClassCheckType = vehicleClassCheckType,
             rcNumberPrefix = rcNumberPrefix,
             rcNumberPrefixList = rcNumberPrefixList,
+            maxRetryCount = maxRetryCount,
             createdAt = createdAt,
             updatedAt = updatedAt
           }
@@ -100,6 +102,7 @@ instance ToTType' BeamODC.OnboardingDocumentConfig OnboardingDocumentConfig wher
         BeamODC.vehicleClassCheckType = vehicleClassCheckType,
         BeamODC.rcNumberPrefix = rcNumberPrefix,
         BeamODC.rcNumberPrefixList = rcNumberPrefixList,
+        BeamODC.maxRetryCount = maxRetryCount,
         BeamODC.createdAt = createdAt,
         BeamODC.updatedAt = updatedAt
       }

Backend/dev/migrations/dynamic-offer-driver-app/0332-source-down-retry.sql

@@ -0,0 +1,3 @@
+
+alter table atlas_driver_offer_bpp.onboarding_document_configs add column max_retry_count int not null default 4;
+alter table atlas_driver_offer_bpp.idfy_verification add column retry_count int;

Backend/dhall-configs/dev/dynamic-offer-driver-app.dhall

@@ -187,6 +187,7 @@ let AllocatorJobType =
       | OrderAndNotificationStatusUpdate
       | SendOverlay
       | BadDebtCalculation
+      | RetryDocumentVerification
       >
 
 let jobInfoMapx =
@@ -208,6 +209,9 @@ let jobInfoMapx =
         }
       , { mapKey = AllocatorJobType.SendOverlay, mapValue = True }
       , { mapKey = AllocatorJobType.BadDebtCalculation, mapValue = True }
+      , { mapKey = AllocatorJobType.RetryDocumentVerification
+        , mapValue = False
+        }
       ]
 
 let LocationTrackingeServiceConfig = { url = "http://localhost:8081/" }