get things in order
This commit is contained in:
parent
ece76fe5de
commit
a937fe4775
8 changed files with 230 additions and 119 deletions
|
@ -32,11 +32,11 @@ type UserAPI =
|
||||||
:> Capture "id" Int :> ReqBody '[JSON] UserDetailsSubmit :> Post '[JSON] ()
|
:> Capture "id" Int :> ReqBody '[JSON] UserDetailsSubmit :> Post '[JSON] ()
|
||||||
)
|
)
|
||||||
:<|> "product" :>
|
:<|> "product" :>
|
||||||
( "list" :> Get '[JSON] [Product]
|
( "list" :> Get '[JSON] [ProductOverview]
|
||||||
:<|> "new" :> AuthProtect "header-auth" :> ReqBody '[JSON] ProductSubmit
|
:<|> "new" :> AuthProtect "header-auth" :> ReqBody '[JSON] ProductSubmit
|
||||||
:> Post '[JSON] Int
|
:> Post '[JSON] Int
|
||||||
:<|> "update" :> AuthProtect "header-auth"
|
:<|> "update" :> AuthProtect "header-auth"
|
||||||
:> Capture "id" Int :> ReqBody '[JSON] AmountUpdate :> Post '[JSON] ()
|
:> ReqBody '[JSON] AmountUpdate :> Post '[JSON] ()
|
||||||
)
|
)
|
||||||
:<|> "buy" :> AuthProtect "header-auth" :> ReqBody '[JSON] [PurchaseDetail]
|
:<|> "buy" :> AuthProtect "header-auth" :> ReqBody '[JSON] [PurchaseDetail]
|
||||||
:> Post '[JSON] PurchaseResult
|
:> Post '[JSON] PurchaseResult
|
||||||
|
|
34
src/Main.hs
34
src/Main.hs
|
@ -113,7 +113,7 @@ users =
|
||||||
now <- liftIO $ getCurrentTime
|
now <- liftIO $ getCurrentTime
|
||||||
randSalt <- liftIO $ random 8
|
randSalt <- liftIO $ random 8
|
||||||
conn <- rsConnection <$> ask
|
conn <- rsConnection <$> ask
|
||||||
head <$> (liftIO $ runInsert_ conn (insertUser us (utctDay now) randSalt))
|
insertUser us (utctDay now) randSalt conn
|
||||||
|
|
||||||
userGetUpdate :: Maybe Int -> Int -> MateHandler UserDetails
|
userGetUpdate :: Maybe Int -> Int -> MateHandler UserDetails
|
||||||
userGetUpdate Nothing _ =
|
userGetUpdate Nothing _ =
|
||||||
|
@ -142,7 +142,7 @@ users =
|
||||||
then do
|
then do
|
||||||
now <- liftIO $ getCurrentTime
|
now <- liftIO $ getCurrentTime
|
||||||
conn <- rsConnection <$> ask
|
conn <- rsConnection <$> ask
|
||||||
void $ liftIO $ runUpdate_ conn (updateUserDetails id uds (utctDay now))
|
void $ updateUserDetails id uds (utctDay now) conn
|
||||||
else
|
else
|
||||||
throwError $ err403
|
throwError $ err403
|
||||||
{ errBody = "Wrong Authentication present"
|
{ errBody = "Wrong Authentication present"
|
||||||
|
@ -153,28 +153,28 @@ products =
|
||||||
new :<|>
|
new :<|>
|
||||||
update
|
update
|
||||||
where
|
where
|
||||||
list :: MateHandler [Product]
|
list :: MateHandler [ProductOverview]
|
||||||
list = do
|
list = do
|
||||||
conn <- rsConnection <$> ask
|
conn <- rsConnection <$> ask
|
||||||
productSelect conn
|
productOverviewSelect conn
|
||||||
|
|
||||||
new :: Maybe Int -> ProductSubmit -> MateHandler Int
|
new :: Maybe Int -> ProductSubmit -> MateHandler Int
|
||||||
new (Just _) bevsub = do
|
new (Just _) bevsub = do
|
||||||
conn <- rsConnection <$> ask
|
conn <- rsConnection <$> ask
|
||||||
now <- liftIO $ getCurrentTime
|
now <- liftIO $ getCurrentTime
|
||||||
bevid <- head <$> (liftIO $ runInsert_ conn (insertProduct bevsub))
|
bevid <- insertProduct bevsub conn
|
||||||
void $ liftIO $ runInsert_ conn (insertNewEmptyAmount bevid now bevsub)
|
void $ insertNewEmptyAmount bevid now bevsub conn
|
||||||
return bevid
|
return bevid
|
||||||
new Nothing _ =
|
new Nothing _ =
|
||||||
throwError $ err403
|
throwError $ err403
|
||||||
|
|
||||||
update :: Maybe Int -> Int -> AmountUpdate -> MateHandler ()
|
update :: Maybe Int -> AmountUpdate -> MateHandler ()
|
||||||
update (Just _) bid amosub = do
|
update (Just _) amosub@(AmountUpdate pid amount) = do
|
||||||
conn <- rsConnection <$> ask
|
conn <- rsConnection <$> ask
|
||||||
liftIO $ do
|
now <- liftIO $ getCurrentTime
|
||||||
now <- getCurrentTime
|
oldprice <- getLatestPriceByProductId pid conn
|
||||||
void $ runInsert_ conn (manualProductAmountUpdate amosub now bid)
|
void $ manualProductAmountUpdate amosub now oldprice conn
|
||||||
update Nothing _ _ =
|
update Nothing _ =
|
||||||
throwError $ err403
|
throwError $ err403
|
||||||
|
|
||||||
buy :: Maybe Int -> [PurchaseDetail] -> MateHandler PurchaseResult
|
buy :: Maybe Int -> [PurchaseDetail] -> MateHandler PurchaseResult
|
||||||
|
@ -184,8 +184,8 @@ buy (Just auid) pds = do
|
||||||
mmiss <- checkProductAvailability pd conn
|
mmiss <- checkProductAvailability pd conn
|
||||||
case mmiss of
|
case mmiss of
|
||||||
Just miss -> return
|
Just miss -> return
|
||||||
( (pd {pdAmount = miss}):ms
|
( (pd {purchaseDetailAmount = miss}):ms
|
||||||
, (pd {pdAmount = max 0 (pdAmount pd - miss)}:rs)
|
, (pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs)
|
||||||
)
|
)
|
||||||
Nothing -> return
|
Nothing -> return
|
||||||
( ms
|
( ms
|
||||||
|
@ -201,7 +201,7 @@ buy (Just auid) pds = do
|
||||||
)
|
)
|
||||||
0
|
0
|
||||||
real
|
real
|
||||||
liftIO $ runUpdate_ conn (addToUserBalance auid (-price))
|
addToUserBalance auid (-price) conn
|
||||||
newBalance <- userBalanceSelect conn auid
|
newBalance <- userBalanceSelect conn auid
|
||||||
return $ PurchaseResult
|
return $ PurchaseResult
|
||||||
( if newBalance < 0
|
( if newBalance < 0
|
||||||
|
@ -215,8 +215,8 @@ buy Nothing pds = do
|
||||||
mmiss <- checkProductAvailability pd conn
|
mmiss <- checkProductAvailability pd conn
|
||||||
case mmiss of
|
case mmiss of
|
||||||
Just miss -> return
|
Just miss -> return
|
||||||
( (pd {pdAmount = miss}):ms
|
( (pd {purchaseDetailAmount = miss}):ms
|
||||||
, (pd {pdAmount = max 0 (pdAmount pd - miss)}:rs)
|
, (pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs)
|
||||||
)
|
)
|
||||||
Nothing -> return
|
Nothing -> return
|
||||||
( ms
|
( ms
|
||||||
|
|
|
@ -58,8 +58,10 @@ insertNewEmptyAmount
|
||||||
:: Int -- | the associated product id
|
:: Int -- | the associated product id
|
||||||
-> UTCTime -- | current time
|
-> UTCTime -- | current time
|
||||||
-> ProductSubmit -- | submitted product data
|
-> ProductSubmit -- | submitted product data
|
||||||
-> Insert [Int]
|
-> PGS.Connection
|
||||||
insertNewEmptyAmount bevid now (ProductSubmit _ price _ _ _ _ _ _ _) = Insert
|
-> MateHandler Int
|
||||||
|
insertNewEmptyAmount bevid now (ProductSubmit _ price _ _ _ _ _ _ _) conn =
|
||||||
|
fmap head $ liftIO $ runInsert_ conn $ Insert
|
||||||
{ iTable = amountTable
|
{ iTable = amountTable
|
||||||
, iRows =
|
, iRows =
|
||||||
[
|
[
|
||||||
|
@ -142,8 +144,10 @@ manualProductAmountUpdate
|
||||||
:: AmountUpdate
|
:: AmountUpdate
|
||||||
-> UTCTime -- Current time
|
-> UTCTime -- Current time
|
||||||
-> Int -- Old BeveragePrice
|
-> Int -- Old BeveragePrice
|
||||||
-> Insert [Int]
|
-> PGS.Connection
|
||||||
manualProductAmountUpdate (AmountUpdate pid amount) now oldprice = Insert
|
-> MateHandler Int
|
||||||
|
manualProductAmountUpdate (AmountUpdate pid amount) now oldprice conn =
|
||||||
|
fmap head $ liftIO $ runInsert_ conn $ Insert
|
||||||
{ iTable = amountTable
|
{ iTable = amountTable
|
||||||
, iRows =
|
, iRows =
|
||||||
[
|
[
|
||||||
|
|
|
@ -128,9 +128,8 @@ validateToken conn header = do
|
||||||
if diffUTCTime stamp now > 0
|
if diffUTCTime stamp now > 0
|
||||||
then return $ Just uid
|
then return $ Just uid
|
||||||
else do
|
else do
|
||||||
liftIO $ do
|
void $ deleteToken header conn
|
||||||
void $ forkIO $ void $ runDelete_ conn (deleteToken header)
|
liftIO $ threadDelay $ 1 * 10 ^ 6
|
||||||
threadDelay $ 1 * 10 ^ 6
|
|
||||||
throwError $ err401
|
throwError $ err401
|
||||||
{ errBody = "Your token expired!"
|
{ errBody = "Your token expired!"
|
||||||
}
|
}
|
||||||
|
@ -169,7 +168,7 @@ generateToken (Ticket _ ident exp) (AuthHash hash) = do
|
||||||
<$> (random 23)
|
<$> (random 23)
|
||||||
<*> (pure ident)
|
<*> (pure ident)
|
||||||
<*> (addUTCTime (23*60) <$> getCurrentTime)
|
<*> (addUTCTime (23*60) <$> getCurrentTime)
|
||||||
void $ liftIO $ runInsert_ conn (insertToken token)
|
void $ insertToken token conn
|
||||||
return $ Granted (AuthToken $ tokenString token)
|
return $ Granted (AuthToken $ tokenString token)
|
||||||
else
|
else
|
||||||
return Denied
|
return Denied
|
||||||
|
@ -177,8 +176,10 @@ generateToken (Ticket _ ident exp) (AuthHash hash) = do
|
||||||
|
|
||||||
insertToken
|
insertToken
|
||||||
:: Token
|
:: Token
|
||||||
-> Insert [ByteString]
|
-> PGS.Connection
|
||||||
insertToken (Token tString tUser tExpiry) = Insert
|
-> MateHandler ByteString
|
||||||
|
insertToken (Token tString tUser tExpiry) conn =
|
||||||
|
fmap head $ liftIO $ runInsert_ conn $ Insert
|
||||||
{ iTable = tokenTable
|
{ iTable = tokenTable
|
||||||
, iRows =
|
, iRows =
|
||||||
[
|
[
|
||||||
|
@ -194,8 +195,10 @@ insertToken (Token tString tUser tExpiry) = Insert
|
||||||
|
|
||||||
deleteToken
|
deleteToken
|
||||||
:: ByteString
|
:: ByteString
|
||||||
-> Opaleye.Delete Int64
|
-> PGS.Connection
|
||||||
deleteToken tstr = Delete
|
-> Handler Int64
|
||||||
|
deleteToken tstr conn =
|
||||||
|
liftIO $ runDelete_ conn $ Delete
|
||||||
{ dTable = tokenTable
|
{ dTable = tokenTable
|
||||||
, dWhere = (\(rtstr, _, _) -> rtstr .== C.constant tstr)
|
, dWhere = (\(rtstr, _, _) -> rtstr .== C.constant tstr)
|
||||||
, dReturning = rCount
|
, dReturning = rCount
|
||||||
|
@ -204,8 +207,9 @@ deleteToken tstr = Delete
|
||||||
|
|
||||||
deleteTokenByUserId
|
deleteTokenByUserId
|
||||||
:: Int
|
:: Int
|
||||||
-> Opaleye.Delete Int64
|
-> PGS.Connection
|
||||||
deleteTokenByUserId uid = Delete
|
-> MateHandler Int64
|
||||||
|
deleteTokenByUserId uid conn = liftIO $ runDelete_ conn $ Delete
|
||||||
{ dTable = tokenTable
|
{ dTable = tokenTable
|
||||||
, dWhere = (\(_, rid, _) -> rid .== C.constant uid)
|
, dWhere = (\(_, rid, _) -> rid .== C.constant uid)
|
||||||
, dReturning = rCount
|
, dReturning = rCount
|
||||||
|
@ -262,4 +266,4 @@ processLogout
|
||||||
-> MateHandler ()
|
-> MateHandler ()
|
||||||
processLogout uid = do
|
processLogout uid = do
|
||||||
conn <- rsConnection <$> ask
|
conn <- rsConnection <$> ask
|
||||||
liftIO $ void $ runDelete_ conn (deleteTokenByUserId uid)
|
void $ deleteTokenByUserId uid conn
|
||||||
|
|
|
@ -1,12 +1,15 @@
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE Arrows #-}
|
||||||
module Model.Product where
|
module Model.Product where
|
||||||
|
|
||||||
import Servant.Server
|
import Servant.Server
|
||||||
|
|
||||||
import Data.Text as T hiding (head, foldl)
|
import Data.Text as T hiding (head, foldl)
|
||||||
import Data.Time.Calendar (Day)
|
import Data.Time.Calendar (Day)
|
||||||
import Data.Profunctor.Product (p10)
|
import Data.Time.Clock (UTCTime)
|
||||||
|
import Data.Profunctor.Product (p9)
|
||||||
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Aeson.Types
|
import Data.Aeson.Types
|
||||||
|
@ -17,7 +20,7 @@ import Control.Monad (when)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Error.Class (throwError)
|
import Control.Monad.Error.Class (throwError)
|
||||||
|
|
||||||
import Control.Arrow ((<<<))
|
import Control.Arrow ((<<<), returnA)
|
||||||
|
|
||||||
import qualified Database.PostgreSQL.Simple as PGS
|
import qualified Database.PostgreSQL.Simple as PGS
|
||||||
|
|
||||||
|
@ -29,6 +32,7 @@ import Opaleye.Constant as C
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
|
import Model.Amount
|
||||||
|
|
||||||
initProduct :: PGS.Query
|
initProduct :: PGS.Query
|
||||||
initProduct = mconcat
|
initProduct = mconcat
|
||||||
|
@ -42,7 +46,7 @@ initProduct = mconcat
|
||||||
, "product_avatar integer,"
|
, "product_avatar integer,"
|
||||||
, "product_supplier integer,"
|
, "product_supplier integer,"
|
||||||
, "product_max_amount integer not null,"
|
, "product_max_amount integer not null,"
|
||||||
, "product_total_bought integer not null,"
|
-- , "product_total_bought integer not null,"
|
||||||
, "product_amount_per_crate integer not null,"
|
, "product_amount_per_crate integer not null,"
|
||||||
, "product_price_per_crate integer,"
|
, "product_price_per_crate integer,"
|
||||||
, "product_art_nr varchar(128)"
|
, "product_art_nr varchar(128)"
|
||||||
|
@ -59,7 +63,7 @@ productTable :: Table
|
||||||
, FieldNullable SqlInt4
|
, FieldNullable SqlInt4
|
||||||
, FieldNullable SqlInt4
|
, FieldNullable SqlInt4
|
||||||
, Field SqlInt4
|
, Field SqlInt4
|
||||||
, Field SqlInt4
|
-- , Field SqlInt4
|
||||||
, Field SqlInt4
|
, Field SqlInt4
|
||||||
, FieldNullable SqlInt4
|
, FieldNullable SqlInt4
|
||||||
, FieldNullable SqlText
|
, FieldNullable SqlText
|
||||||
|
@ -73,13 +77,13 @@ productTable :: Table
|
||||||
, FieldNullable SqlInt4
|
, FieldNullable SqlInt4
|
||||||
, FieldNullable SqlInt4
|
, FieldNullable SqlInt4
|
||||||
, Field SqlInt4
|
, Field SqlInt4
|
||||||
, Field SqlInt4
|
-- , Field SqlInt4
|
||||||
, Field SqlInt4
|
, Field SqlInt4
|
||||||
, FieldNullable SqlInt4
|
, FieldNullable SqlInt4
|
||||||
, FieldNullable SqlText
|
, FieldNullable SqlText
|
||||||
)
|
)
|
||||||
productTable = table "product" (
|
productTable = table "product" (
|
||||||
p10
|
p9
|
||||||
( tableField "product_id"
|
( tableField "product_id"
|
||||||
, tableField "product_ident"
|
, tableField "product_ident"
|
||||||
-- , tableField "product_price"
|
-- , tableField "product_price"
|
||||||
|
@ -89,13 +93,14 @@ productTable = table "product" (
|
||||||
, tableField "product_avatar"
|
, tableField "product_avatar"
|
||||||
, tableField "product_supplier"
|
, tableField "product_supplier"
|
||||||
, tableField "product_max_amount"
|
, tableField "product_max_amount"
|
||||||
, tableField "product_total_bought"
|
-- , tableField "product_total_bought"
|
||||||
, tableField "product_amount_per_crate"
|
, tableField "product_amount_per_crate"
|
||||||
, tableField "product_price_per_crate"
|
, tableField "product_price_per_crate"
|
||||||
, tableField "product_art_nr"
|
, tableField "product_art_nr"
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
productSelect
|
productSelect
|
||||||
:: PGS.Connection
|
:: PGS.Connection
|
||||||
-> MateHandler [Product]
|
-> MateHandler [Product]
|
||||||
|
@ -112,15 +117,78 @@ productSelect conn = do
|
||||||
, Maybe Int
|
, Maybe Int
|
||||||
, Maybe Int
|
, Maybe Int
|
||||||
, Int
|
, Int
|
||||||
, Int
|
-- , Int
|
||||||
, Int
|
, Int
|
||||||
, Maybe Int
|
, Maybe Int
|
||||||
, Maybe T.Text
|
, Maybe T.Text
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
mapM
|
mapM
|
||||||
(\(i1, i2, {-i3, i4, i5,-} i6, i7, i8, i9, i10, i11, i12, i13) -> return $
|
(\(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
|
Product i1 i2 {-i3 i4 i5-} i6 i7 i8 i9 {-i10-} i11 i12 i13
|
||||||
|
)
|
||||||
|
bevs
|
||||||
|
|
||||||
|
|
||||||
|
productOverviewSelect
|
||||||
|
:: PGS.Connection
|
||||||
|
-> MateHandler [ProductOverview]
|
||||||
|
productOverviewSelect conn = do
|
||||||
|
bevs <- liftIO $ runSelect conn
|
||||||
|
( proc () -> do
|
||||||
|
(i1, i2, i6, i7, i8, i9, i11, i12, i13) <- queryTable productTable -< ()
|
||||||
|
returnA -< (i1, i2, i6, i7, i8, i9, i11, i12, i13)
|
||||||
|
) :: 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
|
||||||
|
amounts <- liftIO $ runSelect conn
|
||||||
|
( proc () -> do
|
||||||
|
stuff@(a1, _, _, _, _) <- orderBy (desc (\(_, ts, _, _, _) -> ts))
|
||||||
|
(queryTable amountTable) -< ()
|
||||||
|
restrict -< C.constant i1 .== a1
|
||||||
|
returnA -< stuff
|
||||||
|
) :: MateHandler
|
||||||
|
[ ( Int
|
||||||
|
, UTCTime
|
||||||
|
, Int
|
||||||
|
, Int
|
||||||
|
, Bool
|
||||||
|
)
|
||||||
|
]
|
||||||
|
(i3, i4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts
|
||||||
|
i5 <- return $ (\(_, x) -> x) $
|
||||||
|
foldl
|
||||||
|
(\(bef, van) (_, _, amo, _, ver) ->
|
||||||
|
if ver
|
||||||
|
then (amo, if amo < bef then van + (bef - amo) else van)
|
||||||
|
else (amo, van)
|
||||||
|
)
|
||||||
|
(0, 0)
|
||||||
|
(Prelude.reverse amounts)
|
||||||
|
i10 <- return $ snd $ foldl (\(bef, tot) (_, _, amo, _, ver) ->
|
||||||
|
if ver
|
||||||
|
then (amo, tot)
|
||||||
|
else (amo, tot + (bef - amo))
|
||||||
|
)
|
||||||
|
(0, 0)
|
||||||
|
(Prelude.reverse amounts)
|
||||||
|
return $ ProductOverview
|
||||||
|
i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13
|
||||||
)
|
)
|
||||||
bevs
|
bevs
|
||||||
|
|
||||||
|
@ -203,8 +271,10 @@ productSelect conn = do
|
||||||
|
|
||||||
insertProduct
|
insertProduct
|
||||||
:: ProductSubmit
|
:: ProductSubmit
|
||||||
-> Insert [Int]
|
-> PGS.Connection
|
||||||
insertProduct (ProductSubmit ident price ml ava sup max apc ppc artnr) = Insert
|
-> MateHandler Int
|
||||||
|
insertProduct (ProductSubmit ident price ml ava sup max apc ppc artnr) conn =
|
||||||
|
fmap head $ liftIO $ runInsert_ conn $ Insert
|
||||||
{ iTable = productTable
|
{ iTable = productTable
|
||||||
, iRows =
|
, iRows =
|
||||||
[
|
[
|
||||||
|
@ -217,13 +287,13 @@ insertProduct (ProductSubmit ident price ml ava sup max apc ppc artnr) = Insert
|
||||||
, C.constant ava
|
, C.constant ava
|
||||||
, C.constant sup
|
, C.constant sup
|
||||||
, C.constant max
|
, C.constant max
|
||||||
, C.constant (0 :: Int)
|
-- , C.constant (0 :: Int)
|
||||||
, C.constant apc
|
, C.constant apc
|
||||||
, C.constant ppc
|
, C.constant ppc
|
||||||
, C.constant artnr
|
, C.constant artnr
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
, iReturning = rReturning (\(id, _, _, _, _, _, _, _, _, _) -> id)
|
, iReturning = rReturning (\(id, _, _, _, _, _, _, _, _) -> id)
|
||||||
, iOnConflict = Nothing
|
, iOnConflict = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -173,8 +173,13 @@ userBalanceSelect conn id = do
|
||||||
users
|
users
|
||||||
|
|
||||||
|
|
||||||
insertUser :: UserSubmit -> Day -> ByteString -> Insert [Int]
|
insertUser
|
||||||
insertUser us now randSalt = Insert
|
:: UserSubmit
|
||||||
|
-> Day
|
||||||
|
-> ByteString
|
||||||
|
-> PGS.Connection
|
||||||
|
-> MateHandler Int
|
||||||
|
insertUser us now randSalt conn = fmap head $ liftIO $ runInsert_ conn $ Insert
|
||||||
{ iTable = userTable
|
{ iTable = userTable
|
||||||
, iRows =
|
, iRows =
|
||||||
[
|
[
|
||||||
|
@ -193,8 +198,13 @@ insertUser us now randSalt = Insert
|
||||||
, iOnConflict = Nothing
|
, iOnConflict = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
updateUserDetails :: Int -> UserDetailsSubmit -> Day -> Update Int64
|
updateUserDetails
|
||||||
updateUserDetails uid uds now = Update
|
:: Int
|
||||||
|
-> UserDetailsSubmit
|
||||||
|
-> Day
|
||||||
|
-> PGS.Connection
|
||||||
|
-> MateHandler Int64
|
||||||
|
updateUserDetails uid uds now conn = liftIO $ runUpdate_ conn $ Update
|
||||||
{ uTable = userTable
|
{ uTable = userTable
|
||||||
, uUpdateWith = updateEasy (\(id_, _, i3, _, _, _, i7, i8, _) ->
|
, uUpdateWith = updateEasy (\(id_, _, i3, _, _, _, i7, i8, _) ->
|
||||||
( id_
|
( id_
|
||||||
|
@ -215,8 +225,9 @@ updateUserDetails uid uds now = Update
|
||||||
addToUserBalance
|
addToUserBalance
|
||||||
:: Int
|
:: Int
|
||||||
-> Int
|
-> Int
|
||||||
-> Update Int64
|
-> PGS.Connection
|
||||||
addToUserBalance uid amount = Update
|
-> MateHandler Int64
|
||||||
|
addToUserBalance uid amount conn = liftIO $ runUpdate_ conn $ Update
|
||||||
{ uTable = userTable
|
{ uTable = userTable
|
||||||
, uUpdateWith = updateEasy (\(id_, i2, i3, i4, i5, i6, i7, i8, i9) ->
|
, uUpdateWith = updateEasy (\(id_, i2, i3, i4, i5, i6, i7, i8, i9) ->
|
||||||
( id_
|
( id_
|
||||||
|
|
|
@ -17,7 +17,7 @@ data Product = Product
|
||||||
, productAvatar :: Maybe Int
|
, productAvatar :: Maybe Int
|
||||||
, productSupplier :: Maybe Int
|
, productSupplier :: Maybe Int
|
||||||
, productMaxAmount :: Int
|
, productMaxAmount :: Int
|
||||||
, productTotalBought :: Int
|
-- , productTotalBought :: Int
|
||||||
, productAmountPerCrate :: Int
|
, productAmountPerCrate :: Int
|
||||||
, productPricePerCrate :: Maybe Int
|
, productPricePerCrate :: Maybe Int
|
||||||
, productArtNr :: Maybe T.Text
|
, productArtNr :: Maybe T.Text
|
||||||
|
@ -29,6 +29,28 @@ instance ToJSON Product where
|
||||||
instance FromJSON Product
|
instance FromJSON Product
|
||||||
|
|
||||||
|
|
||||||
|
data ProductOverview = ProductOverview
|
||||||
|
{ productOverviewId :: Int
|
||||||
|
, productOverviewIdent :: T.Text
|
||||||
|
, productOverviewPrice :: Int
|
||||||
|
, productOverviewAmount :: Int
|
||||||
|
, productOverviewVanish :: Int
|
||||||
|
, productOverviewMl :: Int
|
||||||
|
, productOverviewAvatar :: Maybe Int
|
||||||
|
, productOverviewSupplier :: Maybe Int
|
||||||
|
, productOverviewMaxAmount :: Int
|
||||||
|
, productOverviewTotalBought :: Int
|
||||||
|
, productOverviewAmountPerCrate :: Int
|
||||||
|
, productOverviewPricePerCrate :: Maybe Int
|
||||||
|
, productOverviewArtNr :: Maybe T.Text
|
||||||
|
} deriving (Generic, Show)
|
||||||
|
|
||||||
|
instance ToJSON ProductOverview where
|
||||||
|
toEncoding = genericToEncoding defaultOptions
|
||||||
|
|
||||||
|
instance FromJSON ProductOverview
|
||||||
|
|
||||||
|
|
||||||
data ProductSubmit = ProductSubmit
|
data ProductSubmit = ProductSubmit
|
||||||
{ productSubmitIdent :: T.Text
|
{ productSubmitIdent :: T.Text
|
||||||
, productSubmitPrice :: Int
|
, productSubmitPrice :: Int
|
||||||
|
|
|
@ -10,8 +10,8 @@ import GHC.Generics
|
||||||
|
|
||||||
|
|
||||||
data PurchaseDetail = PurchaseDetail
|
data PurchaseDetail = PurchaseDetail
|
||||||
{ pdBeverage :: Int
|
{ purchaseDetailBeverage :: Int
|
||||||
, pdAmount :: Int
|
, purchaseDetailAmount :: Int
|
||||||
}
|
}
|
||||||
deriving (Generic, Show)
|
deriving (Generic, Show)
|
||||||
|
|
||||||
|
@ -22,8 +22,8 @@ instance FromJSON PurchaseDetail
|
||||||
|
|
||||||
|
|
||||||
data PurchaseResult = PurchaseResult
|
data PurchaseResult = PurchaseResult
|
||||||
{ prFlag :: PurchaseResultFlag
|
{ purchaseResultFlag :: PurchaseResultFlag
|
||||||
, prMissingItems :: [PurchaseDetail]
|
, purchaseResultMissingItems :: [PurchaseDetail]
|
||||||
}
|
}
|
||||||
deriving (Generic, Show)
|
deriving (Generic, Show)
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue