diff --git a/mateamt.cabal b/mateamt.cabal index dcadc0e..1388b94 100644 --- a/mateamt.cabal +++ b/mateamt.cabal @@ -175,5 +175,6 @@ test-suite mateamt-test build-tool-depends: hspec-discover:hspec-discover == 2.* other-modules: + Spec TestUtil AppMainSpec diff --git a/src/Control/Product.hs b/src/Control/Product.hs index fc9954e..74b665f 100644 --- a/src/Control/Product.hs +++ b/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) diff --git a/src/Control/User.hs b/src/Control/User.hs index daafc4b..6af6739 100644 --- a/src/Control/User.hs +++ b/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" diff --git a/src/Model/Auth.hs b/src/Model/Auth.hs index 21772a8..ee00b0a 100644 --- a/src/Model/Auth.hs +++ b/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) ) diff --git a/src/Types/Auth.hs b/src/Types/Auth.hs index d10a14a..910fe72 100644 --- a/src/Types/Auth.hs +++ b/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)