diff options
author | William Carroll <wpcarro@gmail.com> | 2020-07-25T17·32+0100 |
---|---|---|
committer | William Carroll <wpcarro@gmail.com> | 2020-07-25T17·32+0100 |
commit | 722205b0818a7fb2280941554baaff9400808d65 (patch) | |
tree | 483128aff3695a56bfca86a2a8d84f2d71336a73 /src | |
parent | d01161656419370032f19fd659e30c349cac93cb (diff) |
Remodel Account type
Remove unnecessary fields: - name - age Add domain-specific fields: - username - password - email - role
Diffstat (limited to 'src')
-rw-r--r-- | src/App.hs | 4 | ||||
-rw-r--r-- | src/Types.hs | 29 |
2 files changed, 22 insertions, 11 deletions
diff --git a/src/App.hs b/src/App.hs index 40dc23a303a0..a13ffa2d3066 100644 --- a/src/App.hs +++ b/src/App.hs @@ -32,7 +32,7 @@ server pool = userAdd :: T.Account -> IO (Maybe T.Session) userAdd newUser = flip runSqlPersistMPool pool $ do - exists <- selectFirst [T.AccountName ==. (T.accountName newUser)] [] + exists <- selectFirst [T.AccountUsername ==. (T.accountUsername newUser)] [] case exists of Nothing -> do insert newUser @@ -44,7 +44,7 @@ server pool = userGet :: Text -> IO (Maybe T.Account) userGet name = flip runSqlPersistMPool pool $ do - mUser <- selectFirst [T.AccountName ==. name] [] + mUser <- selectFirst [T.AccountUsername ==. name] [] pure $ entityVal <$> mUser app :: ConnectionPool -> Application diff --git a/src/Types.hs b/src/Types.hs index 813a4b51c305..fc1516e5b746 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -7,6 +7,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE NamedFieldPuns #-} -------------------------------------------------------------------------------- module Types where -------------------------------------------------------------------------------- @@ -17,21 +18,31 @@ import Database.Persist.TH share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| Account - name Text - age Int - UniqueName name + username Text + password Text + email Text + role Text + UniqueUsername username + UniqueEmail email deriving Eq Read Show |] instance FromJSON Account where - parseJSON = withObject "User" $ \ v -> - Account <$> v .: "name" - <*> v .: "age" + parseJSON = withObject "Account" $ \ v -> + Account <$> v .: "username" + <*> v .: "password" + <*> v .: "email" + <*> v .: "role" instance ToJSON Account where - toJSON (Account name age) = - object [ "name" .= name - , "age" .= age + toJSON (Account{ accountUsername + , accountPassword + , accountEmail + , accountRole }) = + object [ "username" .= accountUsername + , "password" .= accountPassword + , "email" .= accountEmail + , "role" .= accountRole ] newtype Username = Username Text |