Backend/feat/hyper verge selfie liveness check api integration (Do not Merge, for reference)

lib/mobility-core/mobility-core.cabal

@@ -147,6 +147,9 @@ library
       Kernel.External.Verification.GovtData.Storage.Beam
       Kernel.External.Verification.GovtData.Storage.Query
       Kernel.External.Verification.GovtData.Types
+      Kernel.External.Verification.HyperVerge.Error
+      Kernel.External.Verification.HyperVerge.Flow
+      Kernel.External.Verification.HyperVerge.Types
       Kernel.External.Verification.Idfy.Auth
       Kernel.External.Verification.Idfy.Client
       Kernel.External.Verification.Idfy.Config
@@ -157,6 +160,7 @@ library
       Kernel.External.Verification.Idfy.Types.Response
       Kernel.External.Verification.Idfy.WebhookHandler
       Kernel.External.Verification.Interface
+      Kernel.External.Verification.Interface.HyperVerge
       Kernel.External.Verification.Interface.Idfy
       Kernel.External.Verification.Interface.InternalScripts
       Kernel.External.Verification.Interface.Types

lib/mobility-core/src/Kernel/External/Verification/HyperVerge/Error.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Kernel.External.Verification.HyperVerge.Error where
+
+import Kernel.Prelude
+import Kernel.Types.Error.BaseError
+import Kernel.Types.Error.BaseError.HTTPError
+
+data HyperVergeError
+  = HyperVergeFaceNotDetected
+  | HyperVergeCallError Text Text
+  deriving (Eq, Show, IsBecknAPIError)
+
+instanceExceptionWithParent 'HTTPException ''HyperVergeError
+
+instance IsBaseError HyperVergeError where
+  toMessage = \case
+    HyperVergeFaceNotDetected -> Just "Face not detected. Please provide a valid image."
+    HyperVergeCallError code resp -> Just $ "Error Response from Hyperverge. Status Code = " <> code <> " response from HyperVerge is : " <> resp
+
+instance IsHTTPError HyperVergeError where
+  toErrorCode = \case
+    HyperVergeFaceNotDetected -> "FACE_NOT_DETECTED"
+    HyperVergeCallError _ _ -> "HYPERVERGE_CALL_ERROR"
+
+  toHttpCode = \case
+    HyperVergeFaceNotDetected -> E422
+    HyperVergeCallError _ _ -> E400 -- HVTODO: Check if this error code fits accurately.
+
+instance IsAPIError HyperVergeError

lib/mobility-core/src/Kernel/External/Verification/HyperVerge/Flow.hs

