Merge remote-tracking branch 'origin/master'

Author: peterpeterparker

infra/handler/app/Test.hs

@@ -538,7 +538,7 @@ testServer = withServer $ \port -> do
 
   runClientM (decksGetDeckId' b deckId) clientEnv >>= \case
     Left e -> error $ "Expected decks, got error: " <> show e
-    Right deck ->
+    Right (Item _deckId deck) ->
       if deck == newDeck then pure () else (error $ "Expected get deck, got: " <> show deck)
 
   let updatedSlide = Slide Nothing "quux" HMS.empty
@@ -579,7 +579,7 @@ _usersPut' :: T.Text -> UserId -> UserInfo -> ClientM (Item UserId User)
 _usersDelete' :: T.Text -> UserId -> ClientM ()
 
 decksGet' :: T.Text -> Maybe UserId -> ClientM [Item DeckId Deck]
-decksGetDeckId' :: T.Text -> DeckId -> ClientM Deck
+decksGetDeckId' :: T.Text -> DeckId -> ClientM (Item DeckId Deck)
 decksPostPublish' :: T.Text -> DeckId -> ClientM PresResponse
 decksPost' :: T.Text -> Deck -> ClientM (Item DeckId Deck)
 decksPut' :: T.Text -> DeckId -> Deck -> ClientM (Item DeckId Deck)

infra/handler/package.yaml

@@ -12,6 +12,7 @@ dependencies:
     - amazonka-sqs
     - base
     - bytestring
+    - cases
     - contravariant
     - conduit
     - conduit-extra

infra/handler/src/DeckGo/Handler.hs

@@ -222,7 +222,7 @@ type DecksAPI =
     Protected :> QueryParam "owner_id" UserId :> Get '[JSON] [Item DeckId Deck] :<|>
     Protected :>
       Capture "deck_id" DeckId :>
-      Get '[JSON] Deck :<|>
+      Get '[JSON] (Item DeckId Deck) :<|>
     Protected :>
       Capture "deck_id" DeckId :>
       "publish" :>
@@ -810,7 +810,7 @@ decksGetDeckId
     :: HC.Connection
     -> Firebase.UserId
     -> DeckId
-    -> Servant.Handler Deck
+    -> Servant.Handler (Item DeckId Deck)
 decksGetDeckId conn fuid deckId = do
 
     iface <- liftIO $ getDbInterface conn
@@ -827,7 +827,7 @@ decksGetDeckId conn fuid deckId = do
         [ "Deck was found", show deck, "but requester is not the owner", show fuid ]
       Servant.throwError Servant.err404
 
-    pure deck
+    pure (Item deckId deck)
 
 decksDeleteSession :: DeckId -> HS.Session ()
 decksDeleteSession did = do
@@ -1209,6 +1209,8 @@ data DbVersion
   | DbVersion1
   | DbVersion2
   | DbVersion3
+  | DbVersion4
+  | DbVersion5
   deriving stock (Enum, Bounded, Ord, Eq)
 
 -- | Migrates from ver to latest
@@ -1309,6 +1311,80 @@ migrateFrom = \frm -> do
             , ");"
             ]
           ) HE.unit HD.unit True
+      DbVersion4 -> do
+        HS.sql "DROP TABLE IF EXISTS username"
+        HS.sql "DROP TABLE IF EXISTS account CASCADE"
+        HS.sql "DROP TABLE IF EXISTS slide"
+        HS.sql "DROP TABLE IF EXISTS deck"
+        HS.statement () $ Statement
+          (BS8.unwords
+            [ "CREATE TABLE account ("
+            ,   "id TEXT PRIMARY KEY,"
+            ,   "firebase_id TEXT UNIQUE,"
+            ,   "username TEXT UNIQUE NULL"
+            , ");"
+            ]
+          ) HE.unit HD.unit True
+        HS.statement () $ Statement
+          (BS8.unwords
+            [ "CREATE TABLE deck ("
+            ,   "id TEXT PRIMARY KEY,"
+            ,   "name TEXT NOT NULL,"
+            ,   "background TEXT NULL,"
+            ,   "owner TEXT NOT NULL REFERENCES account (id),"
+            ,   "attributes JSON"
+            , ");"
+            ]
+          ) HE.unit HD.unit True
+        HS.statement () $ Statement
+          (BS8.unwords
+            [ "CREATE TABLE slide ("
+            ,   "id TEXT PRIMARY KEY,"
+            ,   "deck TEXT NOT NULL REFERENCES deck (id) ON DELETE CASCADE,"
+            ,   "index INT2 NULL,"
+            ,   "content TEXT," -- TODO: is any of this nullable?
+            ,   "template TEXT,"
+            ,   "attributes JSON"
+            , ");"
+            ]
+          ) HE.unit HD.unit True
+      DbVersion5 -> do
+        HS.sql "DROP TABLE IF EXISTS username"
+        HS.sql "DROP TABLE IF EXISTS account CASCADE"
+        HS.sql "DROP TABLE IF EXISTS slide"
+        HS.sql "DROP TABLE IF EXISTS deck"
+        HS.statement () $ Statement
+          (BS8.unwords
+            [ "CREATE TABLE account ("
+            ,   "id TEXT PRIMARY KEY,"
+            ,   "firebase_id TEXT UNIQUE,"
+            ,   "username TEXT UNIQUE NULL"
+            , ");"
+            ]
+          ) HE.unit HD.unit True
+        HS.statement () $ Statement
+          (BS8.unwords
+            [ "CREATE TABLE deck ("
+            ,   "id TEXT PRIMARY KEY,"
+            ,   "name TEXT NOT NULL,"
+            ,   "background TEXT NULL,"
+            ,   "owner TEXT NOT NULL REFERENCES account (id) ON DELETE CASCADE,"
+            ,   "attributes JSON"
+            , ");"
+            ]
+          ) HE.unit HD.unit True
+        HS.statement () $ Statement
+          (BS8.unwords
+            [ "CREATE TABLE slide ("
+            ,   "id TEXT PRIMARY KEY,"
+            ,   "deck TEXT NOT NULL REFERENCES deck (id) ON DELETE CASCADE,"
+            ,   "index INT2 NULL,"
+            ,   "content TEXT," -- TODO: is any of this nullable?
+            ,   "template TEXT,"
+            ,   "attributes JSON"
+            , ");"
+            ]
+          ) HE.unit HD.unit True
 
 readDbVersion :: HS.Session (Either String (Maybe DbVersion))
 readDbVersion = do
