diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-09-27 12:36:37 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-09-27 12:36:37 -0400 |
commit | d154002e063c1c3af5aba13cf05a11df8b8f9897 (patch) | |
tree | 86ebc67990feb68fe50862c58c34e47b8ff30779 | |
parent | 90ff9f8872b0b4157a7e755e00eedf88907c98f1 (diff) | |
download | keysafe-d154002e063c1c3af5aba13cf05a11df8b8f9897.tar.gz |
Server: --motd can be used to provide a Message Of The Day.
This commit was sponsored by Anthony DeRobertis on Patreon.
-rw-r--r-- | CHANGELOG | 1 | ||||
-rw-r--r-- | CmdLine.hs | 6 | ||||
-rw-r--r-- | HTTP/Server.hs | 9 |
3 files changed, 13 insertions, 3 deletions
@@ -11,6 +11,7 @@ keysafe (0.20160923) UNRELEASED; urgency=medium * Added a second keysafe server to the server list. It's provided by Marek Isalski at Faelix. Currently located in UK, but planned move to CH. Currently at Alternate level until verification is complete. + * Server: --motd can be used to provide a Message Of The Day. -- Joey Hess <id@joeyh.name> Fri, 23 Sep 2016 10:40:55 -0400 @@ -38,6 +38,7 @@ data ServerConfig = ServerConfig { serverPort :: Port , serverAddress :: String , monthsToFillHalfDisk :: Integer + , serverMotd :: Maybe T.Text } parse :: Parser CmdLine @@ -185,6 +186,11 @@ parseServerConfig = ServerConfig <> showDefault <> help "Server rate-limits requests and requires proof of work, to avoid too many objects being stored. This is an lower bound on how long it could possibly take for half of the current disk space to be filled." ) + <*> optional (T.pack <$> strOption + ( long "motd" + <> metavar "MESSAGE" + <> help "The server's Message Of The Day." + )) get :: IO CmdLine get = execParser opts diff --git a/HTTP/Server.hs b/HTTP/Server.hs index c667601..f2ecfa8 100644 --- a/HTTP/Server.hs +++ b/HTTP/Server.hs @@ -24,6 +24,7 @@ import Control.Monad.IO.Class import Control.Concurrent import Control.Concurrent.Thread.Delay import Control.Concurrent.STM +import Data.Maybe import Data.String import qualified Data.ByteString as B @@ -32,6 +33,7 @@ data ServerState = ServerState , storage :: Storage , rateLimiter :: RateLimiter , logger :: Logger + , serverConfig :: ServerConfig } newServerState :: Maybe LocalStorageDirectory -> ServerConfig -> IO ServerState @@ -42,6 +44,7 @@ newServerState d cfg = do <*> pure (serverStorage d) <*> newRateLimiter cfg d l <*> pure l + <*> pure cfg runServer :: Maybe LocalStorageDirectory -> ServerConfig -> IO () runServer d cfg = do @@ -62,13 +65,13 @@ userAPI :: Proxy HttpAPI userAPI = Proxy server :: ServerState -> Server HttpAPI -server st = motd +server st = motd st :<|> getObject st :<|> putObject st :<|> countObjects st -motd :: Handler Motd -motd = return $ Motd "Hello World!" +motd :: ServerState -> Handler Motd +motd = return . Motd . fromMaybe "Hello World!" . serverMotd . serverConfig getObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> Handler (POWGuarded StorableObject) getObject st i pow = rateLimit (rateLimiter st) (logger st) pow i $ do |