Use the records directly without converting to thier PG counterparts …

…while doing db manipulations

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"

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)
+

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

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

SpockOpaleye/src/UserApi.hs

@@ -26,87 +26,38 @@ 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
     where
     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