@@ -1352,6 +1428,8 @@ dbVersionToText = \case
   DbVersion1 -> "1"
   DbVersion2 -> "2"
   DbVersion3 -> "3"
+  DbVersion4 -> "4"
+  DbVersion5 -> "5"
 
 dbVersionFromText :: T.Text -> Maybe DbVersion
 dbVersionFromText t =

infra/handler/src/DeckGo/Presenter.hs

@@ -10,6 +10,7 @@ module DeckGo.Presenter where
 
 import Control.Lens hiding ((.=))
 import Control.Monad
+import qualified Cases
 import qualified Network.AWS.SQS as SQS
 import qualified Data.Aeson as Aeson
 import Data.Bifunctor
@@ -101,6 +102,8 @@ withPresentationFiles uname deck slides act = do
     interpol =
       T.replace "{{DECKDECKGO_TITLE}}" (unDeckname dname) .
       T.replace "{{DECKDECKGO_AUTHOR}}" (unUsername uname) .
+      T.replace "{{DECKDECKGO_USERNAME}}" (unUsername uname) .
+      T.replace "{{DECKDECKGO_DECKNAME}}" (sanitizeDeckname dname) .
       -- TODO: description
       T.replace "{{DECKDECKGO_DESCRIPTION}}" "(no description given)" .
       T.replace "{{DECKDECKGO_BASE_HREF}}"
@@ -132,7 +135,7 @@ slideTags :: Slide -> [Tag]
 slideTags slide =
     [ TagSoup.TagOpen
         ("deckgo-slide-" <> slideTemplate slide)
-        (HMS.toList (slideAttributes slide))
+        (first Cases.spinalize <$> HMS.toList (slideAttributes slide))
     ] <> maybe [] TagSoup.parseTags (slideContent slide) <>
     [ TagSoup.TagClose
         ("deckgo-slide-" <> slideTemplate slide)

infra/lambda.tf

@@ -19,7 +19,7 @@ resource "aws_lambda_function" "api" {
       PGDATABASE               = aws_db_instance.default.name
       PGPASSWORD               = aws_db_instance.default.password
       QUEUE_NAME               = aws_sqs_queue.presentation_deploy.name
-      FIREBASE_PROJECT_ID      = "deckdeckgo-studio-beta"
+      FIREBASE_PROJECT_ID      = "deckdeckgo-studio-prod"
       DECKGO_PRESENTATIONS_URL = aws_route53_record.www_site_beta.fqdn
       META_BUCKET_NAME         = aws_s3_bucket.meta.bucket
     }

infra/nix/sources.json

@@ -5,10 +5,10 @@
         "homepage": "https://deckdeckgo.com",
         "owner": "deckgo",
         "repo": "deckdeckgo-starter",
-        "rev": "b52b2f0dcb4213492f37afe1d962ba6d13fd3f97",
-        "sha256": "186dvy7nswsyixh79fcbzir1v30cspl24wkj9m4xa5g9hwypkncz",
+        "rev": "6b52258cfe6a7813ffc2a28041b4692a5056a01e",
+        "sha256": "1afjaqmh7pis7561q4vay4yla51li2qi82f0j82yrp91vlj1c54h",
         "type": "tarball",
-        "url": "https://github.com/deckgo/deckdeckgo-starter/archive/b52b2f0dcb4213492f37afe1d962ba6d13fd3f97.tar.gz",
+        "url": "https://github.com/deckgo/deckdeckgo-starter/archive/6b52258cfe6a7813ffc2a28041b4692a5056a01e.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
     "elasticmq": {