From 45c7a2d6cc50424204e5075d17b133e776ee2445 Mon Sep 17 00:00:00 2001 From: "Sandeep.C.R" Date: Fri, 4 Nov 2016 18:11:50 +0000 Subject: [PATCH] Use the records directly without converting to thier PG counterparts while doing db manipulations --- SpockOpaleye/app/Main.hs | 21 ++++----- SpockOpaleye/src/OpaleyeDef.hs | 22 +++++++++ SpockOpaleye/src/RoleAPi.hs | 15 +----- SpockOpaleye/src/TenantApi.hs | 35 +++----------- SpockOpaleye/src/UserApi.hs | 85 +++++++--------------------------- 5 files changed, 57 insertions(+), 121 deletions(-) diff --git a/SpockOpaleye/app/Main.hs b/SpockOpaleye/app/Main.hs index 36fce98..9f85908 100644 --- a/SpockOpaleye/app/Main.hs +++ b/SpockOpaleye/app/Main.hs @@ -34,15 +34,12 @@ app :: SpockM Connection MySession MyAppState () app = do post ("tenants/new") $ do maybe_tenant_incoming <- jsonBody - maybe_newtenant <- - case maybe_tenant_incoming of - Just incoming_tenant -> do - result <- - runQuery (\conn -> validateIncomingTenant conn incoming_tenant) - case result of - Valid -> runQuery (\conn -> create_tenant conn incoming_tenant) - _ -> return Nothing - Nothing -> return Nothing - case maybe_newtenant of - Just tenant -> json tenant - _ -> json $ T.pack "Tenant not created" + case maybe_tenant_incoming of + Just incoming_tenant -> do + result <- runQuery (\conn -> validateIncomingTenant conn incoming_tenant) + case result of + Valid -> do + new_tenant <- runQuery (\conn -> create_tenant conn incoming_tenant) + json new_tenant + _ -> json $ T.pack "Validation fail" + Nothing -> json $ T.pack "Unrecognized input" diff --git a/SpockOpaleye/src/OpaleyeDef.hs b/SpockOpaleye/src/OpaleyeDef.hs index bc87459..c155fb7 100644 --- a/SpockOpaleye/src/OpaleyeDef.hs +++ b/SpockOpaleye/src/OpaleyeDef.hs @@ -210,6 +210,12 @@ instance D.Default Constant (UserId) (Column (Nullable PGInt4)) where def' :: UserId -> (Column (Nullable PGInt4)) def' (UserId id) = (toNullable.pgInt4) id +instance D.Default Constant (UserId) (Maybe (Column PGInt4)) where + def = Constant def' + where + def' :: UserId -> Maybe (Column PGInt4) + def' (UserId id) = Just $ pgInt4 id + instance FromField UserId where fromField field mdata = do x <- fromField field mdata @@ -225,6 +231,12 @@ instance D.Default Constant (RoleId) (Column PGInt4) where def' :: RoleId -> (Column PGInt4) def' (RoleId id) = pgInt4 id +instance D.Default Constant (RoleId) (Maybe (Column PGInt4)) where + def = Constant def' + where + def' :: RoleId -> Maybe (Column PGInt4) + def' (RoleId id) = Just $ pgInt4 id + instance FromField RoleId where fromField field mdata = do x <- fromField field mdata @@ -240,6 +252,12 @@ instance D.Default Constant (TenantId) (Column PGInt4) where def' :: TenantId -> (Column PGInt4) def' (TenantId id) = pgInt4 id +instance D.Default Constant (TenantId) (Maybe (Column PGInt4)) where + def = Constant def' + where + def' :: TenantId -> Maybe (Column PGInt4) + def' (TenantId id) = Just $ pgInt4 id + instance FromField TenantId where fromField field mdata = do x <- fromField field mdata @@ -258,3 +276,7 @@ instance D.Default Constant () (Column PGText) where instance D.Default Constant () (Column (Nullable PGText)) where def = Constant (\_ -> toNullable $ pgStrictText "") + +instance D.Default Constant Text (Column (Nullable PGText)) where + def = Constant (toNullable.pgStrictText) + diff --git a/SpockOpaleye/src/RoleAPi.hs b/SpockOpaleye/src/RoleAPi.hs index 313c483..0be02e5 100644 --- a/SpockOpaleye/src/RoleAPi.hs +++ b/SpockOpaleye/src/RoleAPi.hs @@ -19,19 +19,8 @@ import GHC.Int import Opaleye import OpaleyeDef -create_role :: Connection -> Role -> IO (Maybe Role) -create_role conn role@Role { role_tenantid = tenant_id , role_name = name , role_permission = rp } = do - ids <- - runInsertManyReturning - conn roleTable (return Role { - role_id = Nothing, - role_tenantid = constant tenant_id, - role_name = pgStrictText name, - role_permission = constant rp - }) id - return $ case ids of - [] -> Nothing - (x:xs) -> Just x +create_role :: Connection -> Role -> IO Role +create_role conn role = fmap Prelude.head $ runInsertManyReturning conn roleTable [constant role] id remove_role :: Connection -> Role -> IO GHC.Int.Int64 remove_role conn Role {role_id = t_id} = do diff --git a/SpockOpaleye/src/TenantApi.hs b/SpockOpaleye/src/TenantApi.hs index 2532c1e..f9c52e0 100644 --- a/SpockOpaleye/src/TenantApi.hs +++ b/SpockOpaleye/src/TenantApi.hs @@ -25,12 +25,9 @@ import OpaleyeDef import RoleApi import UserApi -create_tenant :: Connection -> TenantIncoming -> IO (Maybe Tenant) +create_tenant :: Connection -> TenantIncoming -> IO Tenant create_tenant conn tenant = do - tenants <- runInsertManyReturning conn tenantTable [constant tenant] id - return $ case tenants of - [] -> Nothing - (x:xs) -> Just x + fmap Prelude.head $ runInsertManyReturning conn tenantTable [constant tenant] id activate_tenant :: Connection -> Tenant -> IO Tenant activate_tenant conn tenant = set_tenant_status conn tenant TenantStatusActive @@ -39,37 +36,17 @@ deactivate_tenant :: Connection -> Tenant -> IO Tenant deactivate_tenant conn tenant = set_tenant_status conn tenant TenantStatusInActive set_tenant_status :: Connection -> Tenant -> TenantStatus -> IO Tenant -set_tenant_status conn tenant status = update_tenant conn (tenant_id tenant) - tenant { tenant_status = status } +set_tenant_status conn tenant status = update_tenant conn (tenant_id tenant) tenant { tenant_status = status } update_tenant :: Connection -> TenantId -> Tenant -> IO Tenant -update_tenant conn t_tenantid tenant@Tenant { - tenant_id = id - ,tenant_name = name - ,tenant_firstname = first_name - ,tenant_lastname = last_name - ,tenant_email = email - ,tenant_phone = phone - ,tenant_status = status - ,tenant_ownerid = owner_id - ,tenant_backofficedomain = bo_domain} = do +update_tenant conn t_tenantid tenant = do runUpdate conn tenantTable update_func match_func return tenant where match_func :: TenantTableR -> Column PGBool - match_func Tenant { tenant_id = id } = id .== (constant t_tenantid) + match_func Tenant { tenant_id = id } = id .== constant t_tenantid update_func :: TenantTableR -> TenantTableW - update_func x = Tenant { - tenant_id = constant $ Just id - ,tenant_name = pgStrictText name - ,tenant_firstname = pgStrictText first_name - ,tenant_lastname = pgStrictText last_name - ,tenant_email = pgStrictText email - ,tenant_phone = pgStrictText phone - ,tenant_status = constant status - ,tenant_ownerid = toNullable . constant <$> owner_id - ,tenant_backofficedomain = pgStrictText bo_domain - } + update_func x = constant tenant remove_tenant :: Connection -> Tenant -> IO GHC.Int.Int64 remove_tenant conn tenant@Tenant {tenant_id = tid} = do diff --git a/SpockOpaleye/src/UserApi.hs b/SpockOpaleye/src/UserApi.hs index 6183ec5..b94a304 100644 --- a/SpockOpaleye/src/UserApi.hs +++ b/SpockOpaleye/src/UserApi.hs @@ -26,73 +26,27 @@ import OpaleyeDef import CryptoDef -create_user :: Connection -> User -> IO (Maybe User) -create_user conn user@User { - user_id = _ - ,user_tenantid = tenant_id - ,user_username = username - ,user_password = password - ,user_firstname = first_name - ,user_lastname = last_name - ,user_status = status - } = do - users <- - runInsertManyReturning conn userTable (return User { - user_id = Nothing - ,user_tenantid = constant tenant_id - ,user_username = pgStrictText username - ,user_password = constant password - ,user_firstname = toNullable . pgStrictText <$> first_name - ,user_lastname = toNullable . pgStrictText <$> last_name - ,user_status = constant status - }) id - return $ case users of - [] -> Nothing - (x:xs) -> Just x - -update_user :: Connection -> UserId -> User -> IO GHC.Int.Int64 -update_user conn (UserId tid) (User { - user_id = _ - ,user_tenantid = tenant_id - ,user_username = username - ,user_password = password - ,user_firstname = firstname - ,user_lastname = lastname - ,user_status = status }) = runUpdate conn userTable update_func match_func +create_user :: Connection -> User -> IO User +create_user conn user = Prelude.head <$> runInsertManyReturning conn userTable [constant user] id + +update_user :: Connection -> UserId -> User -> IO User +update_user conn user_id user = do + runUpdate conn userTable update_func match_func + return user where - update_func User { user_id = id } = User { - user_id = Just id - , user_tenantid = constant tenant_id - , user_username = pgStrictText username - , user_password = constant password - , user_firstname = toNullable . pgStrictText <$> firstname - , user_lastname = toNullable . pgStrictText <$> lastname - , user_status = constant status - } - match_func User { user_id = id } = id .== constant tid - -activate_user :: Connection -> User -> IO GHC.Int.Int64 + update_func :: UserTableR -> UserTableW + update_func _ = constant user + match_func :: UserTableR -> Column PGBool + match_func User { user_id = id } = id .== constant user_id + +activate_user :: Connection -> User -> IO User activate_user conn user = set_user_status conn user UserStatusActive -deactivate_user :: Connection -> User -> IO GHC.Int.Int64 +deactivate_user :: Connection -> User -> IO User deactivate_user conn user = set_user_status conn user UserStatusInActive -set_user_status :: Connection -> User -> UserStatus -> IO GHC.Int.Int64 -set_user_status conn user@User { - user_id = id - ,user_tenantid = tid - ,user_username = username - ,user_password = password - ,user_firstname = firstname - ,user_lastname = lastname - ,user_status = status} new_status = update_user conn id User { user_id = id - ,user_tenantid = tid - ,user_username = username - ,user_password = password - ,user_firstname = firstname - ,user_lastname = lastname - ,user_status = new_status } - +set_user_status :: Connection -> User -> UserStatus -> IO User +set_user_status conn user new_status = update_user conn (user_id user) user { user_status = new_status } remove_user :: Connection -> User -> IO GHC.Int.Int64 remove_user conn User {user_id = tid} = runDelete conn userTable match_function @@ -100,13 +54,10 @@ remove_user conn User {user_id = tid} = match_function User { user_id = id } = id .== constant tid read_users :: Connection -> IO [User] -read_users conn = do - runQuery conn $ user_query +read_users conn = runQuery conn user_query read_users_for_tenant :: Connection -> TenantId -> IO [User] -read_users_for_tenant conn tenant_id = do - r <- runQuery conn $ user_query_by_tenantid tenant_id - return r +read_users_for_tenant conn tenant_id = runQuery conn $ user_query_by_tenantid tenant_id read_user_by_id :: Connection -> UserId -> IO (Maybe User) read_user_by_id conn id = do