From 9f788186875cab141c73c59dde1b8bb86f002a4f Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 9 Aug 2019 20:55:40 +0200 Subject: [PATCH 1/8] let the function get the time itself --- src/Main.hs | 3 +-- src/Model/Amount.hs | 33 +++++++++++++++++---------------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index bb0af17..b3476dc 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -181,9 +181,8 @@ userList muid ref = do productNew :: Maybe Int -> ProductSubmit -> MateHandler Int productNew (Just _) bevsub = do conn <- rsConnection <$> ask - now <- liftIO $ getCurrentTime bevid <- insertProduct bevsub conn - void $ insertNewEmptyAmount bevid now bevsub conn + void $ insertNewEmptyAmount bevid bevsub conn return bevid productNew Nothing _ = throwError $ err403 diff --git a/src/Model/Amount.hs b/src/Model/Amount.hs index 94873ff..fa9b1a8 100644 --- a/src/Model/Amount.hs +++ b/src/Model/Amount.hs @@ -56,25 +56,26 @@ amountTable = table "amount" ( insertNewEmptyAmount :: Int -- | the associated product id - -> UTCTime -- | current time -> ProductSubmit -- | submitted product data -> PGS.Connection -> MateHandler Int -insertNewEmptyAmount bevid now (ProductSubmit _ price _ _ _ _ _ _ _) conn = - fmap head $ liftIO $ runInsert_ conn $ Insert - { iTable = amountTable - , iRows = - [ - ( C.constant bevid - , C.constant now - , C.constant (0 :: Int) - , C.constant price - , C.constant False - ) - ] - , iReturning = rReturning (\(id_, _, _, _, _) -> id_) - , iOnConflict = Nothing - } +insertNewEmptyAmount bevid (ProductSubmit _ price _ _ _ _ _ _ _) conn = + liftIO $ do + now <- getCurrentTime + fmap head $ runInsert_ conn $ Insert + { iTable = amountTable + , iRows = + [ + ( C.constant bevid + , C.constant now + , C.constant (0 :: Int) + , C.constant price + , C.constant False + ) + ] + , iReturning = rReturning (\(id_, _, _, _, _) -> id_) + , iOnConflict = Nothing + } getLatestPriceByProductId :: Int -- The associated Product ID From 61b094e3e69ba17c05b21613760cbfaf8425693d Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 9 Aug 2019 20:55:57 +0200 Subject: [PATCH 2/8] limit the returned rows --- src/Model/Amount.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Model/Amount.hs b/src/Model/Amount.hs index fa9b1a8..0ce9556 100644 --- a/src/Model/Amount.hs +++ b/src/Model/Amount.hs @@ -83,7 +83,7 @@ getLatestPriceByProductId -> MateHandler Int -- The price in cents getLatestPriceByProductId pid conn = do amounts <- liftIO $ runSelect conn $ - orderBy (desc (\(_, ts, _, _, _) -> ts)) + limit 1 $ orderBy (desc (\(_, ts, _, _, _) -> ts)) (keepWhen (\(id_, _, _, _, _) -> id_ .== C.constant pid) <<< queryTable amountTable) :: MateHandler [ ( Int @@ -103,7 +103,7 @@ getLatestAmountByProductId -> MateHandler Int -- The amount getLatestAmountByProductId pid conn = do amounts <- liftIO $ runSelect conn $ - orderBy (desc (\(_, ts, _, _, _) -> ts)) + limit 1 $ orderBy (desc (\(_, ts, _, _, _) -> ts)) (keepWhen (\(id_, _, _, _, _) -> id_ .== C.constant pid) <<< queryTable amountTable) :: MateHandler [ ( Int @@ -124,7 +124,7 @@ getLatestTotalPrice -> MateHandler Int -- The price in cents getLatestTotalPrice (PurchaseDetail pid amount) conn = do amounts <- liftIO $ runSelect conn $ - orderBy (desc (\(_, ts, _, _, _) -> ts)) $ + limit 1 $ orderBy (desc (\(_, ts, _, _, _) -> ts)) $ keepWhen (\(id_, _, _, _, _) -> id_ .== C.constant pid) <<< queryTable amountTable :: MateHandler @@ -146,7 +146,7 @@ checkProductAvailability -> MateHandler (Maybe Int) -- | Returns maybe missing amount checkProductAvailability (PurchaseDetail pid amount) conn = do realamount <- (\(_, _, ramount, _, _) -> ramount) <$> head <$> - (liftIO $ runSelect conn $ + (liftIO $ runSelect conn $ limit 1 $ orderBy (desc (\(_, ts, _, _, _) -> ts)) $ keepWhen (\(id_, _, _, _, _) -> id_ .== C.constant pid) <<< queryTable amountTable @@ -230,7 +230,7 @@ postBuyProductAmountUpdate postBuyProductAmountUpdate (PurchaseDetail pid pdamount) conn = do now <- liftIO $ getCurrentTime (amount, oldprice) <- (\(_, _, am, op, _) -> (am, op)) <$> head <$> ( - liftIO $ runSelect conn $ + liftIO $ runSelect conn $ limit 1 $ orderBy (desc (\(_, ts, _, _, _) -> ts)) $ keepWhen (\(id_, _, _, _, _) -> id_ .== C.constant pid) <<< queryTable amountTable From 4e1f1e70d2aacf6e0ea65c80c1998d45d3715c2d Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 9 Aug 2019 20:56:04 +0200 Subject: [PATCH 3/8] some small adjustments --- src/Model/Product.hs | 2 +- src/Model/User.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Model/Product.hs b/src/Model/Product.hs index 471f5f9..53a0ce1 100644 --- a/src/Model/Product.hs +++ b/src/Model/Product.hs @@ -421,7 +421,7 @@ insertProduct (ProductSubmit ident price ml ava sup max apc ppc artnr) conn = , C.constant artnr ) ] - , iReturning = rReturning (\(id, _, _, _, _, _, _, _, _) -> id) + , iReturning = rReturning (\(id_, _, _, _, _, _, _, _, _) -> id_) , iOnConflict = Nothing } diff --git a/src/Model/User.hs b/src/Model/User.hs index 897b0de..c5ee078 100644 --- a/src/Model/User.hs +++ b/src/Model/User.hs @@ -37,10 +37,10 @@ initUser :: PGS.Query initUser = mconcat [ "create table if not exists \"user\" (" , "user_id serial primary key," - , "user_ident varchar(128) not null," + , "user_ident text not null," , "user_balance integer not null," , "user_timestamp date not null," - , "user_email varchar(128)," + , "user_email text," , "user_avatar integer," , "user_salt bytea not null," , "user_hash bytea," From b53cf1bd6f13005efb34362728bb42353c452b57 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 10 Aug 2019 10:37:45 +0200 Subject: [PATCH 4/8] commence cotrolify --- mateamt.cabal | 3 ++ src/Control.hs | 6 ++++ src/Control/Buy.hs | 78 ++++++++++++++++++++++++++++++++++++++++++ src/Control/Journal.hs | 24 +++++++++++++ src/Main.hs | 62 +-------------------------------- 5 files changed, 112 insertions(+), 61 deletions(-) create mode 100644 src/Control.hs create mode 100644 src/Control/Buy.hs create mode 100644 src/Control/Journal.hs diff --git a/mateamt.cabal b/mateamt.cabal index 67d971e..e224e8b 100644 --- a/mateamt.cabal +++ b/mateamt.cabal @@ -23,6 +23,9 @@ flag develop executable mateamt main-is: Main.hs other-modules: API + , Control + , Control.Buy + , Control.Journal , Model , Model.User , Model.Product diff --git a/src/Control.hs b/src/Control.hs new file mode 100644 index 0000000..5891a47 --- /dev/null +++ b/src/Control.hs @@ -0,0 +1,6 @@ +module Control + ( module C + ) where + +import Control.Buy as C +import Control.Journal as C diff --git a/src/Control/Buy.hs b/src/Control/Buy.hs new file mode 100644 index 0000000..816499f --- /dev/null +++ b/src/Control/Buy.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE OverloadedStrings #-} +module Control.Buy where + +import Servant + +import Control.Monad (void, foldM) + +import Control.Monad.Reader (ask) + +-- internal imports + +import Types +import Model + +buy + :: Maybe Int + -> [PurchaseDetail] + -> MateHandler PurchaseResult +buy (Just auid) pds = do + conn <- rsConnection <$> ask + (missing, real) <- foldM (\acc@(ms, rs) pd -> do + mmiss <- checkProductAvailability pd conn + case mmiss of + Just miss -> return + ( (pd {purchaseDetailAmount = miss}):ms + , (pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs) + ) + Nothing -> return + ( ms + , pd:rs + ) + ) + ([], []) + pds + void $ mapM_ (\pd -> postBuyProductAmountUpdate pd conn) real + price <- foldM + (\total pd -> + fmap (+ total) (getLatestTotalPrice pd conn) + ) + 0 + real + addToUserBalance auid (-price) conn + newBalance <- userBalanceSelect conn auid + return $ PurchaseResult + ( if newBalance < 0 + then PurchaseDebtful + else PurchaseOK + ) + missing +buy Nothing pds = do + conn <- rsConnection <$> ask + (missing, real) <- foldM (\acc@(ms, rs) pd -> do + mmiss <- checkProductAvailability pd conn + case mmiss of + Just miss -> return + ( (pd {purchaseDetailAmount = miss}):ms + , (pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs) + ) + Nothing -> return + ( ms + , pd:rs + ) + ) + ([], []) + pds + void $ mapM_ + (\pd -> postBuyProductAmountUpdate pd conn) + real + price <- foldM + (\total pd -> + fmap (+ total) (getLatestTotalPrice pd conn) + ) + 0 + real + void $ insertNewJournalEntry (JournalSubmit "Cash purchase" price) conn + return $ PurchaseResult + (PayAmount price) + missing diff --git a/src/Control/Journal.hs b/src/Control/Journal.hs new file mode 100644 index 0000000..72ee286 --- /dev/null +++ b/src/Control/Journal.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} +module Control.Journal where + +import Servant + +import Control.Monad.Reader (ask) + +-- internal imports + +import Types +import Model.Journal + +journalShow + :: Maybe Int + -> Maybe Int + -> Maybe Int + -> MateHandler [JournalEntry] +journalShow (Just _) mlimit moffset = do + conn <- rsConnection <$> ask + selectJournalEntries mlimit moffset conn +journalShow Nothing _ _ = + throwError $ err403 + { errBody = "No Authentication present" + } diff --git a/src/Main.hs b/src/Main.hs index b3476dc..8f9435e 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -39,6 +39,7 @@ import API import Model as M import Types +import Control main :: IO () main = do @@ -226,64 +227,3 @@ productList :: MateHandler [ProductOverview] productList = do conn <- rsConnection <$> ask productOverviewSelect conn - - -buy (Just auid) pds = do - conn <- rsConnection <$> ask - (missing, real) <- foldM (\acc@(ms, rs) pd -> do - mmiss <- checkProductAvailability pd conn - case mmiss of - Just miss -> return - ( (pd {purchaseDetailAmount = miss}):ms - , (pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs) - ) - Nothing -> return - ( ms - , pd:rs - ) - ) - ([], []) - pds - void $ mapM_ (\pd -> postBuyProductAmountUpdate pd conn) real - price <- foldM - (\total pd -> - fmap (+ total) (getLatestTotalPrice pd conn) - ) - 0 - real - addToUserBalance auid (-price) conn - newBalance <- userBalanceSelect conn auid - return $ PurchaseResult - ( if newBalance < 0 - then PurchaseDebtful - else PurchaseOK - ) - missing -buy Nothing pds = do - conn <- rsConnection <$> ask - (missing, real) <- foldM (\acc@(ms, rs) pd -> do - mmiss <- checkProductAvailability pd conn - case mmiss of - Just miss -> return - ( (pd {purchaseDetailAmount = miss}):ms - , (pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs) - ) - Nothing -> return - ( ms - , pd:rs - ) - ) - ([], []) - pds - void $ mapM_ - (\pd -> postBuyProductAmountUpdate pd conn) - real - price <- foldM - (\total pd -> - fmap (+ total) (getLatestTotalPrice pd conn) - ) - 0 - real - return $ PurchaseResult - (PayAmount price) - missing From 9ec49edcb5457bbf215baa042aee25faa5da60a3 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 10 Aug 2019 11:37:24 +0200 Subject: [PATCH 5/8] clean product model --- src/Model/Product.hs | 205 ++++--------------------------------------- 1 file changed, 17 insertions(+), 188 deletions(-) diff --git a/src/Model/Product.hs b/src/Model/Product.hs index 53a0ce1..7a15f34 100644 --- a/src/Model/Product.hs +++ b/src/Model/Product.hs @@ -39,14 +39,10 @@ initProduct = mconcat [ "create table if not exists \"product\" (" , "product_id serial primary key," , "product_ident varchar(128) not null," - -- , "product_price integer not null," - -- , "product_amount integer not null," - -- , "product_vanish integer not null," , "product_ml integer not null," , "product_avatar integer," , "product_supplier integer," , "product_max_amount integer not null," - -- , "product_total_bought integer not null," , "product_amount_per_crate integer not null," , "product_price_per_crate integer," , "product_art_nr varchar(128)" @@ -56,28 +52,20 @@ initProduct = mconcat productTable :: Table ( Maybe (Field SqlInt4) , Field SqlText - -- , Field SqlInt4 - -- , Field SqlInt4 - -- , Field SqlInt4 , Field SqlInt4 , FieldNullable SqlInt4 , FieldNullable SqlInt4 , Field SqlInt4 - -- , Field SqlInt4 , Field SqlInt4 , FieldNullable SqlInt4 , FieldNullable SqlText ) ( Field SqlInt4 , Field SqlText - -- , Field SqlInt4 - -- , Field SqlInt4 - -- , Field SqlInt4 , Field SqlInt4 , FieldNullable SqlInt4 , FieldNullable SqlInt4 , Field SqlInt4 - -- , Field SqlInt4 , Field SqlInt4 , FieldNullable SqlInt4 , FieldNullable SqlText @@ -86,14 +74,10 @@ productTable = table "product" ( p9 ( tableField "product_id" , tableField "product_ident" - -- , tableField "product_price" - -- , tableField "product_amount" - -- , tableField "product_vanish" , tableField "product_ml" , tableField "product_avatar" , tableField "product_supplier" , tableField "product_max_amount" - -- , tableField "product_total_bought" , tableField "product_amount_per_crate" , tableField "product_price_per_crate" , tableField "product_art_nr" @@ -110,22 +94,18 @@ productSelect conn = do ) :: MateHandler [ ( Int , T.Text - -- , Int - -- , Int - -- , Int , Int , Maybe Int , Maybe Int , Int - -- , Int , Int , Maybe Int , Maybe T.Text ) ] mapM - (\(i1, i2, {-i3, i4, i5,-} i6, i7, i8, i9, {-i10,-} i11, i12, i13) -> return $ - Product i1 i2 {-i3 i4 i5-} i6 i7 i8 i9 {-i10-} i11 i12 i13 + (\(i1, i2, i3, i4, i5, i6, i7, i8, i9) -> return $ + Product i1 i2 i3 i4 i5 i6 i7 i8 i9 ) prods @@ -141,21 +121,17 @@ productOverviewSelect conn = do ) :: MateHandler [ ( Int , T.Text - -- , Int - -- , Int - -- , Int , Int , Maybe Int , Maybe Int , Int - -- , Int , Int , Maybe Int , Maybe T.Text ) ] mapM - (\(i1, i2, {-i3, i4, i5,-} i6, i7, i8, i9, {-i10,-} i11, i12, i13) -> do + (\(i1, i2, i3, i4, i5, i6, i7, i8, i9) -> do amounts <- liftIO $ runSelect conn ( proc () -> do stuff@(a1, _, _, _, _) <- orderBy (desc (\(_, ts, _, _, _) -> ts)) @@ -170,8 +146,8 @@ productOverviewSelect conn = do , Bool ) ] - (i3, i4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts - i5 <- return $ (\(_, x) -> x) $ + (ii3, ii4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts + ii5 <- return $ (\(_, x) -> x) $ foldl (\(bef, van) (_, _, amo, _, ver) -> if ver @@ -180,7 +156,7 @@ productOverviewSelect conn = do ) (0, 0) (Prelude.reverse amounts) - i10 <- return $ snd $ foldl (\(bef, tot) (_, _, amo, _, ver) -> + ii10 <- return $ snd $ foldl (\(bef, tot) (_, _, amo, _, ver) -> if ver then (amo, tot) else (amo, tot + max 0 (bef - amo)) @@ -188,7 +164,7 @@ productOverviewSelect conn = do (0, 0) (Prelude.reverse amounts) return $ ProductOverview - i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13 + i1 i2 ii3 ii4 ii5 i3 i4 i5 i6 ii10 i7 i8 i9 ) prods @@ -206,21 +182,17 @@ productOverviewSelectSingle pid conn = do ) :: MateHandler [ ( Int , T.Text - -- , Int - -- , Int - -- , Int , Int , Maybe Int , Maybe Int , Int - -- , Int , Int , Maybe Int , Maybe T.Text ) ] head <$> mapM - (\(i1, i2, {-i3, i4, i5,-} i6, i7, i8, i9, {-i10,-} i11, i12, i13) -> do + (\(i1, i2, i3, i4, i5, i6, i7, i8, i9) -> do amounts <- liftIO $ runSelect conn ( proc () -> do stuff@(a1, _, _, _, _) <- orderBy (desc (\(_, ts, _, _, _) -> ts)) @@ -235,8 +207,8 @@ productOverviewSelectSingle pid conn = do , Bool ) ] - (i3, i4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts - i5 <- return $ (\(_, x) -> x) $ + (ii3, ii4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts + ii5 <- return $ (\(_, x) -> x) $ foldl (\(bef, van) (_, _, amo, _, ver) -> if ver @@ -245,7 +217,7 @@ productOverviewSelectSingle pid conn = do ) (0, 0) (Prelude.reverse amounts) - i10 <- return $ snd $ foldl (\(bef, tot) (_, _, amo, _, ver) -> + ii10 <- return $ snd $ foldl (\(bef, tot) (_, _, amo, _, ver) -> if ver then (amo, tot) else (amo, tot + max 0 (bef - amo)) @@ -253,7 +225,7 @@ productOverviewSelectSingle pid conn = do (0, 0) (Prelude.reverse amounts) return $ ProductOverview - i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13 + i1 i2 ii3 ii4 ii5 i3 i4 i5 i6 ii10 i7 i8 i9 ) prods @@ -269,21 +241,17 @@ productShortOverviewSelect conn = do ) :: MateHandler [ ( Int , T.Text - -- , Int - -- , Int - -- , Int , Int , Maybe Int , Maybe Int , Int - -- , Int , Int , Maybe Int , Maybe T.Text ) ] mapM - (\(i1, i2, {-i3, i4, i5,-} i6, i7, i8, i9, {-i10,-} i11, i12, i13) -> do + (\(i1, i2, i3, i4, i5, i6, i7, i8, i9) -> do amounts <- liftIO $ runSelect conn ( proc () -> do stuff@(a1, _, _, _, _) <- orderBy (desc (\(_, ts, _, _, _) -> ts)) @@ -298,8 +266,8 @@ productShortOverviewSelect conn = do , Bool ) ] - (i3, i4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts - i5 <- return $ (\(_, x) -> x) $ + (ii3, ii4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts + ii5 <- return $ (\(_, x) -> x) $ foldl (\(bef, van) (_, _, amo, _, ver) -> if ver @@ -308,7 +276,7 @@ productShortOverviewSelect conn = do ) (0, 0) (Prelude.reverse amounts) - i10 <- return $ snd $ foldl (\(bef, tot) (_, _, amo, _, ver) -> + ii10 <- return $ snd $ foldl (\(bef, tot) (_, _, amo, _, ver) -> if ver then (amo, tot) else (amo, tot + (bef - amo)) @@ -316,87 +284,11 @@ productShortOverviewSelect conn = do (0, 0) (Prelude.reverse amounts) return $ ProductShortOverview - i1 i2 i3 i4 i6 i7 + i1 i2 ii3 ii4 i3 i4 ) prods --- getProductPrice --- :: PurchaseDetail --- -> PGS.Connection --- -> MateHandler Int --- getProductPrice (PurchaseDetail bid amount) conn = do --- when (amount < 0) ( --- throwError $ err406 --- { errBody = "Amounts less or equal zero are not acceptable" --- } --- ) --- bevs <- liftIO $ runSelect conn --- ( keepWhen --- (\(id_, _, _, _, _, _, _, _, _, _, _) -> id_ .== C.constant bid) <<< --- queryTable productTable --- ) :: MateHandler --- [ ( Int --- , T.Text --- -- , Int --- -- , Int --- , Int --- , Int --- , Maybe Int --- , Maybe Int --- , Int --- , Int --- , Int --- , Maybe Int --- , Maybe T.Text --- ) --- ] --- (amount *) <$> head <$> mapM --- (\(i1, i2, {-i3, i4,-} i5, i6, i7, i8, i9, i10, i11, i12, i13) -> return $ --- i3 --- ) --- bevs - - --- checkProductAvailability --- :: PGS.Connection --- -> PurchaseDetail --- -> MateHandler (Maybe Int) -- | returns maybe missing amount --- checkProductAvailability conn (PurchaseDetail bid amount) = do --- when (amount <= 0) $ --- throwError $ err406 --- { errBody = "Amounts less or equal zero are not acceptable" --- } --- bevs <- liftIO $ runSelect conn --- ( keepWhen --- (\(id_, _, _, _, _, _, _, _, _, _, _) -> id_ .== C.constant bid) <<< --- queryTable productTable --- ) :: MateHandler --- [ ( Int --- , T.Text --- , Int --- -- , Int --- -- , Int --- , Int --- , Maybe Int --- , Maybe Int --- , Int --- , Int --- , Int --- , Maybe Int --- , Maybe T.Text --- ) --- ] --- realamount <- head <$> mapM --- (\(i1, i2, i3, {-i4, i5,-} i6, i7, i8, i9, i10, i11, i12, i13) -> return $ --- i4 --- ) --- bevs --- if realamount < amount --- then return (Just (amount - realamount)) --- else return Nothing - - insertProduct :: ProductSubmit -> PGS.Connection @@ -408,14 +300,10 @@ insertProduct (ProductSubmit ident price ml ava sup max apc ppc artnr) conn = [ ( C.constant (Nothing :: Maybe Int) , C.constant ident - -- , C.constant price - -- , C.constant (0 :: Int) - -- , C.constant (0 :: Int) , C.constant ml , C.constant ava , C.constant sup , C.constant max - -- , C.constant (0 :: Int) , C.constant apc , C.constant ppc , C.constant artnr @@ -424,62 +312,3 @@ insertProduct (ProductSubmit ident price ml ava sup max apc ppc artnr) conn = , iReturning = rReturning (\(id_, _, _, _, _, _, _, _, _) -> id_) , iOnConflict = Nothing } - - --- updateProduct --- :: Int --- -> ProductSubmit --- -> Update Int64 --- updateProduct sid (ProductSubmit ident price ml ava sup max apc ppc artnr) = Update --- { uTable = productTable --- , uUpdateWith = updateEasy (\(id_, _, _, amo, van, _, _, _, _, tot, _, _, _) -> --- ( id_ --- , C.constant ident --- , C.constant price --- , amo --- , van --- , C.constant ml --- , C.constant ava --- , C.constant sup --- , C.constant max --- , tot --- , C.constant apc --- , C.constant ppc --- , C.constant artnr --- ) --- ) --- , uWhere = --- (\(id_, _, _, _, _, _, _, _, _, _, _, _, _) -> --- id_ .== C.constant sid --- ) --- , uReturning = rCount --- } - --- reduceProductAmount --- :: PurchaseDetail --- -> Update Int64 --- reduceProductAmount (PurchaseDetail pid amount) = Update --- { uTable = productTable --- , uUpdateWith = updateEasy --- (\(id_, ident, price, amo, van, ml, ava, sup, max, tot, apc, ppc, artnr) -> --- ( id_ --- , ident --- , price --- , amo - C.constant amount --- , van --- , ml --- , ava --- , sup --- , max --- , tot + C.constant amount --- , apc --- , ppc --- , artnr --- ) --- ) --- , uWhere = --- (\(id_, _, _, _, _, _, _, _, _, _, _, _, _) -> --- id_ .== C.constant pid --- ) --- , uReturning = rCount --- } From d5abbeef2174becda596dc11c080cddcd9383022 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 10 Aug 2019 11:40:01 +0200 Subject: [PATCH 6/8] beautiy init query --- src/Model/Product.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Model/Product.hs b/src/Model/Product.hs index 7a15f34..b6090aa 100644 --- a/src/Model/Product.hs +++ b/src/Model/Product.hs @@ -36,16 +36,16 @@ import Model.Amount initProduct :: PGS.Query initProduct = mconcat - [ "create table if not exists \"product\" (" - , "product_id serial primary key," - , "product_ident varchar(128) not null," - , "product_ml integer not null," - , "product_avatar integer," - , "product_supplier integer," - , "product_max_amount integer not null," - , "product_amount_per_crate integer not null," - , "product_price_per_crate integer," - , "product_art_nr varchar(128)" + [ "CREATE TABLE IF NOT EXISTS \"product\" (" + , "product_id SERIAL PRIMARY KEY," + , "product_ident TEXT NOT NULL," + , "product_ml INTEGER NOT NULL," + , "product_avatar INTEGER," + , "product_supplier INTEGER," + , "product_max_amount INTEGER NOT NULL," + , "product_amount_per_crate INTEGER NOT NULL," + , "product_price_per_crate INTEGER," + , "product_art_nr TEXT" , ")" ] From 24cdc4a53c72053b34dfbf3937a8050a8370e49a Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 10 Aug 2019 11:41:57 +0200 Subject: [PATCH 7/8] beautify auth init query --- src/Model/Auth.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Model/Auth.hs b/src/Model/Auth.hs index 2fc34bd..8846f65 100644 --- a/src/Model/Auth.hs +++ b/src/Model/Auth.hs @@ -50,10 +50,10 @@ import Model.User initToken :: PGS.Query initToken = mconcat - [ "create table if not exists \"token\" (" - , "token_string bytea not null primary key," - , "token_user integer references \"user\"(user_id) not null," - , "token_expiry timestamptz not null" + [ "CREATE TABLE IF NOT EXISTS \"token\" (" + , "token_string BYTEA NOT NULL PRIMARY KEY," + , "token_user INTEGER REFERENCES \"user\"(user_id) NOT NULL," + , "token_expiry TIMESTAMPTZ NOT NULL" , ")" ] From 73eae1d8fd3ac087f164d2178caeae184b5d1f4d Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 10 Aug 2019 11:43:33 +0200 Subject: [PATCH 8/8] beautiy init user query --- src/Model/User.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Model/User.hs b/src/Model/User.hs index c5ee078..d376d7f 100644 --- a/src/Model/User.hs +++ b/src/Model/User.hs @@ -35,16 +35,16 @@ import Types.Reader initUser :: PGS.Query initUser = mconcat - [ "create table if not exists \"user\" (" - , "user_id serial primary key," - , "user_ident text not null," - , "user_balance integer not null," - , "user_timestamp date not null," - , "user_email text," - , "user_avatar integer," - , "user_salt bytea not null," - , "user_hash bytea," - , "user_algo integer" + [ "CREATE TABLE IF NOT EXISTS \"user\" (" + , "user_id SERIAL PRIMARY KEY," + , "user_ident TEXT NOT NULL," + , "user_balance INTEGER NOT NULL," + , "user_timestamp DATE NOT NULL," + , "user_email TEXT," + , "user_avatar INTEGER," + , "user_salt BYTEA NOT NULL," + , "user_hash BYTEA," + , "user_algo INTEGER" , ")" ]