fix compilation errors

mateamt.cabal

@@ -175,5 +175,6 @@ test-suite mateamt-test
   build-tool-depends:
     hspec-discover:hspec-discover == 2.*
   other-modules:
+    Spec
     TestUtil
     AppMainSpec

src/Control/Product.hs

@@ -38,12 +38,12 @@ productNew Nothing _ =
     { errBody = "No Authentication present."
     }
 
--- productOverview
---   :: Int
---   -> MateHandler ProductOverview
--- productOverview pid = do
---   conn <- asks rsConnection
---   productOverviewSelectSingle pid conn
+productOverview
+  :: Int
+  -> MateHandler ProductOverview
+productOverview pid = do
+  conn <- asks rsConnection
+  productOverviewSelectSingle pid conn
 
 productStockRefill
   :: Maybe (Int, AuthMethod)

src/Control/User.hs

@@ -13,6 +13,8 @@ import Data.Time (getCurrentTime, utctDay)
 
 import Data.Maybe (fromMaybe)
 
+import Data.String (fromString)
+
 import qualified Data.Text as T
 
 -- internal imports
@@ -150,19 +152,21 @@ userNotify
   -> MateHandler ()
 userNotify (Just (auid, method)) boughtItems (PurchaseResult flag missing) = do
   conn <- asks rsConnection
-  authData <- selectAuthOverviewById auid conn
-  user <- userDetailsSelect (authDataUser authData) conn
+  authOV <- selectAuthOverviewById auid conn
+  userDetails <- userDetailsSelect (authOverviewUser authOV) conn
   digestedDetails <- mapM
     (\pd -> do
-      overview <- (productOverviewSelectSingle (purchaseDetailProduct pd) conn
-      return (purchaseDetailAmout pd, productOverviewIdent overview)
+      overview <- productOverviewSelectSingle (purchaseDetailProduct pd) conn
+      return (purchaseDetailAmount pd, productOverviewIdent overview)
       )
     boughtItems
   let messageText = mconcat $ map (<> "\n") $
-        [ "Hello " <> userIdent user <> ","
+        [ "Hello " <> userDetailsIdent userDetails <> ","
         , ""
-        , "Your " <> authDataMethod authData <> " with the comment \"" <>
-          authDataComment authData <> "\" Just made following purchase:"<>
+        , "Your " <> ((fromString $ show $ authOverviewMethod authOV) <>
+          (" with the comment \"" <>
+          ((authOverviewComment authOV) <>
+          "\" Just made following purchase:")))
         ]
   throwError $ err501
     { errBody = "userNotify: Not implemented yet"

src/Model/Auth.hs

@@ -121,11 +121,11 @@ selectAuthOverviews
   -> PGS.Connection             -- ^ Connection Handler
   -> MateHandler [AuthOverview]
 selectAuthOverviews uid conn = do
-  liftIO $ map fromDatabase <$> head <$> runSelect conn (proc () -> do
+  liftIO $ map fromDatabase <$> runSelect conn (proc () -> do
     (adid, aduid, admethod, adcomment, _) <-
       queryTable authDataTable -< ()
     restrict -< aduid .== C.constant uid
-    returnA -< (adid, adcomment, admethod)
+    returnA -< (adid, aduid, adcomment, admethod)
     )
 
 
@@ -133,13 +133,12 @@ selectAuthOverviewById
   :: Int                      -- ^ Auth Data ID
   -> PGS.Connection           -- ^ Connection Handler
   -> MateHandler AuthOverview
-selectAuthOverviews aid conn = do
-  liftIO $ map fromDatabase <$> runSelect conn (proc () -> do
+selectAuthOverviewById aid conn = do
+  liftIO $ fromDatabase <$> head <$> runSelect conn (limit 1 $ proc () -> do
     (adid, aduid, admethod, adcomment, _) <-
       queryTable authDataTable -< ()
     restrict -< adid .== C.constant aid
-    limit 1
-    returnA -< (adid, adcomment, admethod)
+    returnA -< (adid, aduid, adcomment, admethod)
     )
 
 

src/Types/Auth.hs

@@ -199,6 +199,7 @@ instance FromDatabase AuthData where
 
 data AuthOverview = AuthOverview
   { authOverviewId      :: Int
+  , authOverviewUser    :: Int
   , authOverviewComment :: T.Text
   , authOverviewMethod  :: AuthMethod
   }
@@ -218,7 +219,7 @@ instance FromJSON AuthOverview
 
 instance FromDatabase AuthOverview where
 
-  type OutTuple AuthOverview = (Int, T.Text, Int)
+  type OutTuple AuthOverview = (Int, Int, T.Text, Int)
 
-  fromDatabase (id_, comm, method) =
-    AuthOverview id_ comm (toEnum method)
+  fromDatabase (id_, uid, comm, method) =
+    AuthOverview id_ uid comm (toEnum method)