start implementing beverages

This commit is contained in:
nek0 2019-07-18 14:57:35 +02:00
parent d8b3c7feab
commit c7a7ac41f1
4 changed files with 108 additions and 4 deletions

View file

@ -31,6 +31,11 @@ type UserAPI =
:<|> "details" :> AuthProtect "header-auth"
:> Capture "id" Int :> ReqBody '[JSON] UserDetailsSubmit :> Post '[JSON] ()
)
:<|> "beverage" :>
( "list" :> Get '[JSON] [Beverage]
:<|> "new" :> AuthProtect "header-auth" :> ReqBody '[JSON] BeverageSubmit
:> Post '[JSON] Int
)
:<|> "auth" :>
( "get" :> ReqBody '[JSON] Int :> Post '[JSON] AuthInfo
:<|> "send" :> ReqBody '[JSON] AuthRequest :> Post '[JSON] AuthResult

View file

@ -65,6 +65,7 @@ app initState =
authProxy
(`runReaderT` initState)
( users :<|>
beverages :<|>
auth
)
@ -103,7 +104,7 @@ users =
userList :: Maybe Int -> Maybe Refine -> MateHandler [User]
userList muid ref = do
conn <- rsConnection <$> ask
userSelect conn ref (isJust muid)
userSelect conn ref
userNew :: UserSubmit -> MateHandler Int
userNew us = do
@ -145,6 +146,20 @@ users =
{ errBody = "Wrong Authorization present"
}
beverages =
list :<|>
new
where
list :: MateHandler [Beverage]
list = do
conn <- rsConnection <$> ask
beverageSelect conn
new :: Maybe Int -> BeverageSubmit -> MateHandler Int
new _ bevsub = do
conn <- rsConnection <$> ask
head <$> (liftIO $ runInsert_ conn (insertBeverage bevsub))
auth =
authGet :<|>
authSend

View file

@ -9,11 +9,20 @@ import Data.Profunctor.Product (p13)
import Data.Aeson
import Data.Aeson.Types
import Control.Monad.IO.Class (liftIO)
import Control.Arrow ((<<<))
import qualified Database.PostgreSQL.Simple as PGS
import GHC.Generics
import Opaleye as O
import Opaleye.Constant as C
-- internal imports
import Types
initBeverage :: PGS.Query
initBeverage = "create Table if not exists \"beverage\" (beverage_id serial primary key, beverage_ident varchar(128) not null, beverage_price integer not null, beverage_amount integer not null, beverage_vanish integer not null, beverage_ml integer not null, beverage_avatar integer, beverage_supplier integer, beverage_max_amount integer not null, beverage_total_bought integer not null, beverage_amount_per_crate integer not null, beverage_price_per_crate integer, beverage_art_nr varchar(128))"
@ -64,3 +73,57 @@ beverageTable = table "beverage" (
, tableField "beverage_art_nr"
)
)
beverageSelect
:: PGS.Connection
-> MateHandler [Beverage]
beverageSelect conn = do
bevs <- liftIO $ runSelect conn
( keepWhen (\_ -> C.constant True) <<< queryTable beverageTable
) :: 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 $
Beverage i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13
)
bevs
insertBeverage
:: BeverageSubmit
-> Insert [Int]
insertBeverage (BeverageSubmit ident price ml sup max apc ppc artnr) = Insert
{ iTable = beverageTable
, iRows =
[
( C.constant (Nothing :: Maybe Int)
, C.constant ident
, C.constant price
, C.constant (0 :: Int)
, C.constant (0 :: Int)
, C.constant ml
, C.constant (Nothing :: Maybe Int)
, C.constant sup
, C.constant max
, C.constant (0 :: Int)
, C.constant apc
, C.constant ppc
, C.constant artnr
)
]
, iReturning = rReturning (\(id, _, _, _, _, _, _, _, _, _, _, _, _) -> id)
, iOnConflict = Nothing
}

View file

@ -13,11 +13,11 @@ data Beverage = Beverage
, beverageAmount :: Int
, beverageVanish :: Int
, beverageMl :: Int
, beverageAvatar :: Maybe Word
, beverageSupplier :: Maybe Word
, beverageAvatar :: Maybe Int
, beverageSupplier :: Maybe Int
, beverageMaxAmount :: Int
, beverageTotalBought :: Int
, beverageAmonutPerCrate :: Int
, beverageAmountPerCrate :: Int
, beveragePricePerCrate :: Maybe Int
, beverageArtNr :: Maybe T.Text
} deriving (Generic, Show)
@ -26,3 +26,24 @@ instance ToJSON Beverage where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Beverage
data BeverageSubmit = BeverageSubmit
{ beverageSubmitIdent :: T.Text
, beverageSubmitPrice :: Int
-- , beverageSubmitAmount :: Int
-- , beverageSubmitVanish :: Int
, beverageSubmitMl :: Int
-- , beverageSubmitAvatar :: Maybe Int
, beverageSubmitSupplier :: Maybe Int
, beverageSubmitMaxAmount :: Int
-- , beverageSubmitTotalBought :: Int
, beverageSubmitAmountPerCrate :: Int
, beverageSubmitPricePerCrate :: Maybe Int
, beverageSubmitArtNr :: Maybe T.Text
} deriving (Generic, Show)
instance ToJSON BeverageSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON BeverageSubmit