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
}