From 184a8c517a587e2279104dfb142a65464fac0c7f Mon Sep 17 00:00:00 2001
From: anton-k <a.kholomyev@tinkoff.ru>
Date: Thu, 19 Oct 2023 21:12:51 +0300
Subject: [PATCH] Fixes bug in routes

---
 mig/src/Mig/Core/Api.hs        | 13 ++++++++-----
 mig/src/Mig/Core/Types/Info.hs |  5 ++---
 2 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/mig/src/Mig/Core/Api.hs b/mig/src/Mig/Core/Api.hs
index 736f8f7..3ab8001 100644
--- a/mig/src/Mig/Core/Api.hs
+++ b/mig/src/Mig/Core/Api.hs
@@ -91,15 +91,18 @@ toNormalApi api = ApiNormal $ fmap (fmap toInputMediaMap . toOutputMediaMap) (to
     toInputMediaMap = InputMediaMap . toMediaMapBy getInputType
 
     toOutputMediaMap :: Api (Route.Route m) -> OutputMediaMap (Api (Route.Route m))
-    toOutputMediaMap = OutputMediaMap . toMediaMapBy (\routeInfo -> routeInfo.output.media)
+    toOutputMediaMap = OutputMediaMap . toMediaMapBy (\routeInfo -> Just routeInfo.output.media)
 
-    toMediaMapBy :: (RouteInfo -> MediaType) -> Api (Route.Route m) -> MediaMap (Api (Route.Route m))
+    toMediaMapBy :: (RouteInfo -> Maybe MediaType) -> Api (Route.Route m) -> MediaMap (Api (Route.Route m))
     toMediaMapBy getMedia a =
-      MediaMap (toMediaApi <$> medias) a
+      MediaMap (filterAnyCases $ toMediaApi <$> medias) a
       where
-        medias = Set.toList $ foldMap (\route -> Set.singleton (getMedia route.info)) a
+        medias = Set.toList $ foldMap (\route -> maybe Set.empty Set.singleton (getMedia route.info)) a
 
-        toMediaApi media = (media, filterApi (\route -> getMedia route.info == media) a)
+        toMediaApi media = (media, filterApi (\route -> getMedia route.info == Just media) a)
+
+        -- filter out any cases as they are covered by second argument of MediaMap value
+        filterAnyCases = filter (("*/*" /= ) . fst)
 
 -- | Read sub-api by HTTP method, accept-type and content-type
 fromNormalApi :: Method -> ByteString -> ByteString -> ApiNormal a -> Maybe (Api a)
diff --git a/mig/src/Mig/Core/Types/Info.hs b/mig/src/Mig/Core/Types/Info.hs
index 917a9bd..6c06f0a 100644
--- a/mig/src/Mig/Core/Types/Info.hs
+++ b/mig/src/Mig/Core/Types/Info.hs
@@ -30,7 +30,6 @@ module Mig.Core.Types.Info (
 
 import Data.List.Extra (firstJust)
 import Data.Map.Strict qualified as Map
-import Data.Maybe
 import Data.OpenApi
 import Data.OpenApi.Declare (runDeclare)
 import Data.Proxy
@@ -104,8 +103,8 @@ data RouteInput
   deriving (Show, Eq)
 
 -- | Get input media-type
-getInputType :: RouteInfo -> MediaType
-getInputType route = fromMaybe "*/*" $ firstJust (fromInput . (.content)) route.inputs
+getInputType :: RouteInfo -> Maybe MediaType
+getInputType route = firstJust (fromInput . (.content)) route.inputs
   where
     fromInput = \case
       ReqBodyInput ty _ -> Just ty