content: {-
   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 Domain.Action.Beckn.FRFS.OnSearch where
  
  import qualified API.Types.UI.FRFSTicketService as API
  import qualified BecknV2.FRFS.Enums as Spec
  import Data.Aeson
  import Data.List (sortBy)
  import Data.Ord (Down (..))
  import qualified Data.Text as T
  import Domain.Types.Extra.FRFSCachedQuote as CachedQuote
  import qualified Domain.Types.FRFSFarePolicy as FRFSFarePolicy
  import qualified Domain.Types.FRFSQuote as Quote
  import qualified Domain.Types.FRFSQuoteCategory as DFRFSQuoteCategory
  import qualified Domain.Types.FRFSQuoteCategorySpec as DFRFSQuoteCategory
  import qualified Domain.Types.FRFSRouteFareProduct as FRFSRouteFareProduct
  import qualified Domain.Types.FRFSSearch as Search
  import qualified Domain.Types.FRFSTicketCategoryMetadataConfig as DFRFSTicketCategoryMetadataConfig
  import qualified Domain.Types.FRFSVehicleServiceTier as FRFSVehicleServiceTier
  import qualified Domain.Types.IntegratedBPPConfig as DIBC
  import qualified Domain.Types.JourneyLeg as DJourneyLeg
  import Domain.Types.Merchant
  import Domain.Types.MerchantOperatingCity
  import qualified Domain.Types.StationType as Station
  import qualified Domain.Types.StopFare as StopFare
  import qualified Domain.Types.Trip as DTripTypes
  import EulerHS.Prelude (comparing, toStrict)
  import Kernel.Beam.Functions
  import Kernel.External.Maps.Types
  import Kernel.Prelude
  import Kernel.Storage.Esqueleto.Config
  import Kernel.Types.Error
  import Kernel.Types.Id
  import qualified Kernel.Types.TimeBound as DTB
  import Kernel.Utils.Common
  import qualified Lib.JourneyModule.Types as JourneyTypes
  import qualified Lib.JourneyModule.Utils as JourneyUtils
  import qualified SharedLogic.CreateFareForMultiModal as SLCF
  import qualified SharedLogic.FRFSUtils as SFU
  import qualified SharedLogic.IntegratedBPPConfig as SIBC
  import qualified Storage.CachedQueries.FRFSConfig as CQFRFSConfig
  import qualified Storage.CachedQueries.FRFSVehicleServiceTier as CQVSR
  import qualified Storage.CachedQueries.Merchant as QMerch
  import qualified Storage.CachedQueries.Merchant.RiderConfig as QRC
  import qualified Storage.CachedQueries.OTPRest.OTPRest as OTPRest
  import qualified Storage.Queries.FRFSFarePolicy as QFFP
  import qualified Storage.Queries.FRFSQuote as QQuote
  -- import qualified Storage.Queries.FRFSQuoteBreakup as QFRFSQuoteBreakup
  import qualified Storage.Queries.FRFSQuoteCategory as QFRFSQuoteCategory
  import qualified Storage.Queries.FRFSRouteFareProduct as QFRFP
  import qualified Storage.Queries.FRFSSearch as QSearch
  import qualified Storage.Queries.FRFSTicketCategoryMetadataConfig as QFRFSTicketCategoryMetadataConfig
  import qualified Storage.Queries.FRFSVehicleServiceTier as QVSR
  import qualified Storage.Queries.JourneyLeg as QJourneyLeg
  import qualified Storage.Queries.PersonStats as QPStats
  import qualified Storage.Queries.StopFare as QRSF
  import Tools.Error
  import qualified Tools.Metrics.BAPMetrics as Metrics
  
  data DOnSearch = DOnSearch
    { bppSubscriberId :: Text,
      bppSubscriberUrl :: Text,
      providerDescription :: Maybe Text,
      providerId :: Text,
      providerName :: Text,
      quotes :: [DQuote],
      validTill :: Maybe UTCTime,
      transactionId :: Text,
      messageId :: Text,
      bppDelayedInterest :: Maybe Text
    }
    deriving (Show)
  
  data DVehicleServiceTier = DVehicleServiceTier
    { serviceTierType :: Spec.ServiceTierType,
      serviceTierProviderCode :: Text,
      serviceTierShortName :: Text,
      serviceTierDescription :: Text,
      serviceTierLongName :: Text,
      isAirConditioned :: Maybe Bool
    }
    deriving (Show)
  
  data DQuote = DQuote
    { bppItemId :: Text,
      routeCode :: Text,
      price :: Price,
      childPrice :: Maybe Price,
      vehicleType :: Spec.VehicleCategory,
      routeStations :: [DRouteStation],
      stations :: [DStation],
      categories :: [DCategory],
      fareDetails :: Maybe Quote.FRFSFareDetails,
      _type :: Quote.FRFSQuoteType
    }
    deriving (Show)
  
  data DCategory = DCategory
    { code :: Text,
      title :: Text,
      description :: Text,
      tnc :: Text,
      price :: Price,
      offeredPrice :: Price,
      eligibility :: Bool,
      bppItemId :: Text
    }
    deriving (Show)
  
  data DRouteStation = DRouteStation
    { routeCode :: Text,
      routeLongName :: Text,
      routeShortName :: Text,
      routeStartPoint :: LatLong,
      routeEndPoint :: LatLong,
      routeStations :: [DStation],
      routeTravelTime :: Maybe Seconds,
      routeSequenceNum :: Maybe Int,
      routeServiceTier :: Maybe DVehicleServiceTier,
      routePrice :: Price,
      routeColor :: Maybe Text,
      routeFarePolicyId :: Maybe (Id FRFSFarePolicy.FRFSFarePolicy)
    }
    deriving (Show)
  
  data DStation = DStation
    { stationCode :: Text,
      stationName :: Text,
      stationLat :: Maybe Double,
      stationLon :: Maybe Double,
      stationType :: Station.StationType,
      stopSequence :: Maybe Int,
      towards :: Maybe Text
    }
    deriving (Show)
  
  data ValidatedDOnSearch = ValidatedDOnSearch
    { merchant :: Merchant,
      search :: Search.FRFSSearch,
      ticketsBookedInEvent :: Int,
      isEventOngoing :: Bool,
      mbFreeTicketInterval :: Maybe Int,
      mbMaxFreeTicketCashback :: Maybe Int
    }
    deriving (Show)
  
  validateRequest :: (EsqDBFlow m r, EsqDBReplicaFlow m r, CacheFlow m r) => DOnSearch -> m ValidatedDOnSearch
  validateRequest DOnSearch {..} = do
    search <- runInReplica $ QSearch.findById (Id transactionId) >>= fromMaybeM (SearchRequestDoesNotExist transactionId)
    let merchantId = search.merchantId
    merchant <- QMerch.findById merchantId >>= fromMaybeM (MerchantNotFound merchantId.getId)
    frfsConfig <- CQFRFSConfig.findByMerchantOperatingCityIdInRideFlow search.merchantOperatingCityId [] >>= fromMaybeM (InternalError $ "FRFS config not found for merchant operating city Id " <> show search.merchantOperatingCityId)
    if frfsConfig.isEventOngoing == Just True && search.riderId /= SFU.partnerOrgRiderId
      then do
        stats <- QPStats.findByPersonId search.riderId >>= fromMaybeM (InternalError "Person stats not found")
        return ValidatedDOnSearch {merchant, search, ticketsBookedInEvent = fromMaybe 0 stats.ticketsBookedInEvent, isEventOngoing = True, mbFreeTicketInterval = frfsConfig.freeTicketInterval, mbMaxFreeTicketCashback = frfsConfig.maxFreeTicketCashback}
      else return ValidatedDOnSearch {merchant, search, ticketsBookedInEvent = 0, isEventOngoing = False, mbFreeTicketInterval = Nothing, mbMaxFreeTicketCashback = Nothing}
  
  onSearch ::
    ( EsqDBFlow m r,
      EsqDBReplicaFlow m r,
      CacheFlow m r,
      HasShortDurationRetryCfg r c,
      Metrics.HasBAPMetrics m r
    ) =>
    DOnSearch ->
    ValidatedDOnSearch ->
    m ()
  onSearch onSearchReq validatedReq = do
    Metrics.finishMetrics Metrics.SEARCH_FRFS validatedReq.merchant.name validatedReq.search.id.getId validatedReq.search.merchantOperatingCityId.getId
    integratedBPPConfig <- SIBC.findIntegratedBPPConfigFromEntity validatedReq.search
    case integratedBPPConfig.providerConfig of
      DIBC.ONDC _ -> do
        updatedQuotes <- mapM (updateQuote integratedBPPConfig) onSearchReq.quotes
        onSearchHelper (onSearchReq {quotes = updatedQuotes}) validatedReq integratedBPPConfig
      _ -> do
        onSearchHelper onSearchReq validatedReq integratedBPPConfig
    where
      updateQuote integratedBPPConfig quote = do
        stations <-
          forM quote.stations \station -> do
            stationCode <- OTPRest.getStopCodeFromProviderCode integratedBPPConfig station.stationCode
            return $ station {stationCode = fromMaybe station.stationCode stationCode}
        return $ quote {stations = stations}
  
  onSearchHelper :: (EsqDBFlow m r, EsqDBReplicaFlow m r, CacheFlow m r, HasShortDurationRetryCfg r c) => DOnSearch -> ValidatedDOnSearch -> DIBC.IntegratedBPPConfig -> m ()
  onSearchHelper onSearchReq validatedReq integratedBPPConfig = do
    quotesCreatedByCache <- QQuote.findAllBySearchId (Id onSearchReq.transactionId)
    mbJourneyLeg <- QJourneyLeg.findByLegSearchId (Just onSearchReq.transactionId)
    quotes <- traverse (mkQuotes onSearchReq validatedReq) onSearchReq.quotes
    traverse_ cacheQuote quotes
    if null quotesCreatedByCache
      then QQuote.createMany quotes
      else do
        zippedQuotes <- verifyAndZipQuotes quotesCreatedByCache quotes
        let updatedQuotes = map updateQuotes zippedQuotes
        for_ updatedQuotes \quote -> QQuote.updateCachedQuoteByPrimaryKey quote
    let search = validatedReq.search
    mbRequiredQuote <- filterQuotes integratedBPPConfig quotes mbJourneyLeg
    case mbRequiredQuote of
      Just requiredQuote -> do
        void $ SLCF.createFares search.id.getId requiredQuote.id.getId
        QJourneyLeg.updateEstimatedFaresBySearchId (Just requiredQuote.price.amount) (Just requiredQuote.price.amount) (Just validatedReq.search.id.getId)
      Nothing -> do
        QSearch.updateOnSearchFailed validatedReq.search.id (Just True)
    QSearch.updateIsOnSearchReceivedById (Just True) validatedReq.search.id
    fork "Updating Route Stop Fare" $ do
      forM_ onSearchReq.quotes $ \quote -> do
        -- Only cache Single Journey tickets, ignore Return Journey tickets
        when (quote._type == Quote.SingleJourney) $ do
          -- This `null quote.routeStation` check is to ensure that we only update the fare for the route stations if they are present in the quote.
          dStartStation <- getStartStation quote.stations & fromMaybeM (InternalError "Start station not found")
          dEndStation <- getEndStation quote.stations & fromMaybeM (InternalError "End station not found")
          if null quote.routeStations
            then do
              if quote.vehicleType == Spec.METRO
                then do
                  QRSF.findAllByStartStopAndIntegratedBPPConfigId dStartStation.stationCode dEndStation.stationCode integratedBPPConfig.id >>= \case
                    routeStopFares@(_ : _) -> do
                      let farePolicyIds = map (.farePolicyId) routeStopFares
                      traverse_ (\fp -> QRSF.updateFareByStopCodes quote.price.amount fp dStartStation.stationCode dEndStation.stationCode) farePolicyIds
                    [] -> do
                      QFRFP.findAllByIntegratedBPPConfigId integratedBPPConfig.id >>= \case
                        fareProducts@(_ : _) -> do
                          let farePolicyIds = map (.farePolicyId) fareProducts
                          traverse_ (\farePolicyId -> createStopFare farePolicyId dStartStation.stationCode dEndStation.stationCode quote search.merchantId search.merchantOperatingCityId integratedBPPConfig.id) farePolicyIds
                        [] -> do
                          createEntriesInFareTables search.merchantId search.merchantOperatingCityId quote integratedBPPConfig.id
                else do
                  QFRFP.findByRouteCode quote.routeCode integratedBPPConfig.id >>= \case
                    fareProducts@(_ : _) -> do
                      let farePolicyIds = map (.farePolicyId) fareProducts
                      farePolicies <- QFFP.findAllByIds farePolicyIds
                      let filteredFarePolicies = filter (\fp -> fp._type == FRFSFarePolicy.MatrixBased) farePolicies
                      traverse_ (\fp -> QRSF.updateFareByStopCodes quote.price.amount fp.id dStartStation.stationCode dEndStation.stationCode) filteredFarePolicies
                    [] -> do
                      createEntriesInFareTables search.merchantId search.merchantOperatingCityId quote integratedBPPConfig.id
            else do
              forM_ quote.routeStations $ \routeStation -> do
                let price = routeStation.routePrice.amount
                    mbStartStopCode = find (\station -> station.stationType == Station.START) routeStation.routeStations <&> (.stationCode)
                    mbEndStopCode = find (\station -> station.stationType == Station.END) routeStation.routeStations <&> (.stationCode)
                whenJust ((,,) <$> routeStation.routeFarePolicyId <*> mbStartStopCode <*> mbEndStopCode) $ \(farePolicyId, startStopCode, endStopCode) ->
                  QRSF.updateFareByStopCodes price farePolicyId startStopCode endStopCode
    return ()
    where
      cacheQuote quote = do
        let key =
              CachedQuote.FRFSCachedQuoteKey
                { CachedQuote.fromStationId = quote.fromStationCode,
                  CachedQuote.toStationId = quote.toStationCode,
                  CachedQuote.providerId = quote.providerId,
                  CachedQuote.quoteType = quote._type
                }
        CachedQuote.cacheByFRFSCachedQuoteKey key CachedQuote.FRFSCachedQuote {CachedQuote.price = quote.price, CachedQuote.stationsJson = quote.stationsJson}
      createStopFare farePolicyId startStopCode endStopCode quote merchantId merchantOperatingCityId integratedBppConfigId = do
        now <- getCurrentTime
        let stopFare =
              StopFare.StopFare
                { farePolicyId,
                  startStopCode = startStopCode,
                  endStopCode = endStopCode,
                  amount = quote.price.amount,
                  currency = quote.price.currency,
                  merchantId,
                  merchantOperatingCityId,
                  integratedBppConfigId,
                  createdAt = now,
                  updatedAt = now
                }
        QRSF.create stopFare
  
  filterQuotes :: (EsqDBFlow m r, EsqDBReplicaFlow m r, CacheFlow m r) => DIBC.IntegratedBPPConfig -> [Quote.FRFSQuote] -> Maybe DJourneyLeg.JourneyLeg -> m (Maybe Quote.FRFSQuote)
  filterQuotes _ [] _ = return Nothing
  filterQuotes _ _ Nothing = return Nothing
  filterQuotes integratedBPPConfig quotes (Just journeyLeg) = do
    filteredQuotes <- case journeyLeg.serviceTypes of
      Just serviceTypes -> do
        return $
          quotes
            & filter
              ( \quote ->
                  maybe False (\serviceTier -> serviceTier.serviceTierType `elem` serviceTypes) (JourneyTypes.getServiceTierFromQuote quote)
                    && isRouteBasedQuote quote
              )
      Nothing -> return $ filter isRouteBasedQuote quotes
    let finalQuotes = if null filteredQuotes then quotes else filteredQuotes
    case journeyLeg.mode of
      DTripTypes.Bus -> do
        mbRiderConfig <- QRC.findByMerchantOperatingCityId journeyLeg.merchantOperatingCityId Nothing
        let cfgMap = maybe (JourneyUtils.toCfgMap JourneyUtils.defaultBusTierSortingConfig) JourneyUtils.toCfgMap (mbRiderConfig >>= (.busTierSortingConfig))
        let serviceTierTypeFromQuote quote = JourneyTypes.getServiceTierFromQuote quote <&> (.serviceTierType)
        return $
          Just $
            minimumBy
              ( \quote1 quote2 ->
                  compare
                    (maybe maxBound (JourneyUtils.tierRank cfgMap) (serviceTierTypeFromQuote quote1))
                    (maybe maxBound (JourneyUtils.tierRank cfgMap) (serviceTierTypeFromQuote quote2))
              )
              finalQuotes
      _ -> return $ Just $ minimumBy (\quote1 quote2 -> compare quote1.price.amount.getHighPrecMoney quote2.price.amount.getHighPrecMoney) finalQuotes
    where
      isRouteBasedQuote quote =
        -- TODO :: Can be used across all, but as we don't want to break others we are doing this only for ONDC
        case integratedBPPConfig.providerConfig of
          DIBC.ONDC config ->
            (config.routeBasedQuoteSelection /= Just True)
              || maybe
                True
                ( \(routeStationsJson :: [API.FRFSRouteStationsAPI], firstRouteDetail) ->
                    any (\route -> Just route.code == firstRouteDetail.routeCode) routeStationsJson
                )
                ((,) <$> (decodeFromText =<< quote.routeStationsJson) <*> (listToMaybe journeyLeg.routeDetails))
          _ -> True
  
  mkQuotes :: (EsqDBFlow m r, EsqDBReplicaFlow m r, CacheFlow m r, HasShortDurationRetryCfg r c) => DOnSearch -> ValidatedDOnSearch -> DQuote -> m Quote.FRFSQuote
  mkQuotes dOnSearch ValidatedDOnSearch {..} DQuote {..} = do
    dStartStation <- getStartStation stations & fromMaybeM (InternalError "Start station not found")
    dEndStation <- getEndStation stations & fromMaybeM (InternalError "End station not found")
    integratedBPPConfig <- SIBC.findIntegratedBPPConfigFromEntity search
    startStation <- OTPRest.getStationByGtfsIdAndStopCode dStartStation.stationCode integratedBPPConfig >>= fromMaybeM (InternalError $ "Station not found for stationCode: " <> dStartStation.stationCode <> " and integratedBPPConfigId: " <> integratedBPPConfig.id.getId)
    endStation <- OTPRest.getStationByGtfsIdAndStopCode dEndStation.stationCode integratedBPPConfig >>= fromMaybeM (InternalError $ "Station not found for stationCode: " <> dEndStation.stationCode <> " and integratedBPPConfigId: " <> integratedBPPConfig.id.getId)
    let stationsJSON = stations & map (castStationToAPI integratedBPPConfig.id) & encodeToText
    let routeStationsJSON = routeStations & map (castRouteStationToAPI integratedBPPConfig.id) & encodeToText
    let categoriesJSON = categories & map castCategoryToAPI & encodeToText
    uid <- generateGUID
    now <- getCurrentTime
    let (discountedTickets, eventDiscountAmount) = SFU.getDiscountInfo isEventOngoing mbFreeTicketInterval mbMaxFreeTicketCashback price search.quantity ticketsBookedInEvent
    let validTill = fromMaybe (addUTCTime (intToNominalDiffTime 900) now) dOnSearch.validTill -- If validTill is not present, set it to 15 minutes from now
    let frfsQuote =
          Quote.FRFSQuote
            { Quote._type = _type,
              Quote.bppItemId,
              Quote.bppSubscriberId = dOnSearch.bppSubscriberId,
              Quote.bppSubscriberUrl = dOnSearch.bppSubscriberUrl,
              Quote.fromStationCode = startStation.code,
              Quote.toStationCode = endStation.code,
              Quote.id = uid,
              Quote.price,
              Quote.childPrice,
              Quote.estimatedPrice = Just price,
              Quote.providerDescription = dOnSearch.providerDescription,
              Quote.providerId = dOnSearch.providerId,
              Quote.providerName = dOnSearch.providerName,
              Quote.quantity = search.quantity,
              Quote.riderId = search.riderId,
              Quote.searchId = search.id,
              Quote.stationsJson = stationsJSON,
              Quote.routeStationsJson = Just routeStationsJSON,
              Quote.discountsJson = Just categoriesJSON,
              Quote.validTill,
              Quote.vehicleType,
              Quote.merchantId = search.merchantId,
              Quote.merchantOperatingCityId = search.merchantOperatingCityId,
              Quote.partnerOrgId = search.partnerOrgId,
              Quote.partnerOrgTransactionId = search.partnerOrgTransactionId,
              Quote.createdAt = now,
              Quote.updatedAt = now,
              Quote.integratedBppConfigId = search.integratedBppConfigId,
              Quote.childTicketQuantity = Nothing,
              Quote.multimodalSearchRequestId = search.multimodalSearchRequestId,
              bppDelayedInterest = readMaybe . T.unpack =<< dOnSearch.bppDelayedInterest,
              oldCacheDump = Nothing,
              ..
            }
  
    forM_ categories $ \category -> do
      quoteCategoryIdForDiscount <- generateGUID
      ticketCategoryMetadataConfig' <- QFRFSTicketCategoryMetadataConfig.findByCategoryVehicleAndCity (getQuoteCategoryType category.code) vehicleType search.merchantOperatingCityId >>= fromMaybeM (InternalError $ "Ticket category metadata config not found for city and category: " <> category.code <> " " <> show vehicleType <> " " <> search.merchantOperatingCityId.getId)
  
      let quoteCategoryForDiscount =
            DFRFSQuoteCategory.FRFSQuoteCategory
              { id = quoteCategoryIdForDiscount,
                quoteId = uid,
                bppItemId = category.bppItemId,
                price = category.price,
                offeredPrice = category.offeredPrice,
                maxTicketAllowed = Nothing,
                merchantId = search.merchantId,
                merchantOperatingCityId = search.merchantOperatingCityId,
                ticketCategoryMetadataConfig = ticketCategoryMetadataConfig',
                selectedQuantity = Nothing,
                createdAt = now,
                updatedAt = now
              }
  
      -- quoteBreakupDiscountsId <- generateGUID
      -- let quoteBreakupDiscounts =
      --       DFRFSQuoteBreakup.FRFSQuoteBreakup
      --         { id = quoteBreakupDiscountsId,
      --           quoteId = uid,
      --           quoteCategoryId = quoteCategoryIdForDiscount,
      --           tag = getCategoryPriceTags category.code,
      --           value = show category.offeredPrice.amount,
      --           merchantId = search.merchantId,
      --           merchantOperatingCityId = search.merchantOperatingCityId,
      --           createdAt = now,
      --           updatedAt = now
      --         }
  
      QFRFSQuoteCategory.create quoteCategoryForDiscount
    -- QFRFSQuoteBreakup.create quoteBreakupDiscounts
  
    return frfsQuote
  
  getStartStation :: [DStation] -> Maybe DStation
  getStartStation = find (\station -> station.stationType == Station.START)
  
  getEndStation :: [DStation] -> Maybe DStation
  getEndStation = find (\station -> station.stationType == Station.END)
  
  castStationToAPI :: Id DIBC.IntegratedBPPConfig -> DStation -> API.FRFSStationAPI
  castStationToAPI integratedBppConfigId DStation {..} =
    API.FRFSStationAPI
      { API.address = Nothing,
        API.code = stationCode,
        API.parentStopCode = Nothing,
        API.routeCodes = Nothing,
        API.color = Nothing,
        API.lat = stationLat,
        API.lon = stationLon,
        API.name = Just stationName,
        API.stationType = Just stationType,
        API.sequenceNum = stopSequence,
        API.distance = Nothing,
        API.towards = Nothing,
        API.timeTakenToTravelUpcomingStop = Nothing,
        API.integratedBppConfigId = integratedBppConfigId
      }
  
  castRouteStationToAPI :: Id DIBC.IntegratedBPPConfig -> DRouteStation -> API.FRFSRouteStationsAPI
  castRouteStationToAPI integratedBppConfigId DRouteStation {..} =
    API.FRFSRouteStationsAPI
      { API.code = routeCode,
        API.color = routeColor,
        API.startPoint = routeStartPoint,
        API.endPoint = routeEndPoint,
        API.longName = routeLongName,
        API.shortName = routeShortName,
        API.sequenceNum = routeSequenceNum,
        API.travelTime = routeTravelTime,
        API.vehicleServiceTier = castVehicleServiceTierAPI <$> routeServiceTier,
        API.priceWithCurrency = mkPriceAPIEntity routePrice,
        API.stations = map (castStationToAPI integratedBppConfigId) routeStations
      }
  
  castVehicleServiceTierAPI :: DVehicleServiceTier -> API.FRFSVehicleServiceTierAPI
  castVehicleServiceTierAPI DVehicleServiceTier {..} =
    API.FRFSVehicleServiceTierAPI
      { _type = serviceTierType,
        providerCode = serviceTierProviderCode,
        description = serviceTierDescription,
        longName = serviceTierLongName,
        shortName = serviceTierShortName,
        isAirConditioned = isAirConditioned
      }
  
  castCategoryToAPI :: DCategory -> API.FRFSDiscountRes
  castCategoryToAPI DCategory {..} =
    API.FRFSDiscountRes
      { API.code = code,
        API.price = mkPriceAPIEntity price,
        API.title = title,
        API.description = description,
        API.tnc = tnc,
        API.eligibility = eligibility
      }
  
  isQuoteChanged :: (Quote.FRFSQuote, Quote.FRFSQuote) -> Bool
  isQuoteChanged (quotesFromCache, quotesFromOnSearch) = not $ quotesFromCache.price == quotesFromOnSearch.price && quotesFromCache.stationsJson == quotesFromOnSearch.stationsJson
  
  updateQuotes :: (Quote.FRFSQuote, Quote.FRFSQuote) -> Quote.FRFSQuote
  updateQuotes (quotesFromCache, quotesFromOnSearch) = do
    let oldCacheDump =
          if isQuoteChanged (quotesFromCache, quotesFromOnSearch)
            then Just (toJsonText FRFSCachedQuote {price = quotesFromCache.price, stationsJson = quotesFromCache.stationsJson})
            else Nothing
  
    Quote.FRFSQuote
      { Quote._type = quotesFromCache._type,
        Quote.bppItemId = quotesFromOnSearch.bppItemId,
        Quote.bppSubscriberId = quotesFromOnSearch.bppSubscriberId,
        Quote.bppSubscriberUrl = quotesFromOnSearch.bppSubscriberUrl,
        Quote.fromStationCode = quotesFromCache.fromStationCode,
        Quote.id = quotesFromCache.id,
        Quote.price = quotesFromOnSearch.price,
        Quote.childPrice = quotesFromOnSearch.childPrice,
        Quote.estimatedPrice = quotesFromOnSearch.estimatedPrice,
        Quote.providerDescription = quotesFromOnSearch.providerDescription,
        Quote.providerId = quotesFromCache.providerId,
        Quote.providerName = quotesFromCache.providerName,
        Quote.quantity = quotesFromOnSearch.quantity,
        Quote.riderId = quotesFromCache.riderId,
        Quote.searchId = quotesFromCache.searchId,
        Quote.stationsJson = quotesFromCache.stationsJson,
        Quote.routeStationsJson = quotesFromOnSearch.routeStationsJson,
        Quote.discountsJson = quotesFromOnSearch.discountsJson,
        Quote.toStationCode = quotesFromCache.toStationCode,
        Quote.validTill = quotesFromOnSearch.validTill,
        Quote.vehicleType = quotesFromCache.vehicleType,
        Quote.merchantId = quotesFromCache.merchantId,
        Quote.merchantOperatingCityId = quotesFromCache.merchantOperatingCityId,
        Quote.partnerOrgId = quotesFromCache.partnerOrgId,
        Quote.partnerOrgTransactionId = quotesFromCache.partnerOrgTransactionId,
        Quote.createdAt = quotesFromCache.createdAt,
        Quote.updatedAt = quotesFromCache.updatedAt,
        Quote.bppDelayedInterest = quotesFromOnSearch.bppDelayedInterest,
        Quote.oldCacheDump,
        Quote.fareDetails = quotesFromOnSearch.fareDetails,
        Quote.eventDiscountAmount = quotesFromOnSearch.eventDiscountAmount,
        Quote.integratedBppConfigId = quotesFromOnSearch.integratedBppConfigId,
        Quote.discountedTickets = quotesFromOnSearch.discountedTickets,
        Quote.childTicketQuantity = quotesFromOnSearch.childTicketQuantity,
        Quote.multimodalSearchRequestId = quotesFromOnSearch.multimodalSearchRequestId
      }
    where
      toJsonText :: FRFSCachedQuote -> Text
      toJsonText cachedQuote = toStrict $ decodeUtf8 $ encode cachedQuote
  
  verifyAndZipQuotes :: (MonadFlow m) => [Quote.FRFSQuote] -> [Quote.FRFSQuote] -> m [(Quote.FRFSQuote, Quote.FRFSQuote)]
  verifyAndZipQuotes quotesFromCache quotesFromOnSearch = do
    if length quotesFromCache /= length quotesFromOnSearch
      then throwError $ CachedFRFSQuoteAnomaly (show quotesFromCache) (show quotesFromOnSearch)
      else case (quotesFromCache, quotesFromOnSearch) of
        ([q1], [q2]) ->
          if q1._type == q2._type
            then return [(q1, q2)]
            else throwError $ CachedFRFSQuoteAnomaly (show quotesFromCache) (show quotesFromOnSearch)
        _ -> do
          let isBothQuotesValid = verifyQuote quotesFromCache && verifyQuote quotesFromOnSearch
          if isBothQuotesValid
            then do
              let sortedQ1 = sortBy (comparing (Down . Quote._type)) quotesFromCache
              let sortedQ2 = sortBy (comparing (Down . Quote._type)) quotesFromOnSearch
              return (zip sortedQ1 sortedQ2)
            else throwError $ CachedFRFSQuoteAnomaly (show quotesFromCache) (show quotesFromOnSearch)
    where
      verifyQuote quotes =
        length quotes == 2
          && any (\q -> q._type == Quote.SingleJourney) quotes
          && any (\q -> q._type == Quote.ReturnJourney) quotes
  
  createEntriesInFareTables :: (EsqDBFlow m r, EsqDBReplicaFlow m r, CacheFlow m r) => Id Merchant -> Id MerchantOperatingCity -> DQuote -> Id DIBC.IntegratedBPPConfig -> m ()
  createEntriesInFareTables merchantId merchantOperatingCityId quote integratedBppConfigId = do
    fareProductId <- generateGUID
    farePolicyId <- generateGUID
    now <- getCurrentTime
    let routeCode = quote.routeCode
        startStopCode = find (\station -> station.stationType == Station.START) quote.stations <&> (.stationCode)
        endStopCode = find (\station -> station.stationType == Station.END) quote.stations <&> (.stationCode)
    let farePolicy =
          FRFSFarePolicy.FRFSFarePolicy
            { id = farePolicyId,
              _type = FRFSFarePolicy.MatrixBased,
              applicableDiscountIds = [],
              description = "Matrix Based Fare Policy",
              cessCharge = Nothing,
              merchantId,
              merchantOperatingCityId,
              createdAt = now,
              updatedAt = now
            }
    let routeStopFare =
          StopFare.StopFare
            { farePolicyId,
              startStopCode = fromMaybe "" startStopCode,
              endStopCode = fromMaybe "" endStopCode,
              amount = quote.price.amount,
              currency = quote.price.currency,
              merchantId,
              merchantOperatingCityId,
              integratedBppConfigId,
              createdAt = now,
              updatedAt = now
            }
    (vehicleServiceTierId, vehicleServiceTier) <- do
      CQVSR.findByServiceTierAndMerchantOperatingCityIdAndIntegratedBPPConfigId Spec.ORDINARY merchantOperatingCityId integratedBppConfigId >>= \case
        Just vsc -> return (vsc.id, Nothing)
        Nothing -> do
          id <- generateGUID
          return
            ( id,
              Just $
                FRFSVehicleServiceTier.FRFSVehicleServiceTier
                  { id,
                    _type = Spec.ORDINARY,
                    providerCode = "ORDINARY",
                    description = "ORDINARY",
                    shortName = show quote.vehicleType,
                    longName = show quote.vehicleType,
                    isAirConditioned = Just False,
                    integratedBppConfigId,
                    merchantId,
                    merchantOperatingCityId,
                    createdAt = now,
                    updatedAt = now
                  }
            )
  
    let frfsRouteFareProduct =
          FRFSRouteFareProduct.FRFSRouteFareProduct
            { id = fareProductId,
              routeCode,
              vehicleType = quote.vehicleType,
              farePolicyId,
              vehicleServiceTierId = vehicleServiceTierId,
              merchantId,
              merchantOperatingCityId,
              timeBounds = DTB.Unbounded,
              integratedBppConfigId,
              createdAt = now,
              updatedAt = now
            }
    whenJust vehicleServiceTier $ \vsc -> do
      QVSR.create vsc
    QFRFP.create frfsRouteFareProduct
    QFFP.create farePolicy
    QRSF.create routeStopFare
  
  -- Helper function to get category tag based on discount code
  getCategoryPriceTags :: Text -> DFRFSQuoteCategory.FRFSCategoryTag
  getCategoryPriceTags code =
    case code of
      "ADULT" -> DFRFSQuoteCategory.ADULT_PRICE
      "FEMALE" -> DFRFSQuoteCategory.FEMALE_PRICE
      "MALE" -> DFRFSQuoteCategory.MALE_PRICE
      "CHILD" -> DFRFSQuoteCategory.CHILD_PRICE
      "SENIOR_CITIZEN" -> DFRFSQuoteCategory.SENIOR_CITIZEN_PRICE
      "STUDENT" -> DFRFSQuoteCategory.STUDENT_PRICE
      _ -> DFRFSQuoteCategory.ADULT_PRICE
  
  getQuoteCategoryType :: Text -> DFRFSTicketCategoryMetadataConfig.FRFSQuoteCategoryType
  getQuoteCategoryType code =
    case fromJSON (String code) of
      Success categoryType -> categoryType
      Data.Aeson.Error _ -> DFRFSTicketCategoryMetadataConfig.ADULT
  