diff --git a/src/Vervis/Avatar.hs b/src/Vervis/Avatar.hs index 01abd8a..160de7b 100644 --- a/src/Vervis/Avatar.hs +++ b/src/Vervis/Avatar.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2018 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -28,9 +28,8 @@ import Network.Wai (isSecure) import Yesod.Core (MonadHandler) import Yesod.Core.Handler (waiRequest) -getAvatarUrl :: MonadHandler m => Text -> m (Maybe Text) -getAvatarUrl email = do - secure <- isSecure <$> waiRequest +getAvatarUrl :: MonadHandler m => Bool -> Text -> m (Maybe Text) +getAvatarUrl secure email = do let opts = def { optSecure = secure , optTryGravatar = False diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 6255606..2cffa63 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -27,8 +27,9 @@ import Text.Hamlet (hamletFile) import Yesod.Auth.Account import Yesod.Auth.Account.Message (AccountMsg (MsgUsernameExists)) import Yesod.Auth.Message (AuthMessage (IdentifierNotFound)) -import Yesod.Default.Util (addStaticContentExternal) import Yesod.Core.Types (Logger) +import Yesod.Default.Util (addStaticContentExternal) + import Yesod.Mail.Send import qualified Yesod.Core.Unsafe as Unsafe diff --git a/src/Vervis/Handler/Person.hs b/src/Vervis/Handler/Person.hs index 6401f92..b44366e 100644 --- a/src/Vervis/Handler/Person.hs +++ b/src/Vervis/Handler/Person.hs @@ -31,6 +31,7 @@ import Text.Blaze.Html (toHtml) import Yesod.Auth.Account (newAccountR) import Vervis.Model.Ident +import Vervis.Secure import Vervis.Widget (avatarW) -- | Get list of users @@ -108,4 +109,5 @@ getPersonR ident = do Entity sid _s <- getBy404 $ UniqueSharer ident Entity _pid p <- getBy404 $ UniquePersonIdent sid return p + secure <- getSecure defaultLayout $(widgetFile "person") diff --git a/src/Vervis/Secure.hs b/src/Vervis/Secure.hs new file mode 100644 index 0000000..511e1e4 --- /dev/null +++ b/src/Vervis/Secure.hs @@ -0,0 +1,61 @@ +{- This file is part of Vervis. + - + - Written in 2018 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +-- | Sometimes we need to give the user a URL with a different domain than the +-- main web application, but with the same protocol scheme: If we're running in +-- HTTPS, then provide an HTTPS URL. And if we're running plain HTTP, provide +-- an HTTP URL (not because HTTPS is bad, but because we may be serving that +-- URL too and simply not providing SSL for it). +-- +-- In order to construct that URL, we need to figure out whether the request +-- we're serving is secured with HTTPS. +-- +-- Since the web app may be running behind a reverse proxy, checking the +-- request itself isn't enough - we need to know whether a reverse proxy may be +-- serving our web app via HTTPS. +-- +-- One way to detect that is @Forwarded@ headers in the request, but it seems +-- they can be faked, i.e. just inserted manually by an HTTP client. So our +-- approach here is to rely on the configured approot: If you use a reverse +-- proxy, specify the approot in your web app settings file, otherwise only the +-- request itself will be consulted. +module Vervis.Secure + ( getSecure + ) +where + +import Prelude + +import Control.Monad ((<=<)) +import Data.Text (Text) +import Network.Wai (isSecure) +import Yesod.Core.Handler (getsYesod, waiRequest) + +import qualified Data.Text as T (take) + +import Vervis.Foundation +import Vervis.Settings + +getSecure :: Handler Bool +getSecure = do + let detectScheme t = + case T.take 5 t of + "https" -> Just True + "http:" -> Just False + _ -> Nothing + msec <- getsYesod $ detectScheme <=< appRoot . appSettings + case msec of + Nothing -> isSecure <$> waiRequest + Just sec -> return sec diff --git a/src/Vervis/Widget.hs b/src/Vervis/Widget.hs index 9bb31c2..1bd59ef 100644 --- a/src/Vervis/Widget.hs +++ b/src/Vervis/Widget.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2018 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -53,9 +53,9 @@ revisionW = changes = $darcsTotalPatches :: Int in $(widgetFile "widget/revision") -avatarW :: Text -> WidgetT site IO () -avatarW email = do - murl <- getAvatarUrl email +avatarW :: Bool -> Text -> WidgetT site IO () +avatarW secure email = do + murl <- getAvatarUrl secure email [whamlet|
$maybe url <- murl diff --git a/templates/person.hamlet b/templates/person.hamlet index 160da52..9f37bf3 100644 --- a/templates/person.hamlet +++ b/templates/person.hamlet @@ -1,6 +1,6 @@ $# This file is part of Vervis. $# -$# Written in 2016 by fr33domlover . +$# Written in 2016, 2018 by fr33domlover . $# $# ♡ Copying is an act of love. Please copy, reuse and share. $# @@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . -^{avatarW $ personEmail person} +^{avatarW secure $ personEmail person}
  • diff --git a/vervis.cabal b/vervis.cabal index 25300c4..e611f9d 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -92,8 +92,8 @@ library Text.FilePath.Local Text.Jasmine.Local Web.PathPieces.Local - Yesod.Paginate.Local Yesod.Mail.Send + Yesod.Paginate.Local Vervis.Application Vervis.Avatar @@ -160,6 +160,7 @@ library Vervis.Readme Vervis.Render Vervis.Role + Vervis.Secure Vervis.Settings Vervis.Settings.StaticFiles Vervis.SourceTree