module Mensam.Server.Server.FileServer where

import Control.Monad.IO.Unlift
import Control.Monad.Logger.CallStack
import Data.Text qualified as T
import WaiAppStatic.Storage.Filesystem
import WaiAppStatic.Types

fileServerSettings ::
  (MonadLogger m, MonadUnliftIO m) =>
  FilePath ->
  m StaticSettings
fileServerSettings :: forall (m :: * -> *).
(MonadLogger m, MonadUnliftIO m) =>
FilePath -> m StaticSettings
fileServerSettings FilePath
path =
  ((forall a. m a -> IO a) -> IO StaticSettings) -> m StaticSettings
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO StaticSettings)
 -> m StaticSettings)
-> ((forall a. m a -> IO a) -> IO StaticSettings)
-> m StaticSettings
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
    StaticSettings -> IO StaticSettings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StaticSettings -> IO StaticSettings)
-> StaticSettings -> IO StaticSettings
forall a b. (a -> b) -> a -> b
$ case FilePath -> StaticSettings
defaultWebAppSettings FilePath
path of
      defaultSettings :: StaticSettings
defaultSettings@StaticSettings {Pieces -> IO LookupResult
ssLookupFile :: Pieces -> IO LookupResult
ssLookupFile :: StaticSettings -> Pieces -> IO LookupResult
ssLookupFile, File -> IO MimeType
ssGetMimeType :: File -> IO MimeType
ssGetMimeType :: StaticSettings -> File -> IO MimeType
ssGetMimeType} ->
        StaticSettings
defaultSettings
          { ssLookupFile = \Pieces
pieces -> do
              m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> (Text -> m ()) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Looking up file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Pieces -> FilePath
forall a. Show a => a -> FilePath
show Pieces
pieces)
              Pieces -> IO LookupResult
ssLookupFile Pieces
pieces
          , ssGetMimeType = \File
file -> do
              MimeType
mimeType <- File -> IO MimeType
ssGetMimeType File
file
              m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> (Text -> m ()) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Determined mime type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (MimeType -> FilePath
forall a. Show a => a -> FilePath
show MimeType
mimeType)
              MimeType -> IO MimeType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MimeType
mimeType
          , ssAddTrailingSlash = True -- Disable directory overview without trailing slash, because some links are broken.
          }