diff --git a/infra/default.nix b/infra/default.nix index 94ed8c8cd..1afb32b18 100644 --- a/infra/default.nix +++ b/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 diff --git a/infra/dynamo.tf b/infra/dynamo.tf index 004518e7e..4d247c5f9 100644 --- a/infra/dynamo.tf +++ b/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" } diff --git a/infra/handler/app/Handler.hs b/infra/handler/app/Handler.hs index efa11b521..095ba775c 100644 --- a/infra/handler/app/Handler.hs +++ b/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" + ] diff --git a/infra/handler/app/Test.hs b/infra/handler/app/Test.hs index b545e8880..5e3c77edc 100644 --- a/infra/handler/app/Test.hs +++ b/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' ) :<|> diff --git a/infra/handler/package.yaml b/infra/handler/package.yaml index bf165a37a..7b1786fdc 100644 --- a/infra/handler/package.yaml +++ b/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 diff --git a/infra/handler/src/DeckGo/Handler.hs b/infra/handler/src/DeckGo/Handler.hs index 75b01f507..0d191f524 100644 --- a/infra/handler/src/DeckGo/Handler.hs +++ b/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 diff --git a/infra/lambda.tf b/infra/lambda.tf index e8d864813..535ce1885 100644 --- a/infra/lambda.tf +++ b/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 = [