diff options
| -rw-r--r-- | fig-web/src/Fig/Web/DB.hs | 5 | ||||
| -rw-r--r-- | fig-web/src/Fig/Web/Module/TCG.hs | 29 | ||||
| -rw-r--r-- | fig-web/src/Fig/Web/Utils.hs | 2 | ||||
| -rw-r--r-- | flake.nix | 1 |
4 files changed, 30 insertions, 7 deletions
diff --git a/fig-web/src/Fig/Web/DB.hs b/fig-web/src/Fig/Web/DB.hs index 4408d6b..fc3e2fb 100644 --- a/fig-web/src/Fig/Web/DB.hs +++ b/fig-web/src/Fig/Web/DB.hs @@ -43,6 +43,11 @@ hget (DB c) key hkey = liftIO $ Redis.runRedis c do v <- Redis.hget key hkey pure . join $ hush v +hdel :: MonadIO m => DB -> ByteString -> ByteString -> m () +hdel (DB c) key hkey = liftIO $ Redis.runRedis c do + _ <- Redis.hdel key [hkey] + pure () + hmset :: MonadIO m => DB -> ByteString -> [(ByteString, ByteString)] -> m () hmset (DB c) key m = liftIO $ Redis.runRedis c do void $ Redis.hmset key m diff --git a/fig-web/src/Fig/Web/Module/TCG.hs b/fig-web/src/Fig/Web/Module/TCG.hs index d1bc4fb..c322df5 100644 --- a/fig-web/src/Fig/Web/Module/TCG.hs +++ b/fig-web/src/Fig/Web/Module/TCG.hs @@ -6,6 +6,9 @@ import Fig.Prelude import qualified Data.Text as Text +import qualified System.Directory as Dir +import qualified Data.ByteString as BS + import Fig.Web.Utils import Fig.Web.Types import qualified Fig.Web.DB as DB @@ -18,13 +21,25 @@ public a = do Nothing -> do status status400 respondText "malformed card path" - Just uuid -> DB.hget a.db "tcg:cards" (encodeUtf8 uuid) >>= \case - Nothing -> do - status status404 - respondText "card does not exist" - Just image -> do - addHeader "Content-Type" "image/png" - respondBytes image + Just uuid -> do + let cardDir = a.cfg.dataPath <> "/cards" + -- liftIO $ Dir.createDirectoryIfMissing True cardDir + let cardPath = cardDir <> unpack uuid <> ".png" + liftIO (Dir.doesFileExist cardPath) >>= \case + False -> DB.hget a.db "tcg:cards" (encodeUtf8 uuid) >>= \case + Nothing -> do + status status404 + respondText "card does not exist" + Just image -> do + log $ "Deleting card from Redis: " <> uuid + liftIO $ BS.writeFile cardPath image + DB.hdel a.db "tcg:cards" $ encodeUtf8 uuid + addHeader "Content-Type" "image/png" + respondBytes image + True -> do + image <- liftIO $ BS.readFile cardPath + addHeader "Content-Type" "image/png" + respondBytes image onGet "/api/tcg/binder/:userid" do userid <- pathParam "userid" cards <- take 20 <$> DB.lrange a.db ("tcg-inventory:" <> userid) 0 (-1) diff --git a/fig-web/src/Fig/Web/Utils.hs b/fig-web/src/Fig/Web/Utils.hs index 9337b12..59781cd 100644 --- a/fig-web/src/Fig/Web/Utils.hs +++ b/fig-web/src/Fig/Web/Utils.hs @@ -54,6 +54,7 @@ instance Exception FigWebException data Config = Config { port :: !Int , assetPath :: !FilePath + , dataPath :: !FilePath , clientId :: !Text , authToken :: !Text , dbHost :: !Text @@ -67,6 +68,7 @@ configCodec :: Toml.TomlCodec Config configCodec = do port <- Toml.int "port" Toml..= (\a -> a.port) assetPath <- Toml.string "asset_path" Toml..= (\a -> a.assetPath) + dataPath <- Toml.string "data_path" Toml..= (\a -> a.dataPath) 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) @@ -330,6 +330,7 @@ default = pkgs.writeText "fig-web.toml" '' port = 8000 asset_path = "/var/lib/fig-web-assets" + data_path = "/var/lib/fig-web-data" client_id = "" auth_token = "" db_host = "" |