@@ -0,0 +1,133 @@
+module Kernel.External.Verification.HyperVerge.Flow where
+
+import qualified Control.Concurrent.MVar as CCMVar
+import qualified Data.ByteString as BS
+import Data.ByteString.Builder (toLazyByteString)
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy as BSL
+import Kernel.External.Verification.HyperVerge.Error
+import Kernel.External.Verification.HyperVerge.Types
+import Kernel.Prelude
+import Kernel.Tools.Metrics.CoreMetrics (CoreMetrics)
+import Kernel.Types.Error (ExternalAPICallError (..))
+import Kernel.Utils.Common hiding (callAPI)
+import qualified Network.HTTP.Client as Client
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Network.HTTP.Media (renderHeader)
+import Network.HTTP.Types (hContentType)
+import Servant.API
+import Servant.Client
+import Servant.Client.Core
+import Servant.Multipart
+import Servant.Multipart.Client ()
+import qualified Servant.Types.SourceT as S
+
+type FaceValidationAPI =
+  Header "transactionId" Text
+    :> Header "appId" Text
+    :> Header "appKey" Text
+    :> MultipartForm Tmp HyperVergeSelfieValidationReq
+    :> "v1"
+    :> "checkLiveness"
+    :> Post '[JSON] HyperVergeSelfieValidationRes
+
+api :: Proxy FaceValidationAPI
+api = Proxy
+
+clientFunction :: Maybe Text -> Maybe Text -> Maybe Text -> (BL.ByteString, HyperVergeSelfieValidationReq) -> ClientM HyperVergeSelfieValidationRes
+clientFunction = client api
+
+callAPI :: Maybe Text -> Maybe Text -> Maybe Text -> HyperVergeSelfieValidationReq -> ClientM HyperVergeSelfieValidationRes
+callAPI transactionId appId appKey formData = clientFunction transactionId appId appKey ("xxxxxx", formData)
+
+callHyperVergeFaceValidationAPI ::
+  (MonadFlow m, CoreMetrics m) =>
+  BaseUrl ->
+  Text ->
+  Text ->
+  Text ->
+  HyperVergeSelfieValidationReq ->
+  m HyperVergeSelfieValidationRes
+callHyperVergeFaceValidationAPI url transactionId appId appKey req = do
+  manager <- liftIO $ Client.newManager tlsManagerSettings
+  logDebug $ "The request is : " <> (show req) --HVTODO: Remove this
+  (liftIO $ runClientM (callAPI (Just transactionId) (Just appId) (Just appKey) req) (ClientEnv manager url Nothing modifiedHVMakeClientRequest)) >>= checkHyperVergeError url
+
+checkHyperVergeError :: (MonadThrow m, Log m) => BaseUrl -> Either ClientError HyperVergeSelfieValidationRes -> m HyperVergeSelfieValidationRes
+checkHyperVergeError url resp = do
+  fromEitherM (hyperVergeError url) resp >>= validateResponseStatus
+
+hyperVergeError :: BaseUrl -> ClientError -> ExternalAPICallError
+hyperVergeError = ExternalAPICallError (Just "HYPERVERGE_API_ERROR")
+
+validateResponseStatus :: (MonadThrow m, Log m) => HyperVergeSelfieValidationRes -> m HyperVergeSelfieValidationRes
+validateResponseStatus response
+  | response.statusCode == 200 = pure response
+  | otherwise = throwError $ HyperVergeCallError (show response.statusCode) (show response)
+
+modifiedHVMakeClientRequest :: BaseUrl -> Request -> Client.Request
+modifiedHVMakeClientRequest burl r =
+  Client.defaultRequest
+    { Client.method = requestMethod r,
+      Client.host = fromString $ baseUrlHost burl,
+      Client.port = baseUrlPort burl,
+      Client.path =
+        BSL.toStrict $
+          fromString (baseUrlPath burl)
+            <> toLazyByteString (requestPath r),
+      Client.queryString = buildQueryString . toList $ requestQueryString r,
+      Client.requestHeaders =
+        maybeToList acceptHdr ++ maybeToList contentTypeHdr ++ headers,
+      Client.requestBody = body,
+      Client.secure = isSecure
+    }
+  where
+    -- Content-Type and Accept are specified by requestBody and requestAccept
+    headers =
+      filter (\(h, _) -> h /= "Accept" && h /= "Content-Type") $
+        toList $ requestHeaders r
+
+    acceptHdr
+      | null hs = Nothing
+      | otherwise = Just ("Accept", renderHeader hs)
+      where
+        hs = toList $ requestAccept r
+
+    convertBody bd = case bd of
+      RequestBodyLBS body' -> Client.RequestBodyLBS body'
+      RequestBodyBS body' -> Client.RequestBodyBS body'
+      RequestBodySource sourceIO -> Client.RequestBodyStreamChunked givesPopper
+        where
+          givesPopper :: (IO BS.ByteString -> IO ()) -> IO ()
+          givesPopper needsPopper = S.unSourceT sourceIO $ \step0 -> do
+            ref <- CCMVar.newMVar step0
+
+            -- Note sure we need locking, but it's feels safer.
+            let popper :: IO BS.ByteString
+                popper = CCMVar.modifyMVar ref nextBs
+
+            needsPopper popper
+
+          nextBs S.Stop = return (S.Stop, BS.empty)
+          nextBs (S.Error err) = fail err
+          nextBs (S.Skip s) = nextBs s
+          nextBs (S.Effect ms) = ms >>= nextBs
+          nextBs (S.Yield lbs s) = case BSL.toChunks lbs of
+            [] -> nextBs s
+            (x : xs)
+              | BS.null x -> nextBs step'
+              | otherwise -> return (step', x)
+              where
+                step' = S.Yield (BSL.fromChunks xs) s
+
+    (body, contentTypeHdr) = case requestBody r of
+      Nothing -> (Client.RequestBodyBS "", Nothing)
+      Just (body', typ) -> (convertBody body', Just (hContentType, renderHeader typ))
+
+    isSecure = case baseUrlScheme burl of
+      Http -> False
+      Https -> True
+
+    -- Query string builder which does not do any encoding
+    buildQueryString [] = mempty
+    buildQueryString _ = ""

lib/mobility-core/src/Kernel/External/Verification/HyperVerge/Types.hs

@@ -0,0 +1,85 @@
+module Kernel.External.Verification.HyperVerge.Types where
+
+import Data.Aeson
+import qualified Data.Text as T
+import Kernel.Prelude hiding (error)
+import Servant.Multipart.API (FileData (..), MultipartData (..), Tmp, ToMultipart (..))
+
+data HyperVergeConfig = HyperVergeConfig
+  { url :: BaseUrl,
+    appId :: Text,
+    appKey :: Text
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON)
+
+data HyperVergeSelfieValidationReq = HyperVergeSelfieValidationReq
+  { image :: FilePath
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON, ToSchema)
+
+instance ToMultipart Tmp HyperVergeSelfieValidationReq where
+  toMultipart HyperVergeSelfieValidationReq {..} =
+    MultipartData
+      []
+      [FileData "image" (T.pack image) "" image]
+
+data FaceDetails = FaceDetails
+  { liveFace :: ResultElement,
+    qualityChecks :: Maybe QualityChecks
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON, ToSchema)
+
+data SummaryDetails = SummaryDetails
+  { code :: Text,
+    message :: Text
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON, ToSchema)
+
+data Summary = Summary
+  { action :: Text,
+    details :: [SummaryDetails]
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON, ToSchema)
+
+data QualityChecks = QualityChecks
+  { eyesClosed :: Maybe ResultElement,
+    maskPresent :: Maybe ResultElement,
+    multipleFaces :: Maybe ResultElement,
+    blur :: Maybe ResultElement,
+    hat :: Maybe ResultElement,
+    sunglasses :: Maybe ResultElement,
+    readingGlasses :: Maybe ResultElement,
+    bright :: Maybe ResultElement,
+    dull :: Maybe ResultElement,
+    headTurned :: Maybe ResultElement,
+    lowQuality :: Maybe ResultElement
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON, ToSchema)
+
+data ResultElement = ResultElement
+  { confidence :: Text,
+    value :: Text
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON, ToSchema)
+
+data ValidationResult = ValidationResult
+  { error :: Maybe Text,
+    details :: Maybe FaceDetails,
+    summary :: Maybe Summary
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON, ToSchema)
+
+data MetaData = MetaData
+  { requestId :: Text,
+    transactionId :: Maybe Text
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON, ToSchema)
+
+data HyperVergeSelfieValidationRes = HyperVergeSelfieValidationRes
+  { status :: Text,
+    statusCode :: Int,
+    result :: Maybe ValidationResult,
+    metadata :: Maybe MetaData,
+    error :: Maybe Text
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON, ToSchema)

lib/mobility-core/src/Kernel/External/Verification/Interface.hs

@@ -29,10 +29,10 @@ import qualified Kernel.External.Verification.GovtData.Client as GovtData
 import Kernel.External.Verification.GovtData.Storage.Beam as BeamGRC
 import Kernel.External.Verification.GovtData.Types as Reexport
 import Kernel.External.Verification.Idfy.Config as Reexport
+import qualified Kernel.External.Verification.Interface.HyperVerge as HV
 import qualified Kernel.External.Verification.Interface.Idfy as Idfy
 import qualified Kernel.External.Verification.Interface.InternalScripts as IS
 import Kernel.External.Verification.Interface.Types as Reexport
-import Kernel.External.Verification.InternalScripts.Types
 import Kernel.External.Verification.Types as Reexport
 import Kernel.Tools.Metrics.CoreMetrics.Types
 import Kernel.Types.Common
@@ -50,6 +50,7 @@ verifyDLAsync serviceConfig req = case serviceConfig of
   IdfyConfig cfg -> Idfy.verifyDLAsync cfg req
   GovtDataConfig -> throwError $ InternalError "Not Implemented!"
   FaceVerificationConfig _ -> throwError $ InternalError "Not Implemented!"
+  HyperVergeConfig _ -> throwError $ InternalError "Not Implemented!"
 
 verifyRC ::
   ( EncFlow m r,
@@ -93,6 +94,7 @@ verifyRC' serviceConfig req = case serviceConfig of
   IdfyConfig cfg -> Idfy.verifyRCAsync cfg req
   GovtDataConfig -> GovtData.verifyRC req
   FaceVerificationConfig _ -> throwError $ InternalError "Not Implemented!"
+  HyperVergeConfig _ -> throwError $ InternalError "Not Implemented!"
 
 validateImage ::
   ( EncFlow m r,
@@ -105,6 +107,7 @@ validateImage serviceConfig req = case serviceConfig of
   IdfyConfig cfg -> Idfy.validateImage cfg req
   GovtDataConfig -> throwError $ InternalError "Not Implemented!"
   FaceVerificationConfig _ -> throwError $ InternalError "Not Implemented!"
+  HyperVergeConfig _ -> throwError $ InternalError "Not Implemented!"
 
 validateFaceImage ::
   ( CoreMetrics m,
@@ -117,6 +120,7 @@ validateFaceImage serviceConfig req = case serviceConfig of
   IdfyConfig _ -> throwError $ InternalError "Not Implemented!"
   GovtDataConfig -> throwError $ InternalError "Not Implemented!"
   FaceVerificationConfig cfg -> IS.validateFace cfg req
+  HyperVergeConfig cfg -> HV.validateFace cfg req
 
 extractRCImage ::
   ( EncFlow m r,
@@ -129,6 +133,7 @@ extractRCImage serviceConfig req = case serviceConfig of
   IdfyConfig cfg -> Idfy.extractRCImage cfg req
   GovtDataConfig -> throwError $ InternalError "Not Implemented!"
   FaceVerificationConfig _ -> throwError $ InternalError "Not Implemented!"
+  HyperVergeConfig _ -> throwError $ InternalError "Not Implemented!"
 
 extractDLImage ::
   ( EncFlow m r,
@@ -141,3 +146,4 @@ extractDLImage serviceConfig req = case serviceConfig of
   IdfyConfig cfg -> Idfy.extractDLImage cfg req
   GovtDataConfig -> throwError $ InternalError "Not Implemented!"
   FaceVerificationConfig _ -> throwError $ InternalError "Not Implemented!"
+  HyperVergeConfig _ -> throwError $ InternalError "Not Implemented!"

lib/mobility-core/src/Kernel/External/Verification/Interface/HyperVerge.hs

@@ -0,0 +1,40 @@
+module Kernel.External.Verification.Interface.HyperVerge where
+
+import qualified Kernel.External.Verification.HyperVerge.Flow as HVFlow
+import qualified Kernel.External.Verification.HyperVerge.Types as HyperVerge
+import qualified Kernel.External.Verification.Interface.Types as Interface
+import qualified Kernel.External.Verification.InternalScripts.Types as InternalScripts
+import Kernel.Prelude hiding (error)
+import Kernel.Tools.Metrics.CoreMetrics (CoreMetrics)
+import Kernel.Types.Common
+import Kernel.Utils.Logging (logDebug)
+
+validateFace :: (CoreMetrics m, MonadFlow m) => HyperVerge.HyperVergeConfig -> Interface.FaceValidationReq -> m Interface.FaceValidationRes
+validateFace hvCfg req = do
+  let url = hvCfg.url
+  let appId = hvCfg.appId
+  let appKey = hvCfg.appKey
+  let transactionId = req.transactionId
+  let hvReq = makeHyperVergeSelfieValidationReq req
+  res <- HVFlow.callHyperVergeFaceValidationAPI url transactionId appId appKey hvReq
+  logDebug $ "HyperVerge Response (before converting into Int. type) is :" <> show res --HVTODO: Remove this
+  resp <- makeHyperVergeSelfieValidationResp res
+  logDebug $ "HyperVerge Parsed Response is :" <> show resp --HVTODO: Remove this
+  return resp
+  where
+    makeHyperVergeSelfieValidationReq Interface.FaceValidationReq {..} = HyperVerge.HyperVergeSelfieValidationReq {..}
+    makeHyperVergeSelfieValidationResp HyperVerge.HyperVergeSelfieValidationRes {..} = do
+      let (faceType, confidence) = case result of
+            Nothing -> (InternalScripts.UNKNOWN, Nothing)
+            Just r -> case r.details of
+              Nothing -> (InternalScripts.UNKNOWN, Nothing)
+              Just HyperVerge.FaceDetails {..} -> case liveFace.value of
+                "yes" -> (InternalScripts.REAL_FACE, Just liveFace.confidence)
+                "no" -> (InternalScripts.FAKE_FACE, Just liveFace.confidence)
+                _ -> (InternalScripts.UNKNOWN, Just liveFace.confidence)
+      return $
+        Interface.FaceValidationRes
+          { score = Nothing,
+            predictionCost = Nothing,
+            ..
+          }