From 3f60c8b1104bb74d83ebc07e17678210642449c3 Mon Sep 17 00:00:00 2001 From: "Sandeep.C.R" Date: Mon, 7 Nov 2016 09:21:41 +0000 Subject: [PATCH] Update housekeeping columns without lens --- SpockOpaleye/src/DataTypes.hs | 10 +++++++--- SpockOpaleye/src/OpaleyeDef.hs | 22 +++++++++++----------- SpockOpaleye/src/RoleAPi.hs | 9 ++++++++- SpockOpaleye/src/TenantApi.hs | 11 +++++++---- SpockOpaleye/src/UserApi.hs | 19 ++++++++++++++----- 5 files changed, 47 insertions(+), 24 deletions(-) diff --git a/SpockOpaleye/src/DataTypes.hs b/SpockOpaleye/src/DataTypes.hs index 413cb27..d8b297a 100644 --- a/SpockOpaleye/src/DataTypes.hs +++ b/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) diff --git a/SpockOpaleye/src/OpaleyeDef.hs b/SpockOpaleye/src/OpaleyeDef.hs index 89533a4..a63f038 100644 --- a/SpockOpaleye/src/OpaleyeDef.hs +++ b/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 diff --git a/SpockOpaleye/src/RoleAPi.hs b/SpockOpaleye/src/RoleAPi.hs index 0be02e5..5694817 100644 --- a/SpockOpaleye/src/RoleAPi.hs +++ b/SpockOpaleye/src/RoleAPi.hs @@ -13,6 +13,7 @@ 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 @@ -20,7 +21,13 @@ 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 diff --git a/SpockOpaleye/src/TenantApi.hs b/SpockOpaleye/src/TenantApi.hs index 12e425b..3b8cbce 100644 --- a/SpockOpaleye/src/TenantApi.hs +++ b/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 diff --git a/SpockOpaleye/src/UserApi.hs b/SpockOpaleye/src/UserApi.hs index b94a304..401ddfc 100644 --- a/SpockOpaleye/src/UserApi.hs +++ b/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