Update

3 files changed, 21 insertions, 15 deletions

diff --git a/fig-frontend/src/Fig/Frontend.hs b/fig-frontend/src/Fig/Frontend.hs
index a6ec8dd..5f0ba10 100644
--- a/fig-frontend/src/Fig/Frontend.hs
+++ b/fig-frontend/src/Fig/Frontend.hs
@@ -7,15 +7,13 @@ import Fig.Prelude
 import Control.Lens (use)
 
 import qualified Data.Text as Text
+import qualified Data.ByteString.Base64 as BS.Base64
 
 import qualified Network.Wai.Middleware.Static as Wai.Static
 import qualified Network.Wai.Handler.Warp as Warp
 
 import qualified Web.Twain as Tw
 
-import qualified Lucid as L
-import qualified Lucid.Base as L
-
 import Fig.Utils.SExpr
 import Fig.Bus.Client
 import Fig.Frontend.Utils
@@ -34,9 +32,14 @@ server cfg busAddr = do
     (\_ _ -> pure ())
     (pure ())
 
+sexprStr :: Text -> SExpr
+sexprStr = SExprString . BS.Base64.encodeBase64 . encodeUtf8
+
 app :: Config -> Commands IO -> IO Tw.Application
 app cfg cmds = do
-  db <- DB.connect
+  log "Connecting to database..."
+  db <- DB.connect cfg
+  log "Connected! Server active."
   st <- stateRef
   pure $ foldr' @[] ($)
     (Tw.notFound . Tw.send $ Tw.text "not found")
@@ -57,10 +60,10 @@ app cfg cmds = do
         input <- Tw.paramMaybe "input"
         liftIO $ cmds.publish [sexp|(frontend redeem incoming)|]
           $ mconcat
-            [ [ SExprString me
-              , SExprString name
+            [ [ sexprStr me
+              , sexprStr name
               ]
-            , maybe [] ((:[]) . SExprString) input
+            , maybe [] ((:[]) . sexprStr) input
             ]
         Tw.send $ Tw.text "it worked"
     , Tw.get "/api/songs" do
@@ -75,7 +78,7 @@ app cfg cmds = do
     , Tw.get "/api/poke/:name" do
         target <- encodeUtf8 . Text.toLower <$> Tw.param "name"
         inbox <- fromMaybe [] <$> DB.smembers db ("pokeinbox:" <> target)
-        Tw.send . Tw.text . pretty . SExprList @Void $ SExprString . decodeUtf8 <$> inbox
+        Tw.send . Tw.text . pretty . SExprList @Void $ sexprStr . decodeUtf8 <$> inbox
     , Tw.post "/api/poke/:name" do
         me <- encodeUtf8 . Text.toLower <$> Tw.param "ayem"
         target <- encodeUtf8 . Text.toLower <$> Tw.param "name"
diff --git a/fig-frontend/src/Fig/Frontend/DB.hs b/fig-frontend/src/Fig/Frontend/DB.hs
index bcf00f2..b0f065d 100644
--- a/fig-frontend/src/Fig/Frontend/DB.hs
+++ b/fig-frontend/src/Fig/Frontend/DB.hs
@@ -5,10 +5,11 @@ import Control.Error.Util (hush)
 import qualified Database.Redis as Redis
 
 import Fig.Prelude
+import Fig.Frontend.Utils
 
-connect :: MonadIO m => m Redis.Connection
-connect = liftIO $ Redis.checkedConnect Redis.defaultConnectInfo
-  { Redis.connectHost = "shiro"
+connect :: MonadIO m => Config -> m Redis.Connection
+connect cfg = liftIO $ Redis.checkedConnect Redis.defaultConnectInfo
+  { Redis.connectHost = unpack cfg.dbHost
   }
 
 get :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe ByteString)
diff --git a/fig-frontend/src/Fig/Frontend/Utils.hs b/fig-frontend/src/Fig/Frontend/Utils.hs
index 20234e7..3081ddb 100644
--- a/fig-frontend/src/Fig/Frontend/Utils.hs
+++ b/fig-frontend/src/Fig/Frontend/Utils.hs
@@ -19,10 +19,11 @@ newtype FigFrontendException = FigFrontendException Text
 instance Exception FigFrontendException
 
 data Config = Config
-  { port :: Int
-  , assetPath :: FilePath
-  , clientId :: Text
-  , authToken :: Text
+  { port :: !Int
+  , assetPath :: !FilePath
+  , clientId :: !Text
+  , authToken :: !Text
+  , dbHost :: !Text
   } deriving (Show, Eq, Ord)
 
 configCodec :: Toml.TomlCodec Config
@@ -31,6 +32,7 @@ configCodec = do
   assetPath <- Toml.string "asset_path" Toml..= (\a -> a.assetPath)
   clientId <- Toml.text "client_id" Toml..= (\a -> a.clientId)
   authToken <- Toml.text "auth_token" Toml..= (\a -> a.authToken)
+  dbHost <- Toml.text "db_host" Toml..= (\a -> a.dbHost)
   pure $ Config{..}
 
 loadConfig :: FilePath -> IO Config