diff --git a/config/settings-default.yaml b/config/settings-default.yaml index 292f5aa..50ac537 100644 --- a/config/settings-default.yaml +++ b/config/settings-default.yaml @@ -20,10 +20,10 @@ http-port: "_env:PORT:3000" ip-from-header: "_env:IP_FROM_HEADER:false" -# Default behavior: determine the application root from the request headers. -# Uncomment to set an explicit approot -#approot: "_env:APPROOT:http://localhost:3000" - +# The instance's host (e.g. "dev.angeley.es"). Used for determining which +# requests are federated and which are for this instance, and for generating +# URLs. The database relies on this value, and you shouldn't change it once +# you deploy an instance. instance-host: "_env:INSTANCE_HOST:localhost" # Encryption key file for encrypting the session cookie sent to clients diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 6669b3e..8632886 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -125,10 +125,9 @@ type AppDB = YesodDB App instance Yesod App where -- Controls the base of generated URLs. For more information on modifying, -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot - approot = ApprootRequest $ \app req -> - case appRoot $ appSettings app of - Nothing -> getApprootText guessApproot app req - Just root -> root + approot = ApprootMaster $ mkroot . appInstanceHost . appSettings + where + mkroot h = "https://" <> h -- Store session data on the client in encrypted cookies, -- default session idle timeout is 120 minutes @@ -160,7 +159,21 @@ instance Yesod App where defaultCsrfHeaderName defaultCsrfParamName ) + . ( \ handler -> do + host <- getsYesod $ appInstanceHost . appSettings + bs <- lookupHeaders hHost + case bs of + [b] | b == encodeUtf8 host -> handler + _ -> invalidArgs [hostMismatch host bs] + ) . defaultYesodMiddleware + where + hostMismatch h l = T.concat + [ "Request host mismatch: Expected " + , h + , " but instead got " + , T.pack (show l) + ] defaultLayout widget = do master <- getYesod diff --git a/src/Vervis/Secure.hs b/src/Vervis/Secure.hs index 511e1e4..99cbfb6 100644 --- a/src/Vervis/Secure.hs +++ b/src/Vervis/Secure.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2018 by fr33domlover . + - Written in 2018, 2019 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -31,6 +31,9 @@ -- 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. +-- +-- UPDATE: There's no optional approot setting, we always assume HTTPS. So +-- 'getSecure' simply always returns 'True'. module Vervis.Secure ( getSecure ) @@ -49,7 +52,8 @@ import Vervis.Foundation import Vervis.Settings getSecure :: Handler Bool -getSecure = do +getSecure = return True + {- let detectScheme t = case T.take 5 t of "https" -> Just True @@ -59,3 +63,4 @@ getSecure = do case msec of Nothing -> isSecure <$> waiRequest Just sec -> return sec + -} diff --git a/src/Vervis/Settings.hs b/src/Vervis/Settings.hs index e28ed07..0d4a22e 100644 --- a/src/Vervis/Settings.hs +++ b/src/Vervis/Settings.hs @@ -56,11 +56,10 @@ data AppSettings = AppSettings -- | Maximal number of keys (personal keys or usage of shared keys) to -- remember cached in our database per remote actor. , appMaxActorKeys :: Maybe Int - -- | Base for all generated URLs. If @Nothing@, determined from the - -- request headers. - , appRoot :: Maybe Text - -- | The instance's host (e.g. \"dev.angeley.es\"), currently used just - -- for display. + -- | The instance's host (e.g. \"dev.angeley.es\"). Used for determining + -- which requests are remote and which are for this instance, and for + -- generating URLs. The database relies on this value, and you shouldn't + -- change it once you deploy an instance. , appInstanceHost :: Text -- | Host/interface the server should bind to. , appHost :: HostPreference @@ -148,7 +147,6 @@ instance FromJSON AppSettings where appDatabaseConf <- o .: "database" appMaxInstanceKeys <- o .:? "max-instance-keys" appMaxActorKeys <- o .:? "max-actor-keys" - appRoot <- o .:? "approot" appInstanceHost <- o .: "instance-host" appHost <- fromString <$> o .: "host" appPort <- o .: "http-port"