3 files changed, 29 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)