~philipwhite/webpad

13eb1e12ca08a0ce4ba6c72193ef4db70bbedb37 — Linux User 2 years ago 21fa466
Make username use stronger type
1 files changed, 15 insertions(+), 6 deletions(-)

M Main.hs
M Main.hs => Main.hs +15 -6
@@ 22,6 22,7 @@ import Data.Maybe (isJust, isNothing, listToMaybe)
import Data.Void
import Data.Word
import Data.Time.Clock.POSIX (getPOSIXTime)
import Data.Char

import Database.SQLite.Simple
import Database.SQLite.Simple.FromRow


@@ 171,7 172,18 @@ documentPage (Document filename title public) body role _ =
            selenium_ "body"] (toHtml body)
        with (script_ "") [src_ "/index.js"]

data AddRole = AddRole T.Text RoleType deriving Show
newtype Username = Username T.Text deriving Show

instance FromJSON Username where
    parseJSON = withText "username" $ \text -> do
        if T.length text == 0 || T.length text > 50 then fail usernameRequirement
        else if not (T.all isAlphaNum text) then fail "invalid username"
        else pure (Username text)

instance ToField Username where
    toField (Username username) = toField username

data AddRole = AddRole Username RoleType deriving Show

instance FromJSON AddRole where
    parseJSON = withObject "add-role" $ \o -> AddRole <$> o .: "username" <*> o .: "role"


@@ 195,7 207,7 @@ instance FromJSON UpdateDocument where
        newPublicity <- o .:? "public"
        pure (UpdateDocument newTitle newBody newPublicity)

data Registration = Registration T.Text T.Text Bool deriving (Show)
data Registration = Registration Username T.Text Bool deriving (Show)

data RoleType = Owner | Editor | Viewer deriving (Show, Eq, Enum)



@@ 219,9 231,7 @@ instance FromJSON Registration where
        username <- o .: "username"
        password <- o .: "password"
        isAdmin <- o .: "isAdmin"
        if T.length username == 0 || T.length username > 50 then fail usernameRequirement
        -- TODO: Check that username consists entirely of valid characters.
        else if T.length password < 2 || T.length password > 50 then fail passwordRequirement
        if T.length password < 2 || T.length password > 50 then fail passwordRequirement
        else return (Registration username password isAdmin)

data DeleteUser = DeleteUser T.Text


@@ 274,7 284,6 @@ page title stylesheet body = doctypehtml_ $ do
selenium_ :: T.Text -> Attribute
selenium_ = makeAttribute "data-selenium"


data Document = Document T.Text T.Text Bool deriving (Show)

instance FromRow Document where