diff options
Diffstat (limited to 'fig-frontend')
| -rw-r--r-- | fig-frontend/src/Fig/Frontend.hs | 19 | ||||
| -rw-r--r-- | fig-frontend/src/Fig/Frontend/DB.hs | 7 | ||||
| -rw-r--r-- | fig-frontend/src/Fig/Frontend/Utils.hs | 10 |
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 |
