added bill validation

.vscode/launch.json

@@ -0,0 +1,22 @@
+{
+    "version": "0.2.0",
+    "configurations": [
+    
+        {
+            "type": "ghc",
+            "name": "ghci debug viewer Phoityne",
+            "request": "launch",
+            "internalConsoleOptions": "openOnSessionStart",
+            "workspace": "${workspaceRoot}",
+            "startup": "${workspaceRoot}/test/Spec.hs",
+            "logFile": "${workspaceRoot}/.vscode/phoityne.log",
+            "logLevel": "WARNING",
+            "ghciPrompt": "H>>= ",
+            "ghciCmd": "stack ghci --test --no-load --no-build --main-is TARGET",
+            "ghciEnv": {},
+            "stopOnEntry": true,
+            "hackageVersion": "0.0.14.0",
+            "mainArgs": ""
+        }
+    ]
+}

.vscode/tasks.json

@@ -0,0 +1,41 @@
+{
+  // atuomatically created by phoityne-vscode
+  
+  "version": "0.1.0",
+  "isShellCommand": true,
+  "showOutput": "always",
+  "suppressTaskName": true,
+  "windows": {
+    "command": "cmd",
+    "args": ["/c"]
+  },
+  "linux": {
+    "command": "sh",
+    "args": ["-c"]
+  },
+  "osx": {
+    "command": "sh",
+    "args": ["-c"]
+  },
+  "tasks": [
+    {
+       "taskName": "stack build",
+       "args": [ "echo START_STACK_BUILD && cd ${workspaceRoot} && stack build && echo END_STACK_BUILD " ]
+    },
+    { 
+       "isBuildCommand": true,
+       "taskName": "stack clean & build",
+       "args": [ "echo START_STACK_CLEAN_AND_BUILD && cd ${workspaceRoot} && stack clean && stack build && echo END_STACK_CLEAN_AND_BUILD " ]
+    },
+    { 
+       "isTestCommand": true,
+       "taskName": "stack test",
+       "args": [ "echo START_STACK_TEST && cd ${workspaceRoot} && stack test && echo END_STACK_TEST " ]
+    },
+    { 
+       "isWatching": true,
+       "taskName": "stack watch",
+       "args": [ "echo START_STACK_WATCH && cd ${workspaceRoot} && stack build --test --no-run-tests --file-watch && echo END_STACK_WATCH " ]
+    }
+  ]
+}

src/App.hs

@@ -13,6 +13,7 @@ import           Control.Monad.Trans.Reader
 import           Data.Maybe
 import           Data.String.Conversions
 import           Data.Text
+import           Data.Time.Clock
 import           Database.Persist
 import           Database.Persist.Postgresql
 import           Database.Persist.Sqlite
@@ -33,8 +34,11 @@ couponServer pool =
 
     couponAdd :: Coupon -> IO NoContent
     couponAdd newCoupon = flip runSqlPersistMPool pool $ do
-      exists <- selectFirst [CouponCode ==. couponCode newCoupon] []
+      -- exists <- selectFirst [CouponCode ==. couponCode newCoupon] []
-      when (isNothing exists) $ void $ insert newCoupon
+      upsert newCoupon [CouponValue =. couponValue newCoupon,
+                        CouponMin_price =. couponMin_price newCoupon]
+      -- TODO Add more upsert cols
+      -- when (isNothing exists) $ void $ insert newCoupon
       return NoContent
 
     couponGet :: Text -> IO (Maybe Coupon)
@@ -55,12 +59,35 @@ billCouponServer pool = liftIO.compute
                         where compute bill = runSqlPersistMPool (query bill) pool
                               query bill = do mcpn <- selectFirst [CouponCode ==. coupon bill] []
                                               case mcpn of
-                                                Just cpn -> withCoupon (entityVal cpn) bill
+                                                Just cpn -> computeBill (entityVal cpn) bill
-                                                Nothing -> return (Rejected "Coupon Not Found")
+                                                Nothing -> return $ Rejected "Coupon Not Found"
-                              withCoupon cpn bill = case couponValue cpn of
+
-                                                         ProductFlat c -> productFlat c bill
+computeBill ::  ( MonadIO m) => Coupon -> BillCoupon -> ReaderT SqlBackend m CouponResult
-                                                         CartFlat c -> cartFlat c bill
+computeBill c b = do  pc <- mapM prodCoupon $ productList b
-                                                         CartPercent c -> cartPerCent c bill
+                      cm <- selectFirst [CustomerCouponCode ==. couponCode c,
+                                          CustomerCouponEmail ==. customer b] []
+                      let mcm = customerLimit $ entityVal <$> cm
+                      ct <- liftIO getCurrentTime
+                      let valid = couponCount && True `elem` pc && mcm && couponTime ct
+                      liftIO $ do print pc
+                                  print couponCount
+                                  print mcm
+                                  print $ couponTime ct
+                      if valid
+                        then return.Applied $ computeBillAmount c b
+                        else return.Rejected $ "Rejected Coupon Invalid"
+                      where prodCoupon k = do p <- selectFirst [ProductCouponCode ==. couponCode c,
+                                                                ProductCouponProduct ==. productName k] []
+                                              return $ productLimit $ entityVal <$> p
+                            couponCount = couponUsed c < couponUsage_limit c
+                            couponTime ct = couponValid_from c < ct && couponValid_till c > ct
+                            productLimit (Just pc) = productCouponUsage pc > couponProduct_limit c
+                            productLimit _ = True
+                            customerLimit (Just cp) = customerCouponUsage cp > couponCustomer_limit c
+                            customerLimit _ = True
+
+computeBillAmount :: Coupon -> BillCoupon -> Int
+computeBillAmount _ _ = 100
 
 productFlat ::  (Monad m) => CouponForProduct -> BillCoupon -> m CouponResult
 productFlat p bill = return (Rejected "Coupon ProductFlat Found")
@@ -104,4 +131,4 @@ mkSqliteApp sqliteFile = do
   return $ appDebug pool
 
 run :: String -> IO ()
-run dbConnStr = Warp.run 3000 =<< mkApp dbConnStr
+run dbConnStr = Warp.run 3000 =<< mkDebugPgApp dbConnStr

src/Models.hs

@@ -41,6 +41,7 @@ Coupon json
   code Text
   value  CouponType
   min_price Int
+  product_limit Int
   customer_limit Int
   usage_limit Int
   used Int