Update housekeeping columns without lens

SpockOpaleye/src/DataTypes.hs

@@ -1,14 +1,14 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances #-}
 
 module DataTypes where
 
 import           CryptoDef
 import           Data.List.NonEmpty
 import           Data.Text
+import           Data.Time          (UTCTime)
 import           GHC.Generics
-import           Data.Time(UTCTime)
 
 data ValidationResult = Valid | Invalid
   deriving (Eq, Show)
@@ -57,6 +57,10 @@ data UserPoly key created_at updated_at tenant_id username password firstname la
 
 type User = UserPoly UserId UTCTime UTCTime TenantId Text BcryptPassword (Maybe Text) (Maybe Text) UserStatus
 
+type UserIncoming = UserPoly () () () TenantId Text Text (Maybe Text) (Maybe Text) ()
+
+type UserIncomingSafe = UserPoly () () () TenantId Text BcryptPassword (Maybe Text) (Maybe Text) ()
+
 data Permission = Read | Create | Update | Delete
   deriving (Show)
 

SpockOpaleye/src/OpaleyeDef.hs

@@ -1,5 +1,5 @@
-{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE TemplateHaskell       #-}
@@ -12,10 +12,10 @@ import           Data.Profunctor.Product
 import qualified Data.Profunctor.Product.Default      as D
 import           Data.Profunctor.Product.TH           (makeAdaptorAndInstance)
 import           Data.Text
-import           Data.Time(UTCTime)
 import           Data.Text.Encoding
-import           Database.PostgreSQL.Simple.FromField
+import           Data.Time                            (UTCTime)
 import           Database.PostgreSQL.Simple           (Connection)
+import           Database.PostgreSQL.Simple.FromField
 import           Opaleye
 
 import           Control.Lens
@@ -76,7 +76,7 @@ type UserTableW = UserPoly
   (Column PGBytea)
   (Maybe (Column (Nullable PGText)))
   (Maybe (Column (Nullable PGText)))
-  (Column PGText)
+  (Maybe (Column PGText))
 
 type UserTableR = UserPoly
   (Column PGInt4)
@@ -103,7 +103,7 @@ userTable = Table "users" (pUser
   , user_password = required "password"
   , user_firstname = optional "first_name"
   , user_lastname = optional "last_name"
-  , user_status = required "status"
+  , user_status = optional "status"
  })
 
 type RoleTableW = RolePoly
@@ -158,13 +158,13 @@ instance FromField TenantStatus where
 instance QueryRunnerColumnDefault PGText TenantStatus where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance D.Default Constant UserStatus (Column PGText) where
+instance D.Default Constant UserStatus (Maybe (Column PGText)) where
   def = Constant def'
     where
-      def' :: UserStatus -> (Column PGText)
-      def' UserStatusInActive = pgStrictText "inactive"
-      def' UserStatusActive   = pgStrictText "active"
-      def' UserStatusBlocked  = pgStrictText "blocked"
+      def' :: UserStatus -> Maybe (Column PGText)
+      def' UserStatusInActive = Just $ pgStrictText "inactive"
+      def' UserStatusActive   = Just $ pgStrictText "active"
+      def' UserStatusBlocked  = Just $ pgStrictText "blocked"
 
 instance FromField (UserStatus) where
   fromField f mdata = return gender
@@ -304,6 +304,6 @@ instance D.Default Constant () (Maybe (Column PGTimestamptz)) where
 instance D.Default Constant UTCTime (Maybe (Column PGTimestamptz)) where
   def = Constant (\time -> Just $ pgUTCTime time)
 
-create_item :: (D.Default Constant haskells columnsW, D.Default QueryRunner returned b) 
+create_item :: (D.Default Constant haskells columnsW, D.Default QueryRunner returned b)
     => Connection -> Table columnsW returned -> haskells -> IO b
 create_item conn table item = fmap Prelude.head $ runInsertManyReturning conn table [constant item] id

SpockOpaleye/src/RoleAPi.hs

@@ -13,14 +13,21 @@ module RoleApi
 import           Control.Arrow
 import           Data.List.NonEmpty
 import           Data.Text
