Remove dependency on deprecated system-filepath

This patch removes `system-filepath` and tries to replace any existing
functionality that that package provides.

`system-filepath` has been deprecated in favor of `filepath`:
https://hackage.haskell.org/package/system-filepath

Author: hololeap

happstack-server.cabal

@@ -84,7 +84,6 @@ Library
                        process,
                        semigroups             >= 0.16,
                        sendfile               >= 0.7.1 && < 0.8,
-                       system-filepath        >= 0.3.1,
                        syb,
                        text                   >= 0.10  && < 1.3,
                        time,

src/Happstack/Server/FileServe/BuildingBlocks.hs

@@ -60,16 +60,18 @@ import Control.Monad.Trans          (MonadIO(liftIO))
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.ByteString.Char8 as S
 import Data.Data                    (Data, Typeable)
+import Data.Foldable                (toList)
 import Data.List                    (sort)
 import Data.Maybe                   (fromMaybe)
 import           Data.Map           (Map)
 import qualified Data.Map           as Map
-import Filesystem.Path.CurrentOS    (commonPrefix, encodeString, decodeString, collapse, append)
+import           Data.Sequence      (Seq ((:|>)), (|>))
+import qualified Data.Sequence      as Seq
 import Happstack.Server.Monads      (ServerMonad(askRq), FilterMonad, WebMonad)
 import Happstack.Server.Response    (ToMessage(toResponse), ifModifiedSince, forbidden, ok, seeOther)
 import Happstack.Server.Types       (Length(ContentLength), Request(rqPaths, rqUri), Response(SendFile), RsFlags(rsfLength), nullRsFlags, result, resultBS, setHeader)
 import System.Directory             (doesDirectoryExist, doesFileExist, getDirectoryContents, getModificationTime)
-import System.FilePath              ((</>), addTrailingPathSeparator, hasDrive, isPathSeparator, joinPath, takeExtension, isValid)
+import System.FilePath              ((</>), addTrailingPathSeparator, hasDrive, isPathSeparator, joinPath, takeExtension, isValid, normalise, splitPath)
 import System.IO                    (IOMode(ReadMode), hFileSize, hClose, openBinaryFile, withBinaryFile)
 import System.Log.Logger            (Priority(DEBUG), logM)
 import           Text.Blaze.Html             ((!))
@@ -384,14 +386,22 @@ fileServe' serveFn mimeFn indexFn localPath = do
 -- >>> combineSafe "/var/uploads/" "../uploads/home/../etc/passwd"
 -- Just "/var/uploads/etc/passwd"
 combineSafe :: FilePath -> FilePath -> Maybe FilePath
-combineSafe root path =
-    if commonPrefix [root', joined] == root'
-      then Just $ encodeString joined
-      else Nothing
+combineSafe root path = do
+    pathSeq <- go Seq.empty $ splitPath $ normalise path
+    let root' = normalise root
+    let path' = joinPath (toList pathSeq)
+    Just $ root' </> path'
   where
-    root'  = decodeString root
-    path'  = decodeString path
-    joined = collapse $ append root' path'
+    -- | Build up a 'Seq' representation of @path@, reducing any @..@ elements and returning
+    -- @'Nothing'@ if it tries to go up beyond its top level.
+    --
+    -- Note that this functionality has been removed from the filepath package
+    -- See: <https://neilmitchell.blogspot.com/2015/10/filepaths-are-subtle-symlinks-are-hard.html>
+    go :: Seq FilePath -> [FilePath] -> Maybe (Seq FilePath)
+    go p         []        = Just p
+    go Seq.Empty ("..":_ ) = Nothing -- Going up beyond the top level is not allowed
+    go (s :|> _) ("..":ps) = go s ps -- Going up a level pops an element off the right side of the Seq
+    go s         (p   :ps) = go (s |> p) ps -- Just add an element to the right side of the Seq
 
 isSafePath :: [FilePath] -> Bool
 isSafePath [] = True