Backend/fix/ondc_compliance_changes

lib/mobility-core/mobility-core.cabal

@@ -576,6 +576,7 @@ library
       Kernel.Utils.Servant.API
       Kernel.Utils.Servant.BaseUrl
       Kernel.Utils.Servant.BasicAuth
+      Kernel.Utils.Servant.BecknResponseWrapper
       Kernel.Utils.Servant.Client
       Kernel.Utils.Servant.HeaderAuth
       Kernel.Utils.Servant.HTML

lib/mobility-core/src/Kernel/Types/Beckn/Ack.hs

@@ -16,13 +16,15 @@ module Kernel.Types.Beckn.Ack where
 
 import qualified Control.Lens as L
 import Data.Aeson
-import qualified Data.Aeson.Key as AesonKey (Key)
 import Data.Aeson.Types (unexpected)
 import qualified Data.HashMap.Strict.InsOrd as HMSIO
 import Data.OpenApi
 import EulerHS.Prelude
+import qualified Kernel.Types.Beckn.Error as BError
 
-data AckResponse = Ack
+data AckResponse
+  = Ack
+  | Nack BError.Error
   deriving (Generic, Show)
 
 instance ToSchema AckResponse where
@@ -32,13 +34,13 @@ instance ToSchema AckResponse where
         mempty
           & type_ L.?~ OpenApiObject
           & properties
-            L..~ HMSIO.singleton "message" messageSchema
+            L..~ HMSIO.fromList [("message", messageSchema), ("error", errorSchema)]
           & required L..~ ["message"]
     where
       statusSchema =
         (mempty :: Schema)
           & type_ L.?~ OpenApiString
-          & enum_ L.?~ ["ACK"]
+          & enum_ L.?~ ["ACK", "NACK"]
           & Inline
       ackSchema =
         (mempty :: Schema)
@@ -54,19 +56,60 @@ instance ToSchema AckResponse where
             L..~ HMSIO.singleton "ack" ackSchema
           & required L..~ ["ack"]
           & Inline
+      codeSchema = (mempty :: Schema) & type_ L.?~ OpenApiString & Inline
+      messageFieldSchema = (mempty :: Schema) & type_ L.?~ OpenApiString & Inline
+      errorSchema =
+        (mempty :: Schema)
+          & type_ L.?~ OpenApiObject
+          & properties
+            L..~ HMSIO.fromList [("code", codeSchema), ("message", messageFieldSchema)]
+          & required L..~ ["code"]
+          & Inline
 
+-- ONDC TRV10 v2.1.0 envelope: `{message: {ack: {status}}, error?: {code, message}}`.
+-- Error carries only `code` and `message` — the internal `type` and `path` fields are
+-- not emitted (spec-optional, and we keep those in the in-memory Error record for logs).
+--
+-- Parser accepts the unwrapped shape (spec). A WAI-level wrapper middleware in the BPP
+-- optionally rewraps outgoing bodies in `{response: ...}` for deployments whose BAPs
+-- expect that shape; the response-wrapper middleware is the only place that knows about
+-- the wrapper, keeping the wire-format contract explicit.
 instance FromJSON AckResponse where
-  parseJSON = withObject "Ack" $ \v -> do
+  parseJSON = withObject "AckResponse" $ \v -> do
+    -- Accept both unwrapped (spec) and wrapped ({response: {...}}) bodies — the wrapper
+    -- is handled by middleware at emit time, but a peer may echo our wrapped output back.
+    inner <- (v .: "response") <|> pure v
     status <-
-      (v .: "message")
+      (inner .: "message")
         >>= (.: "ack")
         >>= (.: "status")
-    unless (status == String "ACK") (unexpected status)
-    pure Ack
+    case status of
+      String "ACK" -> pure Ack
+      String "NACK" -> do
+        errObj <- inner .: "error"
+        errCode <- errObj .: "code"
+        errMsg <- errObj .:? "message"
+        pure $
+          Nack
+            BError.Error
+              { BError._type = BError.INTERNAL_ERROR,
+                BError.code = errCode,
+                BError.path = Nothing,
+                BError.message = errMsg
+              }
+      other -> unexpected other
 
 instance ToJSON AckResponse where
-  toJSON Ack = "message" .== "ack" .== "status" .== String "ACK"
-    where
-      (.==) :: AesonKey.Key -> Value -> Value
-      k .== v = Object (k .= v)
-      infixr 9 .==
+  toJSON Ack =
+    object
+      [ "message" .= object ["ack" .= object ["status" .= ("ACK" :: Text)]]
+      ]
+  toJSON (Nack err) =
+    object
+      [ "message" .= object ["ack" .= object ["status" .= ("NACK" :: Text)]],
+        "error"
+          .= object
+            [ "code" .= BError.code err,
+              "message" .= BError.message err
+            ]
+      ]

