put path sanitize function in utils

Author: jruehlow

service/src/Handler/Register.hs

@@ -108,7 +108,3 @@ checkPassword =
           then return $ Left ("Password must be at least 3 characters long" :: Text)
           else return $ Right password
     )
-
--- Helper to convert Int to Text
-showT :: (Show a) => a -> Text
-showT = T.pack . show

service/src/Handler/Replay.hs

@@ -23,13 +23,6 @@ getParagraph era source book paragraph = do
     [p] -> return p
     _ -> error "No paragraph found for this era."
 
-formatDuration :: Int -> Text
-formatDuration ms =
-  let totalSeconds = ms `div` 1000
-      (minutes, seconds) = totalSeconds `divMod` 60
-      pad2 n = if n < 10 then "0" <> show n else show n
-   in pack $ pad2 minutes <> ":" <> pad2 seconds
-
 getReplayR :: Text -> Handler Html
 getReplayR replayId = do
   Entity _ replay <- runDB $ getBy404 $ UniqueUuid replayId

service/src/Handler/SaveReplay.hs

@@ -93,12 +93,6 @@ getUuid = do
       d = fromIntegral (w2' .&. 0xFFFFFFFF) :: Word32
   pure $ toText (fromWords a b c d)
 
-diffInMilliseconds :: UTCTime -> UTCTime -> Int
-diffInMilliseconds t1 t2 =
-  let diffSeconds = diffUTCTime t1 t2
-      diffMillis = diffSeconds * 1000
-   in round diffMillis
-
 postSaveReplayR :: Handler Value
 postSaveReplayR = do
   userId <- requireAuthId

service/src/Import/NoFoundation.hs

@@ -1,12 +1,15 @@
 {-# LANGUAGE CPP #-}
+
 module Import.NoFoundation
-    ( module Import
-    ) where
+  ( module Import,
+  )
+where
 
-import ClassyPrelude.Yesod   as Import
-import Model                 as Import
-import Settings              as Import
-import Settings.StaticFiles  as Import
-import Yesod.Auth            as Import
-import Yesod.Core.Types      as Import (loggerSet)
+import ClassyPrelude.Yesod as Import
+import Import.Utils as Import
+import Model as Import
+import Settings as Import
+import Settings.StaticFiles as Import
+import Yesod.Auth as Import
+import Yesod.Core.Types as Import (loggerSet)
 import Yesod.Default.Config2 as Import

service/src/Import/Utils.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+module Import.Utils where
+
+import ClassyPrelude.Yesod (isInfixOf)
+import Data.Text (Text, pack)
+import Data.Time.Clock (UTCTime, diffUTCTime)
+import System.FilePath.Posix (joinPath, normalise, splitPath)
+
+diffInMilliseconds :: UTCTime -> UTCTime -> Int
+diffInMilliseconds t1 t2 =
+  let diffSeconds = diffUTCTime t1 t2
+      diffMillis = diffSeconds * 1000
+   in round diffMillis
+
+formatDuration :: Int -> Text
+formatDuration ms =
+  let totalSeconds = ms `div` 1000
+      (minutes, seconds) = totalSeconds `divMod` 60
+      pad2 n = if n < 10 then "0" <> show n else show n
+   in pack $ pad2 minutes <> ":" <> pad2 seconds
+
+class PathSanitizer a where
+  takeBaseName :: a -> FilePath
+
+instance PathSanitizer FilePath where
+  takeBaseName = sanitizePath
+
+sanitizePath :: FilePath -> FilePath
+sanitizePath p =
+  let (s, suffix) = case span (== '/') p of
+        (sl@('/' : '/' : _), rest) -> (sl, rest)
+        _ -> ("", dropWhile (== '/') p)
+      parts =
+        filter
+          ( \x ->
+              x `notElem` ["./", "../"]
+                && not (".." `isInfixOf` x)
+          )
+          . splitPath
+          . normalise
+          $ suffix
+   in s ++ joinPath parts
+
+showT :: (Show a) => a -> Text
+showT = pack . show

service/src/Model.hs

@@ -20,7 +20,6 @@ module Model where
 
 import ClassyPrelude.Yesod hiding (joinPath)
 import Database.Persist.Quasi
-import System.FilePath.Posix (joinPath, normalise, splitPath)
 import Yesod.Auth.HashDB (HashDBUser (..))
 
 data LobbyStatus = LobbyStatusWaiting | LobbyStatusInProgress | LobbyStatusFinished
@@ -32,28 +31,6 @@ instance ToJSON LobbyStatus
 
 instance FromJSON LobbyStatus
 
-class PathSanitizer a where
-  takeBaseName :: a -> FilePath
-
-instance PathSanitizer FilePath where
-  takeBaseName = sanitizePath
-
-sanitizePath :: FilePath -> FilePath
-sanitizePath p =
-  let (s, suffix) = case span (== '/') p of
-        (sl@('/' : '/' : _), rest) -> (sl, rest)
-        _ -> ("", dropWhile (== '/') p)
-      parts =
-        filter
-          ( \x ->
-              x `notElem` ["./", "../"]
-                && not (".." `isInfixOf` x)
-          )
-          . splitPath
-          . normalise
-          $ suffix
-   in s ++ joinPath parts
-
 share
   [mkPersist sqlSettings, mkMigrate "migrateAll"]
   $(persistFileWith lowerCaseSettings "config/models.persistentmodels")