handler: unique firebase uid and fix del/put

infra/default.nix

@@ -60,8 +60,8 @@ rec
       aws dynamodb create-table \
         --table-name Users \
         --attribute-definitions \
-            AttributeName=UserId,AttributeType=S \
-        --key-schema AttributeName=UserId,KeyType=HASH \
+            AttributeName=UserFirebaseId,AttributeType=S \
+        --key-schema AttributeName=UserFirebaseId,KeyType=HASH \
         --endpoint-url http://127.0.0.1:8000 \
         --provisioned-throughput ReadCapacityUnits=1,WriteCapacityUnits=1 \
         > /dev/null

infra/dynamo.tf

@@ -1,10 +1,10 @@
 resource "aws_dynamodb_table" "deckdeckgo-test-dynamodb-table-users" {
   name           = "Users"
   billing_mode   = "PAY_PER_REQUEST"
-  hash_key       = "UserId"
+  hash_key       = "UserFirebaseId"
 
   attribute {
-    name = "UserId"
+    name = "UserFirebaseId"
     type = "S"
   }
 

infra/handler/app/Handler.hs

@@ -1,10 +1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-import UnliftIO
 import Control.Lens
 import Servant.Auth.Firebase (ProjectId(..))
-import qualified Network.AWS as Aws
+import UnliftIO
 import qualified DeckGo.Handler
+import qualified Network.AWS as Aws
+import qualified Network.HTTP.Types as HTTP
+import qualified Network.Wai as Wai
 import qualified Network.Wai.Handler.Lambda as Lambda
 import qualified Network.Wai.Middleware.Cors as Cors
 
@@ -21,4 +23,18 @@ main = do
   -- TODO: from env
   let projectId = ProjectId "deckdeckgo-studio-beta"
 
-  Lambda.run $ Cors.simpleCors $ DeckGo.Handler.application (env ^. Aws.envManager) projectId env
+  Lambda.run $ cors $ DeckGo.Handler.application (env ^. Aws.envManager) projectId env
+
+cors :: Wai.Middleware
+cors = Cors.cors $
+      const $
+      Just Cors.simpleCorsResourcePolicy { Cors.corsMethods = methods }
+
+methods :: [HTTP.Method]
+methods =
+    [ "GET"
+    , "HEAD"
+    , "POST"
+    , "DELETE"
+    , "PUT"
+    ]

infra/handler/app/Test.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE LambdaCase #-}
 
 import Network.HTTP.Client (newManager, defaultManagerSettings)
+import Network.HTTP.Types as HTTP
 import Servant.API
 import Servant.Client
 import DeckGo.Handler
@@ -30,7 +31,8 @@ main = do
     Right [] -> pure ()
     Right decks -> error $ "Expected 0 decks, got: " <> show decks
 
-  let someUserId = UserId "foo"
+  let someFirebaseId = FirebaseId "the-uid" -- from ./token
+  let someUserId = UserId someFirebaseId
 
   let someDeck = Deck { deckSlides = [] , deckDeckname = Deckname "foo", deckOwnerId = someUserId }
 
@@ -100,9 +102,30 @@ main = do
       if decks == [] then pure () else (error $ "Expected no decks, got: " <> show decks)
 
 
+  let someUser = User { userFirebaseId = someFirebaseId, userAnonymous = False }
+
+  runClientM (usersPost' b someUser) clientEnv >>= \case
+    Left err -> error $ "Expected user, got error: " <> show err
+    Right (Item userId user) ->
+      if user == someUser && userId == someUserId then pure () else (error $ "Expected same user, got: " <> show user)
+
+  runClientM (usersPost' b someUser) clientEnv >>= \case
+    Left (FailureResponse resp) ->
+      if HTTP.statusCode (responseStatusCode resp) == 409 then pure () else
+        error $ "Got unexpecte response: " <> show resp
+    Left err -> error $ "Expected 409, got error: " <> show err
+    Right item -> error $ "Expected failure, got success: " <> show item
+
+
+  -- TODO: test that creating user with token that has different user as sub
+  -- fails
+
+
+
+
 usersGet' :: ClientM [Item UserId User]
 _usersGetUserId' :: UserId -> ClientM (Item UserId User)
-_usersPost' :: T.Text -> User -> ClientM (Item UserId User)
+usersPost' :: T.Text -> User -> ClientM (Item UserId User)
 _usersPut' :: T.Text -> UserId -> User -> ClientM (Item UserId User)
 _usersDelete' :: T.Text -> UserId -> ClientM ()
 
@@ -120,7 +143,7 @@ slidesDelete' :: SlideId -> ClientM ()
 ((
   usersGet' :<|>
   _usersGetUserId' :<|>
-  _usersPost' :<|>
+  usersPost' :<|>
   _usersPut' :<|>
   _usersDelete'
   ) :<|>

infra/handler/package.yaml

@@ -13,14 +13,15 @@ dependencies:
     - filepath
     - firebase-login
     - http-client
+    - http-types
     - lens
     - mtl
     - random
     - servant
-    - swagger2
     - servant-server
     - servant-swagger
     - servant-swagger-ui
+    - swagger2
     - text
     - unliftio
     - unordered-containers

infra/handler/src/DeckGo/Handler.hs

@@ -17,10 +17,11 @@
 module DeckGo.Handler where
 
 -- TODO: double check what is returned on 200 from DynamoDB
--- TODO: check user is in DB
 -- 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
@@ -90,11 +91,11 @@ newtype Username = Username { unUsername :: T.Text }
   deriving newtype (Aeson.FromJSON, Aeson.ToJSON)
 
 data User = User
-  { userFirebaseId :: FirebaseId -- TODO: enforce uniqueness
+  { userFirebaseId :: FirebaseId
   , userAnonymous :: Bool
   } deriving (Show, Eq)
 
-newtype UserId = UserId { unUserId :: T.Text }
+newtype UserId = UserId { unUserId :: FirebaseId }
   deriving newtype
     ( Aeson.FromJSON
     , Aeson.ToJSON
@@ -171,7 +172,7 @@ newtype Deckname = Deckname { unDeckname :: T.Text }
 
 data Deck = Deck
   { deckSlides :: [SlideId]
-  , deckDeckname :: Deckname -- TODO: enforce uniqueness
+  , deckDeckname :: Deckname
   , deckOwnerId :: UserId
   } deriving (Show, Eq)
 
@@ -323,7 +324,7 @@ usersGet env = do
 usersGetUserId :: Aws.Env -> UserId -> Servant.Handler (Item UserId User)
 usersGetUserId env userId = do
     res <- runAWS env $ Aws.send $ DynamoDB.getItem "Users" &
-        DynamoDB.giKey .~ HMS.singleton "UserId" (userIdToAttributeValue userId)
+        DynamoDB.giKey .~ HMS.singleton "UserFirebaseId" (userIdToAttributeValue userId)
     case res of
       Right getItemResponse -> do
         case getItemResponse ^. DynamoDB.girsResponseStatus of
@@ -347,18 +348,26 @@ usersGetUserId env userId = do
         Servant.throwError Servant.err500
 
 usersPost :: Aws.Env -> Firebase.UserId -> User -> Servant.Handler (Item UserId User)
-usersPost env _uid user = do
+usersPost env fuid user = do
 
-    userId <- liftIO $ UserId <$> newId
+    let userId = UserId (userFirebaseId user)
+
+    when (Firebase.unUserId fuid /= unFirebaseId (userFirebaseId user)) $ do
+      Servant.throwError Servant.err403
 
     res <- runAWS env $ Aws.send $ DynamoDB.putItem "Users" &
-        DynamoDB.piItem .~ userToItem userId user
+        DynamoDB.piItem .~ userToItem userId user &
+        DynamoDB.piConditionExpression .~ Just "attribute_not_exists(UserFirebaseId)"
 
     case res of
       Right {} -> pure ()
-      Left e -> do
-        liftIO $ print e
-        Servant.throwError Servant.err500
+      Left e -> case e ^? DynamoDB._ConditionalCheckFailedException of
+        Just _e -> do
+          u <- usersGetUserId env userId
+          Servant.throwError Servant.err409 { Servant.errBody = Aeson.encode u }
+        Nothing -> do
+          liftIO $ print e
+          Servant.throwError Servant.err500
 
     pure $ Item userId user
 
@@ -367,7 +376,7 @@ usersPut env _ userId user = do
 
     res <- runAWS env $ Aws.send $ DynamoDB.updateItem "Users" &
         DynamoDB.uiUpdateExpression .~
-          Just "SET UserDecks = :s, UserUsername = :n, UserFirebaseId = :i" &
+          Just "SET UserDecks = :s, UserUsername = :n" &
         DynamoDB.uiExpressionAttributeValues .~ userToItem' user &
         DynamoDB.uiReturnValues .~ Just DynamoDB.UpdatedNew &
         DynamoDB.uiKey .~ HMS.singleton "UserId"
@@ -385,7 +394,7 @@ usersDelete :: Aws.Env -> Firebase.UserId -> UserId -> Servant.Handler ()
 usersDelete env _ userId = do
 
     res <- runAWS env $ Aws.send $ DynamoDB.deleteItem "Users" &
-        DynamoDB.diKey .~ HMS.singleton "UserId"
+        DynamoDB.diKey .~ HMS.singleton "UserFirebaseId"
           (userIdToAttributeValue userId)
 
     case res of
@@ -588,31 +597,29 @@ slidesDelete env slideId = do
 -- USERS
 
 userToItem :: UserId -> User -> HMS.HashMap T.Text DynamoDB.AttributeValue
-userToItem userId User{userFirebaseId, userAnonymous} =
-    HMS.singleton "UserId" (userIdToAttributeValue userId) <>
-    HMS.singleton "UserFirebaseId" (userFirebaseIdToAttributeValue userFirebaseId) <>
+userToItem userId User{userAnonymous} =
+    HMS.singleton "UserFirebaseId" (userIdToAttributeValue userId) <>
     HMS.singleton "UserAnonymous" (userAnonymousToAttributeValue userAnonymous)
 
 userToItem' :: User -> HMS.HashMap T.Text DynamoDB.AttributeValue
-userToItem' User{userFirebaseId, userAnonymous} =
-    HMS.singleton ":i" (userFirebaseIdToAttributeValue userFirebaseId) <>
+userToItem' User{userAnonymous} =
     HMS.singleton ":a" (userAnonymousToAttributeValue userAnonymous)
 
 itemToUser :: HMS.HashMap T.Text DynamoDB.AttributeValue -> Maybe (Item UserId User)
 itemToUser item = do
-    userId <- HMS.lookup "UserId" item >>= userIdFromAttributeValue
-    userFirebaseId <- HMS.lookup "UserFirebaseId" item >>= userFirebaseIdFromAttributeValue
+    userId <- HMS.lookup "UserFirebaseId" item >>= userIdFromAttributeValue
+    let userFirebaseId = unUserId userId
     userAnonymous <- HMS.lookup "UserAnonymous" item >>= userAnonymousFromAttributeValue
     pure $ Item userId User{..}
 
 -- USER ATTRIBUTES
 
 userIdToAttributeValue :: UserId -> DynamoDB.AttributeValue
-userIdToAttributeValue (UserId userId) =
+userIdToAttributeValue (UserId (FirebaseId userId)) =
     DynamoDB.attributeValue & DynamoDB.avS .~ Just userId
 
 userIdFromAttributeValue :: DynamoDB.AttributeValue -> Maybe UserId
-userIdFromAttributeValue attr = UserId <$> attr ^. DynamoDB.avS
+userIdFromAttributeValue attr = (UserId . FirebaseId) <$> attr ^. DynamoDB.avS
 
 userNameToAttributeValue :: Username -> DynamoDB.AttributeValue
 userNameToAttributeValue (Username username) =
@@ -693,11 +700,11 @@ deckSlidesFromAttributeValue attr =
     traverse slideIdFromAttributeValue (attr ^. DynamoDB.avL)
 
 deckOwnerIdToAttributeValue :: UserId -> DynamoDB.AttributeValue
-deckOwnerIdToAttributeValue (UserId deckOwnerId) =
+deckOwnerIdToAttributeValue (UserId (FirebaseId deckOwnerId)) =
     DynamoDB.attributeValue & DynamoDB.avS .~ Just deckOwnerId
 
 deckOwnerIdFromAttributeValue :: DynamoDB.AttributeValue -> Maybe UserId
-deckOwnerIdFromAttributeValue attr = UserId <$> attr ^. DynamoDB.avS
+deckOwnerIdFromAttributeValue attr = (UserId . FirebaseId) <$> attr ^. DynamoDB.avS
 
 -- SLIDES
 

infra/lambda.tf

@@ -52,11 +52,13 @@ data "aws_iam_policy_document" "policy_for_lambda" {
     actions = [
       "dynamodb:BatchGetItem",
       "dynamodb:GetItem",
+      "dynamodb:UpdateItem",
       "dynamodb:Query",
       "dynamodb:Scan",
       "dynamodb:BatchWriteItem",
       "dynamodb:PutItem",
       "dynamodb:UpdateItem",
+      "dynamodb:DeleteItem",
     ]
 
     resources = [