From c7a7ac41f1252560e06a99347c3a1ec033689165 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@nek0.eu>
Date: Thu, 18 Jul 2019 14:57:35 +0200
Subject: [PATCH] start implementing beverages

---
 src/API.hs            |  5 ++++
 src/Main.hs           | 17 +++++++++++-
 src/Model/Beverage.hs | 63 +++++++++++++++++++++++++++++++++++++++++++
 src/Types/Beverage.hs | 27 ++++++++++++++++---
 4 files changed, 108 insertions(+), 4 deletions(-)

diff --git a/src/API.hs b/src/API.hs
index 1c62c23..6b9bd58 100644
--- a/src/API.hs
+++ b/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
diff --git a/src/Main.hs b/src/Main.hs
index 24dddd9..f13eb62 100644
--- a/src/Main.hs
+++ b/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
diff --git a/src/Model/Beverage.hs b/src/Model/Beverage.hs
index 3eb7237..aff1fab 100644
--- a/src/Model/Beverage.hs
+++ b/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
+  }
diff --git a/src/Types/Beverage.hs b/src/Types/Beverage.hs
index 216349c..4ce60df 100644
--- a/src/Types/Beverage.hs
+++ b/src/Types/Beverage.hs
@@ -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