summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--fig-frontend/fig-frontend.cabal3
-rw-r--r--fig-frontend/src/Fig/Frontend.hs13
-rw-r--r--fig-frontend/src/Fig/Frontend/DB.hs17
3 files changed, 30 insertions, 3 deletions
diff --git a/fig-frontend/fig-frontend.cabal b/fig-frontend/fig-frontend.cabal
index aed5cfd..a15047d 100644
--- a/fig-frontend/fig-frontend.cabal
+++ b/fig-frontend/fig-frontend.cabal
@@ -17,7 +17,9 @@ common deps
, containers
, data-default-class
, directory
+ , errors
, filepath
+ , hedis
, http-types
, http-client
, http-client-tls
@@ -54,6 +56,7 @@ library
Fig.Frontend.Utils
Fig.Frontend.Auth
Fig.Frontend.State
+ Fig.Frontend.DB
executable fig-frontend
import: defaults
diff --git a/fig-frontend/src/Fig/Frontend.hs b/fig-frontend/src/Fig/Frontend.hs
index ea81bcb..30e2f46 100644
--- a/fig-frontend/src/Fig/Frontend.hs
+++ b/fig-frontend/src/Fig/Frontend.hs
@@ -4,7 +4,7 @@ import Fig.Prelude
import Control.Lens (use)
-import qualified Network.Wai.Middleware.Static as Wai.Static
+-- import qualified Network.Wai.Middleware.Static as Wai.Static
import qualified Network.Wai.Handler.Warp as Warp
import qualified Web.Twain as Tw
@@ -15,6 +15,7 @@ import qualified Lucid.Base as L
import Fig.Frontend.Utils
import Fig.Frontend.Auth
import Fig.Frontend.State
+import qualified Fig.Frontend.DB as DB
server :: Config -> IO ()
server cfg = do
@@ -28,11 +29,12 @@ window id_ title body =
app :: Config -> IO Tw.Application
app cfg = do
+ db <- DB.connect
st <- stateRef
pure $ foldr' @[] ($)
(Tw.notFound . Tw.send $ Tw.text "not found")
- [ Wai.Static.staticPolicy $ Wai.Static.addBase cfg.assetPath
- , Tw.get "/"
+ -- [ Wai.Static.staticPolicy $ Wai.Static.addBase cfg.assetPath
+ [ Tw.get "/"
. Tw.send . Tw.html
. L.renderBS
$ L.doctypehtml_ do
@@ -46,4 +48,9 @@ app cfg = do
, Tw.put "/api/buffer" do
buf <- withState st $ use buffer
Tw.send $ Tw.text buf
+ , Tw.get "/api/user/:name" do
+ name <- Tw.param "name"
+ DB.get db ("user:" <> encodeUtf8 name) >>= \case
+ Nothing -> Tw.send . Tw.status Tw.status404 $ Tw.text "user not found"
+ Just val -> Tw.send . Tw.text $ decodeUtf8 val
]
diff --git a/fig-frontend/src/Fig/Frontend/DB.hs b/fig-frontend/src/Fig/Frontend/DB.hs
new file mode 100644
index 0000000..0425f67
--- /dev/null
+++ b/fig-frontend/src/Fig/Frontend/DB.hs
@@ -0,0 +1,17 @@
+module Fig.Frontend.DB where
+
+import Control.Error.Util (hush)
+
+import qualified Database.Redis as Redis
+
+import Fig.Prelude
+
+connect :: MonadIO m => m Redis.Connection
+connect = liftIO $ Redis.checkedConnect Redis.defaultConnectInfo
+ { Redis.connectHost = "shiro"
+ }
+
+get :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe ByteString)
+get c key = liftIO $ Redis.runRedis c do
+ v <- Redis.get key
+ pure $ join $ hush v