~philipwhite/webpad

21fa466ef768730fef135fba53dd89829ac000d7 — Linux User 2 years ago bde2492
Use stronger type for user IDs.
1 files changed, 13 insertions(+), 5 deletions(-)

M Main.hs
M Main.hs => Main.hs +13 -5
@@ 105,12 105,12 @@ roleSelect roleType = select_ $ do
    option_ [value_ "editor"] "Editor"
    option_ [value_ "owner"] "Owner"

sharePage :: [(T.Text, T.Text, RoleType)] -> Document -> CsrfToken -> Html ()
sharePage :: [(UserId, T.Text, RoleType)] -> Document -> CsrfToken -> Html ()
sharePage roles (Document filename title public) csrfToken =
    page "Share" "/share.css" $ do
        h1_ (toHtml ("Share " <> show title))
        table_ $ tbody_ [id_ "roles-table"] $ do
            mapM_ (\(userId, username, roleType) -> tr_ [id_ ("role-row-" <> userId), selenium_ ("role-" <> username)] $ do
            mapM_ (\((UserId userId), username, roleType) -> tr_ [id_ ("role-row-" <> userId), selenium_ ("role-" <> username)] $ do
                td_ $ toHtml username
                td_ $ with (roleSelect roleType) [oninput_ ("update_role(this, '" <> filename <> "', '" <> userId <> "')")]
                td_ $ button_ [onclick_ ("delete_role('" <> filename <> "', '" <> userId <> "')"), selenium_ ("delete-" <> username)] "delete") roles


@@ 235,13 235,21 @@ instance FromJSON Login where
    parseJSON = withObject "login" $ \o -> do
        Login <$> o .: "username" <*> o.: "password"

data UserRow = UserRow T.Text T.Text Bool deriving (Show)
newtype UserId = UserId T.Text deriving (Show, Eq)

instance ToField UserId where
    toField (UserId userId) = toField userId

instance FromField UserId where
    fromField field = UserId <$> fromField field

data UserRow = UserRow UserId T.Text Bool deriving (Show)

instance FromRow UserRow where
    fromRow = UserRow <$> field <*> field <*> field

userToItem :: UserRow -> Html ()
userToItem (UserRow userId username isAdmin) =
userToItem (UserRow (UserId userId) username isAdmin) =
    let classes = if isAdmin then "user-item admin-user-item" else "user-item" in
    li_ [id_ ("user-item-" <> userId), class_ classes] $ do
        toHtml username


@@ 351,7 359,7 @@ requireAuthenticatedUser conn = do
        Just userRow -> pure userRow
        _ -> redirect "/login"

getUserRole :: Connection -> T.Text -> T.Text -> ActionM (Maybe RoleType)
getUserRole :: Connection -> T.Text -> UserId -> ActionM (Maybe RoleType)
getUserRole conn filename userId = do
     roles <- liftIO $ query conn "select type from roles \
                                  \where document = ? \