Merge pull request #93 from deckgo/nm-deck-attributes

Add attributes to decks

Author: nmattia

infra/handler/app/Test.hs

@@ -34,7 +34,7 @@ main = do
   let someFirebaseId = FirebaseId "the-uid" -- from ./token
   let someUserId = UserId someFirebaseId
 
-  let someDeck = Deck { deckSlides = [] , deckDeckname = Deckname "foo", deckOwnerId = someUserId }
+  let someDeck = Deck { deckSlides = [] , deckDeckname = Deckname "foo", deckOwnerId = someUserId, deckAttributes = HMS.empty }
 
   deckId <- runClientM (decksPost' b someDeck) clientEnv >>= \case
     Left err -> error $ "Expected new deck, got error: " <> show err
@@ -46,7 +46,7 @@ main = do
     Left err -> error $ "Expected new slide, got error: " <> show err
     Right (Item slideId _) -> pure slideId
 
-  let newDeck = Deck { deckSlides = [ slideId ], deckDeckname = Deckname "bar", deckOwnerId = someUserId }
+  let newDeck = Deck { deckSlides = [ slideId ], deckDeckname = Deckname "bar", deckOwnerId = someUserId, deckAttributes = HMS.singleton "foo" "bar" }
 
   runClientM (decksPut' b deckId newDeck) clientEnv >>= \case
     Left err -> error $ "Expected updated deck, got error: " <> show err

infra/handler/src/DeckGo/Handler.hs

@@ -16,12 +16,14 @@
 
 module DeckGo.Handler where
 
+-- TODO: created_at, updated_at
+-- TODO: improve swagger description
+-- TODO: feed API
+
 -- TODO: double check what is returned on 200 from DynamoDB
 -- TODO: check permissions
--- TODO: created_at, updated_at
 -- TODO: TTL on anonymous users
 -- TODO: enforce uniqueness on deck_name (per user)
--- TODO: improve swagger description
 
 import Control.Lens hiding ((.=))
 import Control.Monad
@@ -174,6 +176,7 @@ data Deck = Deck
   { deckSlides :: [SlideId]
   , deckDeckname :: Deckname
   , deckOwnerId :: UserId
+  , deckAttributes :: HMS.HashMap T.Text T.Text
   } deriving (Show, Eq)
 
 instance FromJSONObject Deck where
@@ -182,12 +185,14 @@ instance FromJSONObject Deck where
       <$> obj .: "slides"
       <*> obj .: "name"
       <*> obj .: "owner_id"
+      <*> obj .: "attributes"
 
 instance ToJSONObject Deck where
   toJSONObject deck = HMS.fromList
     [ "slides" .= deckSlides deck
     , "name" .= deckDeckname deck
     , "owner_id" .= deckOwnerId deck
+    , "attributes" .= deckAttributes deck
     ]
 
 instance Aeson.FromJSON Deck where
@@ -472,7 +477,7 @@ decksPut :: Aws.Env -> Firebase.UserId -> DeckId -> Deck -> Servant.Handler (Ite
 decksPut env _ deckId deck = do
 
     res <- runAWS env $ Aws.send $ DynamoDB.updateItem "Decks" &
-        DynamoDB.uiUpdateExpression .~ Just "SET DeckSlides = :s, DeckName = :n, DeckOwnerId = :o" &
+        DynamoDB.uiUpdateExpression .~ Just "SET DeckSlides = :s, DeckName = :n, DeckOwnerId = :o, DeckAttributes = :a" &
         DynamoDB.uiExpressionAttributeValues .~ deckToItem' deck &
         DynamoDB.uiReturnValues .~ Just DynamoDB.UpdatedNew &
         DynamoDB.uiKey .~ HMS.singleton "DeckId"
@@ -654,24 +659,27 @@ userDecksFromAttributeValue attr =
 -- DECKS
 
 deckToItem :: DeckId -> Deck -> HMS.HashMap T.Text DynamoDB.AttributeValue
-deckToItem deckId Deck{deckSlides, deckDeckname, deckOwnerId} =
+deckToItem deckId Deck{deckSlides, deckDeckname, deckOwnerId, deckAttributes} =
     HMS.singleton "DeckId" (deckIdToAttributeValue deckId) <>
     HMS.singleton "DeckSlides" (deckSlidesToAttributeValue deckSlides) <>
     HMS.singleton "DeckName" (deckNameToAttributeValue deckDeckname) <>
-    HMS.singleton "DeckOwnerId" (deckOwnerIdToAttributeValue deckOwnerId)
+    HMS.singleton "DeckOwnerId" (deckOwnerIdToAttributeValue deckOwnerId) <>
+    HMS.singleton "DeckAttributes" (deckAttributesToAttributeValue deckAttributes)
 
 deckToItem' :: Deck -> HMS.HashMap T.Text DynamoDB.AttributeValue
-deckToItem' Deck{deckSlides, deckDeckname, deckOwnerId} =
+deckToItem' Deck{deckSlides, deckDeckname, deckOwnerId, deckAttributes} =
     HMS.singleton ":s" (deckSlidesToAttributeValue deckSlides) <>
     HMS.singleton ":n" (deckNameToAttributeValue deckDeckname) <>
-    HMS.singleton ":o" (deckOwnerIdToAttributeValue deckOwnerId)
+    HMS.singleton ":o" (deckOwnerIdToAttributeValue deckOwnerId) <>
+    HMS.singleton ":a" (deckAttributesToAttributeValue deckAttributes)
 
 itemToDeck :: HMS.HashMap T.Text DynamoDB.AttributeValue -> Maybe (Item DeckId Deck)
 itemToDeck item = do
     deckId <- HMS.lookup "DeckId" item >>= deckIdFromAttributeValue
     deckSlides <- HMS.lookup "DeckSlides" item >>= deckSlidesFromAttributeValue
     deckDeckname <- HMS.lookup "DeckName" item >>= deckNameFromAttributeValue
     deckOwnerId <- HMS.lookup "DeckOwnerId" item >>= deckOwnerIdFromAttributeValue
+    deckAttributes <- HMS.lookup "DeckAttributes" item >>= deckAttributesFromAttributeValue
     pure $ Item deckId Deck{..}
 
 -- DECK ATTRIBUTES
@@ -706,6 +714,23 @@ deckOwnerIdToAttributeValue (UserId (FirebaseId deckOwnerId)) =
 deckOwnerIdFromAttributeValue :: DynamoDB.AttributeValue -> Maybe UserId
 deckOwnerIdFromAttributeValue attr = (UserId . FirebaseId) <$> attr ^. DynamoDB.avS
 
+deckAttributesToAttributeValue :: HMS.HashMap T.Text T.Text -> DynamoDB.AttributeValue
+deckAttributesToAttributeValue attributes =
+    DynamoDB.attributeValue & DynamoDB.avM .~
+      HMS.map attributeValueToAttributeValue attributes
+  where
+    attributeValueToAttributeValue :: T.Text -> DynamoDB.AttributeValue
+    attributeValueToAttributeValue attrValue =
+      DynamoDB.attributeValue & DynamoDB.avB .~ Just (T.encodeUtf8 attrValue)
+
+deckAttributesFromAttributeValue :: DynamoDB.AttributeValue -> Maybe (HMS.HashMap T.Text T.Text)
+deckAttributesFromAttributeValue attr =
+    traverse attributeValueFromAttributeValue (attr ^. DynamoDB.avM)
+  where
+    attributeValueFromAttributeValue :: DynamoDB.AttributeValue -> Maybe T.Text
+    attributeValueFromAttributeValue attrValue =
+      T.decodeUtf8 <$> attrValue ^. DynamoDB.avB
+
 -- SLIDES
 
 slideToItem :: SlideId -> Slide -> HMS.HashMap T.Text DynamoDB.AttributeValue