WIP: feat: Fleet Engine (ODRD) REST client, config and JWT auth

lib/mobility-core/mobility-core.cabal

@@ -85,6 +85,10 @@ library
       Kernel.External.EventTracking.Moengage.Flow
       Kernel.External.EventTracking.Moengage.Types
       Kernel.External.EventTracking.Types
+      Kernel.External.FleetEngine.Auth
+      Kernel.External.FleetEngine.Client
+      Kernel.External.FleetEngine.Config
+      Kernel.External.FleetEngine.Types
       Kernel.External.GoogleTranslate.API
       Kernel.External.GoogleTranslate.Client
       Kernel.External.GoogleTranslate.Types

lib/mobility-core/src/Kernel/External/FleetEngine/Auth.hs

@@ -0,0 +1,54 @@
+{-
+  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 Kernel.External.FleetEngine.Auth
+  ( TokenScope (..),
+    fleetEngineAudience,
+    parseServiceAccount,
+    mintFleetEngineToken,
+  )
+where
+
+import qualified Data.Aeson as A
+import qualified Data.Text.Encoding as TE
+import Kernel.Prelude
+import qualified Kernel.Utils.JWT as JWT
+
+-- | Audience for self-signed Fleet Engine JWTs (server, driver and consumer).
+fleetEngineAudience :: Text
+fleetEngineAudience = "https://fleetengine.googleapis.com/"
+
+-- | What a minted token is scoped to. Consumer/driver tokens carry an
+-- @authorization@ claim restricting them to a single trip/vehicle; server
+-- tokens carry no restriction (the service-account role grants access).
+data TokenScope
+  = -- | scoped to a tripId
+    ConsumerToken Text
+  | -- | scoped to a vehicleId
+    DriverToken Text
+  | ServerToken
+
+-- | Decode the (decrypted) service-account JSON text.
+parseServiceAccount :: Text -> Either String JWT.ServiceAccount
+parseServiceAccount = A.eitherDecodeStrict . TE.encodeUtf8
+
+-- | Mint a short-lived self-signed Fleet Engine JWT for the given scope.
+mintFleetEngineToken :: JWT.ServiceAccount -> TokenScope -> Integer -> IO (Either String Text)
+mintFleetEngineToken sa scope ttlSeconds =
+  JWT.createSignedJWTWithClaims sa fleetEngineAudience ttlSeconds (authClaims scope)
+  where
+    authClaims :: TokenScope -> [(Text, A.Value)]
+    authClaims (ConsumerToken tripId) = [("authorization", A.object ["tripid" A..= tripId])]
+    authClaims (DriverToken vehicleId) = [("authorization", A.object ["vehicleid" A..= vehicleId])]
+    authClaims ServerToken = []

lib/mobility-core/src/Kernel/External/FleetEngine/Client.hs

@@ -0,0 +1,148 @@
+{-
+  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 Kernel.External.FleetEngine.Client
+  ( defaultFleetEngineBaseUrl,
+    createTrip,
+    updateTrip,
+    updateTripStatus,
+    assignVehicleAndStart,
+  )
+where
+
+import qualified Data.Aeson as A
+import qualified Data.Text as T
+import EulerHS.Types (EulerClient, client)
+import Kernel.External.FleetEngine.Types
+import Kernel.Prelude
+import Kernel.Tools.Metrics.CoreMetrics (CoreMetrics)
+import Kernel.Types.Common
+import Kernel.Utils.Common
+import Servant hiding (throwError)
+import Servant.Client (Scheme (..))
+
+type CreateTripAPI =
+  "v1"
+    :> "providers"
+    :> Capture "providerId" Text
+    :> "trips"
+    :> MandatoryQueryParam "tripId" Text
+    :> Header "Authorization" Text
+    :> ReqBody '[JSON] Trip
+    :> Post '[JSON] A.Value
+
+type UpdateTripAPI =
+  "v1"
+    :> "providers"
+    :> Capture "providerId" Text
+    :> "trips"
+    :> Capture "tripId" Text
+    :> MandatoryQueryParam "updateMask" Text
+    :> Header "Authorization" Text
+    :> ReqBody '[JSON] Trip
+    :> Patch '[JSON] A.Value
+
+defaultFleetEngineBaseUrl :: BaseUrl
+defaultFleetEngineBaseUrl =
+  BaseUrl
+    { baseUrlScheme = Https,
+      baseUrlHost = "fleetengine.googleapis.com",
+      baseUrlPort = 443,
+      baseUrlPath = ""
+    }
+
+createTripClient :: Text -> Text -> Maybe Text -> Trip -> EulerClient A.Value
+createTripClient = client (Proxy :: Proxy CreateTripAPI)
+
+updateTripClient :: Text -> Text -> Text -> Maybe Text -> Trip -> EulerClient A.Value
+updateTripClient = client (Proxy :: Proxy UpdateTripAPI)
+
+bearer :: Text -> Maybe Text
+bearer token = Just ("Bearer " <> token)
+
+-- | Create a Fleet Engine trip. @tripId@ is the (1:1) BPP ride id, which makes
+-- this idempotent: a re-issued CreateTrip for an existing trip returns
+-- ALREADY_EXISTS and is treated as success.
+createTrip ::
+  (CoreMetrics m, MonadFlow m, MonadReader r m, HasRequestId r) =>
+  BaseUrl ->
+  Text -> -- providerId
+  Text -> -- token (server JWT)
+  Text -> -- tripId
+  Trip ->
+  m ()
+createTrip baseUrl providerId token tripId trip = do
+  result <-
+    callAPI
+      baseUrl
+      (createTripClient providerId tripId (bearer token) trip)
+      "fleetEngineCreateTrip"
+      (Proxy :: Proxy CreateTripAPI)
+  case result of
+    Right _ -> logInfo $ "FleetEngine: created trip " <> tripId
+    Left err
+      | "ALREADY_EXISTS" `T.isInfixOf` show err ->
+        logInfo $ "FleetEngine: trip already exists (idempotent no-op) " <> tripId
+      | otherwise -> logError $ "FleetEngine: createTrip failed for " <> tripId <> ": " <> show err
+
+-- | PATCH a trip with the given field mask and body.
+updateTrip ::
+  (CoreMetrics m, MonadFlow m, MonadReader r m, HasRequestId r) =>
+  BaseUrl ->
+  Text -> -- providerId
+  Text -> -- token (server JWT)
+  Text -> -- tripId
+  Text -> -- updateMask (comma-separated field paths)
+  Trip ->
+  m ()
+updateTrip baseUrl providerId token tripId updateMask trip = do
+  result <-
+    callAPI
+      baseUrl
+      (updateTripClient providerId tripId updateMask (bearer token) trip)
+      "fleetEngineUpdateTrip"
+      (Proxy :: Proxy UpdateTripAPI)
+  case result of
+    Right _ -> logInfo $ "FleetEngine: updated trip " <> tripId <> " [" <> updateMask <> "]"
+    Left err -> logError $ "FleetEngine: updateTrip failed for " <> tripId <> ": " <> show err
+
+-- | Convenience: advance a trip's status.
+updateTripStatus ::
+  (CoreMetrics m, MonadFlow m, MonadReader r m, HasRequestId r) =>
+  BaseUrl ->
+  Text ->
+  Text ->
+  Text ->
+  TripStatus ->
+  m ()
+updateTripStatus baseUrl providerId token tripId status =
+  updateTrip baseUrl providerId token tripId "tripStatus" (emptyTrip {tripStatus = Just status})
+
+-- | Convenience: assign the vehicle to the trip and move it to ENROUTE_TO_PICKUP.
+assignVehicleAndStart ::
+  (CoreMetrics m, MonadFlow m, MonadReader r m, HasRequestId r) =>
+  BaseUrl ->
+  Text ->
+  Text ->
+  Text -> -- tripId
+  Text -> -- vehicleId
+  m ()
+assignVehicleAndStart baseUrl providerId token tripId vehicleId =
+  updateTrip
+    baseUrl
+    providerId
+    token
+    tripId
+    "tripStatus,vehicleId"
+    (emptyTrip {tripStatus = Just ENROUTE_TO_PICKUP, vehicleId = Just vehicleId})

lib/mobility-core/src/Kernel/External/FleetEngine/Config.hs

@@ -0,0 +1,48 @@
+{-
+  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 Kernel.External.FleetEngine.Config where
+
+import Kernel.External.Encryption
+import Kernel.Prelude
+
+-- | Per-merchant-operating-city Fleet Engine (On-demand Rides & Deliveries)
+-- configuration. Modelled on 'Kernel.External.Maps.Google.Config.GoogleCfg':
+-- the service-account JSON is stored encrypted and decrypted server-side only
+-- (it is never shipped to apps; the backend mints short-lived scoped JWTs from
+-- it). Absence of this config in a city is treated as "feature off" by callers.
+data FleetEngineCfg = FleetEngineCfg
+  { -- | GCP project id that owns the Fleet Engine provider (the @providers/{id}@ path segment)
+    providerId :: Text,
+    -- | Fleet Engine REST host; defaults to https://fleetengine.googleapis.com when unset
+    fleetEngineUrl :: Maybe BaseUrl,
+    -- | Service-account JSON (raw JSON text), encrypted at rest
+    serviceAccountJson :: EncryptedField 'AsEncrypted Text,
+    -- | TTL (seconds) for consumer (rider) SDK tokens; defaults to 'defaultConsumerTokenTtl'
+    consumerTokenTtlSeconds :: Maybe Integer,
+    -- | TTL (seconds) for driver SDK tokens; defaults to 'defaultDriverTokenTtl'
+    driverTokenTtlSeconds :: Maybe Integer,
+    -- | TTL (seconds) for server-to-server tokens; defaults to 'defaultServerTokenTtl'
+    serverTokenTtlSeconds :: Maybe Integer
+  }
+  deriving (Generic, Show, Eq, ToJSON, FromJSON)
+
+defaultConsumerTokenTtl :: Integer
+defaultConsumerTokenTtl = 15 * 60
+
+defaultDriverTokenTtl :: Integer
+defaultDriverTokenTtl = 60 * 60
+
+defaultServerTokenTtl :: Integer
+defaultServerTokenTtl = 60 * 60

lib/mobility-core/src/Kernel/External/FleetEngine/Types.hs

@@ -0,0 +1,96 @@
+{-
+  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 Kernel.External.FleetEngine.Types where
+
+import qualified Data.Aeson as A
+import Kernel.Prelude
+
+-- | Lifecycle of a Fleet Engine trip. JSON values must match the Fleet Engine
+-- REST enum spelling exactly (the constructor names are used verbatim).
+data TripStatus
+  = UNKNOWN_TRIP_STATUS
+  | NEW
+  | ENROUTE_TO_PICKUP
+  | ARRIVED_AT_PICKUP
+  | ENROUTE_TO_INTERMEDIATE_DESTINATION
+  | ARRIVED_AT_INTERMEDIATE_DESTINATION
+  | ENROUTE_TO_DROPOFF
+  | COMPLETE
+  | CANCELED
+  deriving (Show, Eq, Generic, ToJSON, FromJSON)
+
+data TripType
+  = UNKNOWN_TRIP_TYPE
+  | SHARED
+  | EXCLUSIVE
+  deriving (Show, Eq, Generic, ToJSON, FromJSON)
+
+data LatLng = LatLng
+  { latitude :: Double,
+    longitude :: Double
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON)
+
+-- | A Fleet Engine TerminalLocation (only the @point@ is required for our use).
+newtype TerminalLocation = TerminalLocation
+  { point :: LatLng
+  }
+  deriving (Show, Eq, Generic, ToJSON, FromJSON)
+
+-- | The subset of the Fleet Engine @Trip@ resource we read/write. All fields are
+-- optional so the same record serves as both the CreateTrip body and the
+-- (masked) UpdateTrip body. @Nothing@ fields are omitted from the JSON so they
+-- never clobber server state on a PATCH.
+data Trip = Trip
+  { tripType :: Maybe TripType,
+    tripStatus :: Maybe TripStatus,
+    vehicleId :: Maybe Text,
+    numberOfPassengers :: Maybe Int,
+    pickupPoint :: Maybe TerminalLocation,
+    dropoffPoint :: Maybe TerminalLocation
+  }
+  deriving (Show, Eq, Generic)
+
+tripJSONOptions :: A.Options
+tripJSONOptions = A.defaultOptions {A.omitNothingFields = True}
+
+instance ToJSON Trip where
+  toJSON = A.genericToJSON tripJSONOptions
+
+instance FromJSON Trip where
+  parseJSON = A.genericParseJSON tripJSONOptions
+
+emptyTrip :: Trip
+emptyTrip =
+  Trip
+    { tripType = Nothing,
+      tripStatus = Nothing,
+      vehicleId = Nothing,
+      numberOfPassengers = Nothing,
+      pickupPoint = Nothing,
+      dropoffPoint = Nothing
+    }
+
+-- | Build the CreateTrip body. Fleet Engine requires @tripType@; pickup/dropoff
+-- are optional but improve ETA quality.
+mkCreateTripBody :: TripType -> Maybe LatLng -> Maybe LatLng -> Maybe Int -> Trip
+mkCreateTripBody tType mbPickup mbDropoff mbPassengers =
+  emptyTrip
+    { tripType = Just tType,
+      tripStatus = Just NEW,
+      pickupPoint = TerminalLocation <$> mbPickup,
+      dropoffPoint = TerminalLocation <$> mbDropoff,
+      numberOfPassengers = mbPassengers
+    }