Make app configurable via environment vars

app/Main.hs

@@ -1,10 +1,10 @@
 module Main where
 
-import Data.Maybe
-import System.Environment
+import System.Envy (decodeWithDefaults)
 import Tutor
+import Tutor.Config
 
 main :: IO ()
 main = do
-  dbFile <- lookupEnv "TUTOR_DATABASE"
-  startApp (fromMaybe "tutor.db" dbFile)
+  config <- decodeWithDefaults defaultConfig :: IO Config
+  startApp config

package.yaml

@@ -22,6 +22,7 @@ dependencies:
 - base >= 4.7 && < 5
 - aeson
 - containers
+- envy
 - lens
 - openapi3
 - parsec

src/Tutor.hs

@@ -4,11 +4,14 @@ import Network.Wai.Handler.Warp
 import Network.Wai.Logger
 import Servant (serve)
 import Tutor.Api (app)
+import Tutor.Config
 import Tutor.Database (initDb)
 
-startApp :: FilePath -> IO ()
-startApp dbFile = do
-  initDb dbFile
+startApp :: Config -> IO ()
+startApp config = do
+  initDb (tutorDatabase config)
   withStdoutLogger $
     \logger ->
-      runSettings (setPort 8080 $ setLogger logger $ defaultSettings) (app dbFile)
+      runSettings
+        (setPort (tutorPort config) $ setLogger logger $ defaultSettings)
+        (app config)

src/Tutor/Api.hs

@@ -6,8 +6,8 @@
 
 module Tutor.Api (app) where
 
-import Control.Monad.IO.Class (liftIO)
 import Control.Lens
+import Control.Monad.IO.Class (liftIO)
 import Data.Aeson (FromJSON, ToJSON)
 import Data.OpenApi
   ( HasDescription (description),
@@ -20,20 +20,29 @@ import Data.OpenApi
     ToSchema,
     URL (URL),
   )
-import Data.Version (showVersion)
 import qualified Data.Text as T
 import Data.Typeable (Typeable)
+import Data.Version (showVersion)
 import GHC.Generics (Generic)
 import qualified Paths_tutor as PT
 import Servant
 import Servant.OpenApi (HasOpenApi (toOpenApi))
 import Tutor.Card
+import Tutor.Config
 import Tutor.Database
 
 data Status = Status
-  {apiVersion :: T.Text}
+  { apiVersion :: T.Text,
+    config :: Config
+  }
   deriving (Generic, Typeable)
 
+instance FromJSON Config
+
+instance ToJSON Config
+
+instance ToSchema Config
+
 instance FromJSON Status
 
 instance ToJSON Status
@@ -194,8 +203,8 @@ openapi =
     & info . description ?~ "An API for searching a Magic: The Gathering card collection."
     & info . license ?~ ("MIT" & url ?~ URL "http://mit.com")
 
-tutorServer :: FilePath -> Server TutorAPI
-tutorServer dbFile = status :<|> searchCards dbFile
+tutorServer :: Config -> Server TutorAPI
+tutorServer config = status config :<|> searchCards (tutorDatabase config)
   where
     searchCards :: FilePath -> Maybe T.Text -> Maybe T.Text -> Maybe T.Text -> Handler [Card]
     searchCards dbFile q sortBy inCollection =
@@ -204,21 +213,22 @@ tutorServer dbFile = status :<|> searchCards dbFile
 docsServer :: Server DocsAPI
 docsServer = return openapi
 
-elmServer :: Server ElmAPI
-elmServer = serveDirectoryFileServer "www/public"
+elmServer :: FilePath -> Server ElmAPI
+elmServer = serveDirectoryFileServer
 
-server :: FilePath -> Server API
-server dbFile = tutorServer dbFile :<|> docsServer :<|> elmServer
+server :: Config -> Server API
+server config = tutorServer config :<|> docsServer :<|> elmServer (tutorStatic config)
 
 packageVersion :: T.Text
 packageVersion = T.pack $ showVersion PT.version
 
-status :: Handler Status
-status =
+status :: Config -> Handler Status
+status config =
   return
     Status
-      { apiVersion = packageVersion
+      { apiVersion = packageVersion,
+        config = config
       }
 
-app :: FilePath -> Application
-app dbFile = serve api $ server dbFile
+app :: Config -> Application
+app config = serve api $ server config

src/Tutor/Config.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Tutor.Config (Config (..), defaultConfig) where
+
+import GHC.Generics
+import System.Envy
+
+data Config = Config
+  { tutorPort :: Int,
+    tutorDatabase :: FilePath,
+    tutorStatic :: FilePath
+  }
+  deriving (Generic, Show)
+
+defaultConfig =
+  Config
+    { tutorPort = 8000,
+      tutorDatabase = "tutor.db",
+      tutorStatic = "www/public"
+    }
+
+instance FromEnv Config

test/AppSpec.hs

@@ -3,9 +3,11 @@
 module AppSpec (spec) where
 
 import Database.SQLite.Simple (execute_, withConnection)
+import System.Envy (decodeWithDefaults)
 import Test.Hspec
 import Test.Hspec.Wai
 import Tutor.Api (app)
+import Tutor.Config
 import Tutor.Database (initDb)
 
 spec :: Spec
@@ -15,12 +17,12 @@ spec = do
       it "responds with 200" $ do
         get "/search" `shouldRespondWith` 200
   where
-    dbFile = "test.db"
     startApp = do
-      initDb dbFile
-      resetDb
-      return $ app dbFile
-    resetDb = do
+      config <- decodeWithDefaults (defaultConfig {tutorDatabase = "test.db"}) :: IO Config
+      initDb (tutorDatabase config)
+      resetDb (tutorDatabase config)
+      return $ app config
+    resetDb dbFile = do
       withConnection dbFile $ \conn ->
         mapM_
           (execute_ conn)