fix: csp-sandbox downloads
This commit is contained in:
parent
211ff5eacc
commit
50cbba114a
@ -37,6 +37,7 @@ import Control.Monad.Logger
|
||||
sendThisFile :: DBFile -> Handler TypedContent
|
||||
sendThisFile File{..}
|
||||
| Just fileContent' <- fileContent = do
|
||||
setCSPSandbox
|
||||
setContentDisposition' . Just $ takeFileName fileTitle
|
||||
let cType = simpleContentType (mimeLookup $ pack fileTitle) <> "; charset=utf-8"
|
||||
respondSourceDB cType $
|
||||
@ -45,7 +46,8 @@ sendThisFile File{..}
|
||||
|
||||
sendFileReference :: forall file a. HasFileReference file => file -> Handler a
|
||||
sendFileReference (view (_FileReference . _1) -> fRef@FileReference{..}) = do
|
||||
when (is _Just fileReferenceContent) $
|
||||
when (is _Just fileReferenceContent) $ do
|
||||
setCSPSandbox
|
||||
setContentDisposition' . Just $ takeFileName fileReferenceTitle
|
||||
let cType = simpleContentType (mimeLookup $ pack fileReferenceTitle) <> "; charset=utf-8"
|
||||
join . runDB $ respondFileConditional Nothing cType fRef
|
||||
@ -77,6 +79,7 @@ serveSomeFiles' archiveName source = do
|
||||
[] -> notFound
|
||||
[file] -> either sendFileReference sendThisFile file
|
||||
_moreFiles -> do
|
||||
setCSPSandbox
|
||||
setContentDisposition' $ Just archiveName
|
||||
respondSourceDB typeZip $ do
|
||||
let zipComment = T.encodeUtf8 $ pack archiveName
|
||||
@ -97,6 +100,7 @@ serveZipArchive' archiveName source = do
|
||||
case results of
|
||||
[] -> notFound
|
||||
_moreFiles -> do
|
||||
setCSPSandbox
|
||||
setContentDisposition' $ Just archiveName
|
||||
respondSourceDB typeZip $ do
|
||||
let zipComment = T.encodeUtf8 $ pack archiveName
|
||||
|
||||
@ -1052,6 +1052,9 @@ setContentDisposition cd (fmap pack -> mFName) = replaceOrAddHeader (decodeUtf8
|
||||
| otherwise
|
||||
= toPathPiece cd
|
||||
|
||||
setCSPSandbox :: MonadHandler m => m ()
|
||||
setCSPSandbox = replaceOrAddHeader "Content-Security-Policy" "sandbox;"
|
||||
|
||||
------------------
|
||||
-- Cryptography --
|
||||
------------------
|
||||
|
||||
Loading…
Reference in New Issue
Block a user