lib/mobility-core/src/Kernel/Types/Error.hs

@@ -1142,21 +1142,32 @@ instance IsAPIError CallStatusError
 data ServiceabilityError
   = RideNotServiceable
   | RideNotServiceableInState Text
-  deriving (Eq, Show, IsBecknAPIError)
+  | UnserviceableTripCategory Text
+  deriving (Eq, Show)
 
 instanceExceptionWithParent 'HTTPException ''ServiceabilityError
 
 instance IsBaseError ServiceabilityError where
-  toMessage RideNotServiceable = Just "Requested ride is not serviceable due to georestrictions."
-  toMessage (RideNotServiceableInState state_) = Just ("Selected state " <> state_ <> " is not serviceable since it does not fall within the state boundary.")
+  toMessage RideNotServiceable = Just "Route Serviceability error"
+  toMessage (RideNotServiceableInState state_) = Just ("Route Serviceability error: selected state " <> state_ <> " is not serviceable.")
+  toMessage (UnserviceableTripCategory cat) = Just ("Route Serviceability error: unserviceable trip category " <> cat <> ".")
 
 instance IsHTTPError ServiceabilityError where
   toErrorCode = \case
     RideNotServiceable -> "RIDE_NOT_SERVICEABLE"
     RideNotServiceableInState _ -> "RIDE_NOT_SERVICEABLE_IN_STATE"
+    UnserviceableTripCategory _ -> "UNSERVICEABLE_TRIP_CATEGORY"
   toHttpCode = \case
     RideNotServiceable -> E400
     RideNotServiceableInState _ -> E400
+    UnserviceableTripCategory _ -> E400
+
+-- ONDC v2.1.0 mandates numeric error codes in NACK responses. "90201" is
+-- "Route Serviceability error" per the ONDC mobility spec. Keep the internal
+-- toErrorCode for metrics/logs, and surface the ONDC code via toOndcErrorCode
+-- which is what the BecknAPIError JSON actually emits.
+instance IsBecknAPIError ServiceabilityError where
+  toOndcErrorCode _ = Just "90201"
 
 instance IsAPIError ServiceabilityError
 

lib/mobility-core/src/Kernel/Types/Error/BaseError/HTTPError/BecknAPIError.hs

@@ -32,21 +32,48 @@ class IsBecknAPIError e where
   toPath :: e -> Maybe Text
   toPath _ = Nothing
 
+  toOndcErrorCode :: e -> Maybe Text
+  toOndcErrorCode _ = Nothing
+
 newtype BecknAPIError = BecknAPIError Error.Error
   deriving (Generic, Eq, Show)
 
+-- ONDC TRV10 v2.1.0 shape: `{message: {ack: {status: "NACK"}}, error: {code, message}}`.
+-- The error object carries only `code` and `message` — internal `type` and `path`
+-- remain in the Haskell Error record for logs/metrics but are not emitted. Optional
+-- `"response"` wrapping for deployments that need it is handled by WAI middleware at
+-- the HTTP edge, not here.
 instance FromJSON BecknAPIError where
-  parseJSON (Object v) = BecknAPIError <$> v .: "error"
+  parseJSON (Object v) = do
+    -- Accept both unwrapped (spec) and wrapped `{response: {...}}` bodies in case a peer
+    -- echoes back our wrapped output.
+    inner <- (v .: "response") <|> pure v
+    errObj <- inner .: "error"
+    errCode <- errObj .: "code"
+    errMsg <- errObj .:? "message"
+    pure $
+      BecknAPIError
+        Error.Error
+          { Error._type = Error.INTERNAL_ERROR,
+            Error.code = errCode,
+            Error.path = Nothing,
+            Error.message = errMsg
+          }
   parseJSON invalid =
     prependFailure
       "Parsing BecknAPIError failed, "
       (typeMismatch "Object" invalid)
 
 instance ToJSON BecknAPIError where
-  toJSON (BecknAPIError err) = object ["message" .= ack, "error" .= err]
-    where
-      ack = object ["ack" .= status]
-      status = object ["status" .= ("NACK" :: Text)]
+  toJSON (BecknAPIError err) =
+    object
+      [ "message" .= object ["ack" .= object ["status" .= ("NACK" :: Text)]],
+        "error"
+          .= object
+            [ "code" .= Error.code err,
+              "message" .= Error.message err
+            ]
+      ]
 
 instance FromResponse BecknAPIError where
   fromResponse = fromJsonResponse

lib/mobility-core/src/Kernel/Utils/Error/BaseError/HTTPError/BecknAPIError.hs

@@ -109,7 +109,7 @@ toBecknAPIError e =
   BecknAPIError
     Error
       { _type = toType e,
-        code = toErrorCode e,
+        code = fromMaybe (toErrorCode e) (toOndcErrorCode e),
         path = toPath e,
         message = toMessageIfNotInternal e
       }