+import           Data.Time                  (getCurrentTime)
 import           Database.PostgreSQL.Simple (Connection)
 import           DataTypes
 import           GHC.Int
 import           Opaleye
 import           OpaleyeDef
 
 create_role :: Connection -> Role -> IO Role
-create_role conn role = fmap Prelude.head $ runInsertManyReturning conn roleTable [constant role] id
+create_role conn role = do
+  current_time <- getCurrentTime
+  fmap Prelude.head $ runInsertManyReturning conn roleTable [constant (role {
+      role_createdat = current_time,
+      role_updatedat = current_time
+    })
+    ] id
 
 remove_role :: Connection -> Role -> IO GHC.Int.Int64
 remove_role conn Role {role_id = t_id} = do

SpockOpaleye/src/TenantApi.hs

@@ -17,6 +17,7 @@ module TenantApi
 
 import           Control.Arrow
 import           Data.Text
+import           Data.Time                  (UTCTime, getCurrentTime)
 import           Database.PostgreSQL.Simple (Connection)
 import           DataTypes
 import           GHC.Int
@@ -27,7 +28,8 @@ import           UserApi
 
 create_tenant :: Connection -> TenantIncoming -> IO Tenant
 create_tenant conn tenant = do
-  create_item conn tenantTable tenant 
+  current_time <- getCurrentTime
+  create_item conn tenantTable tenant { tenant_createdat = current_time, tenant_updatedat = current_time }
 
 activate_tenant :: Connection -> Tenant -> IO Tenant
 activate_tenant conn tenant = set_tenant_status conn tenant TenantStatusActive
@@ -40,13 +42,14 @@ set_tenant_status conn tenant status = update_tenant conn (tenant_id tenant) ten
 
 update_tenant :: Connection -> TenantId -> Tenant -> IO Tenant
 update_tenant conn t_tenantid tenant = do
-  runUpdate conn tenantTable update_func match_func
+  current_time <- getCurrentTime
+  runUpdate conn tenantTable (update_func current_time) match_func
   return tenant
   where
     match_func :: TenantTableR -> Column PGBool
     match_func Tenant { tenant_id = id } = id .== constant t_tenantid
-    update_func :: TenantTableR -> TenantTableW
-    update_func x = constant tenant
+    update_func :: UTCTime -> TenantTableR -> TenantTableW
+    update_func current_time x = constant (tenant { tenant_updatedat = current_time })
 
 remove_tenant :: Connection -> Tenant -> IO GHC.Int.Int64
 remove_tenant conn tenant@Tenant {tenant_id = tid} = do

SpockOpaleye/src/UserApi.hs

@@ -18,6 +18,7 @@ module UserApi
 
 import           Control.Arrow
 import           Data.Text
+import           Data.Time                  (UTCTime, getCurrentTime)
 import           Database.PostgreSQL.Simple (Connection)
 import           DataTypes
 import           GHC.Int
@@ -26,16 +27,24 @@ import           OpaleyeDef
 
 import           CryptoDef
 
-create_user :: Connection -> User -> IO User
-create_user conn user = Prelude.head <$> runInsertManyReturning conn userTable [constant user] id
+create_user :: Connection -> UserIncoming -> IO User
+create_user conn user@ User { user_password = password } = do
+  Just hash <- bcryptPassword password
+  current_time <- getCurrentTime
+  Prelude.head <$> runInsertManyReturning conn userTable [constant (user {
+        user_createdat = current_time
+      , user_updatedat = current_time
+      , user_password = hash
+      } )] id
 
 update_user :: Connection -> UserId -> User -> IO User
 update_user conn user_id user = do
-  runUpdate conn userTable update_func match_func
+  current_time <- getCurrentTime
+  runUpdate conn userTable (update_func current_time) match_func
   return user
   where
-    update_func :: UserTableR -> UserTableW
-    update_func _ = constant user
+    update_func :: UTCTime -> UserTableR -> UserTableW
+    update_func current_time _ = constant (user { user_updatedat = current_time } )
     match_func :: UserTableR -> Column PGBool
     match_func User { user_id = id } = id .== constant user_id