start implementing beverages

src/API.hs

@@ -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

src/Main.hs

@@ -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

src/Model/Beverage.hs

@@ -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
+  }

src/Types/Beverage.hs

@@ -13,11 +13,11 @@ data Beverage = Beverage
   , beverageAmount         :: Int
   , beverageVanish         :: Int
   , beverageMl             :: Int
-  , beverageAvatar         :: Maybe Word
+  , beverageAvatar         :: Maybe Int
-  , beverageSupplier       :: Maybe Word
+  , 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