fig-web/src/Fig/Web/Module/TCG.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

module Fig.Web.Module.TCG
  ( public
  ) where

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.Utils.DB as DB

public :: PublicModule
public a = do
  onGet "/api/tcg/card/:uuid.png" do
    uuidpng <- pathParam "uuid.png"
    case Text.stripSuffix ".png" uuidpng of
      Nothing -> do
        status status400
        respondText "malformed card path"
      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.run a.db (DB.hget "tcg:cards" $ encodeUtf8 uuid) >>= \case
            Nothing -> do
              status status404
              respondText "card does not exist"
            Just image -> do
              liftIO $ Dir.createDirectoryIfMissing True cardDir
              liftIO $ BS.writeFile cardPath image
              log $ "Deleting card from Redis: " <> uuid
              DB.run a.db $ DB.hdel "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.run a.db (DB.lrange ("tcg-inventory:" <> userid) 0 (-1))
    respondHTML do
      head_ do
        title_ "LCOLONQ: The Game"
      body_ do
        forM_ cards $ \c -> do
          img_ [src_ $ mconcat ["/api/tcg/card/", decodeUtf8 c, ".png"]]