From 0b17136d965ddc602a5a0176b538bdb0a47f4d12 Mon Sep 17 00:00:00 2001
From: alexwl <alexey.a.kiryushin@gmail.com>
Date: Fri, 8 Feb 2019 00:34:54 +0300
Subject: Fix search for '.' and '..' identifiers

---
 app/Server.hs | 34 +++++++++++++++++++++++-----------
 1 file changed, 23 insertions(+), 11 deletions(-)

(limited to 'app/Server.hs')

diff --git a/app/Server.hs b/app/Server.hs
index 9160ba6..62e556f 100644
--- a/app/Server.hs
+++ b/app/Server.hs
@@ -730,7 +730,7 @@ loadPackages _config mbStore
          eitherGlobalReferenceMap <*>
          eitherGlobalIdentifierMap of
       Right res -> return $ Just res
-      Left e -> do        
+      Left _ -> do        
         putStrLn "Store lookup errors : "
         let ignoreRight :: Either a b -> Either a ()
             ignoreRight = second (const ())
@@ -908,7 +908,7 @@ handleSync onError =
 --------------------------------------------------------------------------------
 
 type API = GetAllPackages
-  :<|> GetDefinitionSite  
+  :<|> GetDefinitionSite
   :<|> GetExpressions
   :<|> GetReferences
   :<|> GetIdentifiers
@@ -1097,7 +1097,7 @@ getDefinitionSite ::
   -> HCE.LocatableEntity
   -> T.Text
   -> ReaderT Environment IO HCE.DefinitionSite
-getDefinitionSite packageId componentId modName entity name =
+getDefinitionSite packageId componentId modName entity name' =
   withPackageInfo packageId $ \packageInfo' ->
     withModulePath packageInfo' componentId modName $ \modPath ->
       let findDefSite ::
@@ -1113,7 +1113,8 @@ getDefinitionSite packageId componentId modName entity name =
                   Nothing
               _ -> do
                 let mbDefinitionSite =
-                      case entity of
+                      let name = fixDots name'
+                      in case entity of
                         HCE.Typ ->
                           HM.lookup (HCE.OccName name) $
                           HCE.types (defSiteMap :: HCE.DefinitionSiteMap)
@@ -1131,7 +1132,7 @@ getDefinitionSite packageId componentId modName entity name =
                     BSL.concat
                       [ toLazyBS . T.pack $ show entity
                       , " "
-                      , toLazyBS name
+                      , toLazyBS name'
                       , " "
                       , " not found in module "
                       , toLazyBS $ HCE.getHaskellModulePath modPath
@@ -1163,7 +1164,16 @@ getDefinitionSite packageId componentId modName entity name =
               case eitherDefinitionSiteMap of
                 Right definitionSiteMap -> findDefSite pId definitionSiteMap
                 Left e -> error500 (BSL.fromStrict $ BSC.pack e)
-              
+
+-- | "." and ".." is a special case because of the Path Segment Normalization:
+-- https://tools.ietf.org/html/rfc3986#section-6.2.2.3
+-- The segments “..” and “.” can be removed from a URL by a browser.
+-- https://stackoverflow.com/questions/3856693/a-url-resource-that-is-a-dot-2e
+fixDots :: T.Text -> T.Text
+fixDots " ." = "."
+fixDots " .." = ".."
+fixDots t = t
+
 buildLinkHeader :: T.Text -> Paginated a -> Natural -> Natural -> T.Text
 buildLinkHeader url paginated currentPage perPage =
   T.intercalate
@@ -1367,9 +1377,10 @@ findIdentifiers ::
   -> Maybe Int
   -> Maybe Int
   -> ReaderT Environment IO (Headers '[ Header "Link" T.Text, Header "X-Total-Count" Int] [HCE.ExternalIdentifierInfo])
-findIdentifiers packageId query mbPage mbPerPage =
+findIdentifiers packageId query' mbPage mbPerPage =  
   withPackageInfo packageId $ \packageInfo' ->
-    let respond identifiers = do
+    let query = fixDots query'
+        respond identifiers = do
           (paginatedIdentifiers, page, perPage, totalCount) <-
             paginateItems mbPage mbPerPage identifiers
           let url =
@@ -1379,7 +1390,7 @@ findIdentifiers packageId query mbPage mbPerPage =
                   (Proxy :: Proxy API)
                   (Proxy :: Proxy GetIdentifiers)
                   packageId
-                  query
+                  query'
                   Nothing
                   Nothing
               linkHeader = buildLinkHeader url paginatedIdentifiers page perPage
@@ -1435,7 +1446,8 @@ findGlobalIdentifiers ::
   -> Maybe Int
   -> Maybe Int
   -> ReaderT Environment IO (Headers '[ Header "Link" T.Text, Header "X-Total-Count" Int] [HCE.ExternalIdentifierInfo])
-findGlobalIdentifiers query mbPage mbPerPage = do
+findGlobalIdentifiers query' mbPage mbPerPage = do
+  let query = fixDots query'
   globalIdentifierMap <- asks envGlobalIdentifierMap
   let maxItems = 500
   let identifiers
@@ -1451,7 +1463,7 @@ findGlobalIdentifiers query mbPage mbPerPage = do
         safeLink
           (Proxy :: Proxy API)
           (Proxy :: Proxy GetGlobalIdentifiers)
-          query
+          query'
           Nothing
           Nothing
       linkHeader = buildLinkHeader url paginatedIdentifiers page perPage
-- 
cgit v1.2.3