From a2ce81b5f01dab6dfaa960c27cde8078501c860d Mon Sep 17 00:00:00 2001 From: Alaudidae Lark Date: Sat, 6 May 2017 18:04:13 +0530 Subject: [PATCH] added a debug/release app --- app/Main.hs | 1 - coupon-servant.cabal | 1 + src/Api.hs | 5 ++--- src/App.hs | 53 +++++++++++++++++++++++++------------------- src/Coupon.hs | 11 +-------- src/Models.hs | 1 + src/SwaggerGen.hs | 14 ------------ 7 files changed, 35 insertions(+), 51 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 5f30e03..e798aab 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -5,4 +5,3 @@ import App main :: IO () main = run "host=localhost port=5432 user=msfuser dbname=coupon password=" --- run "testSql.db" diff --git a/coupon-servant.cabal b/coupon-servant.cabal index 3549ee9..cc0234f 100644 --- a/coupon-servant.cabal +++ b/coupon-servant.cabal @@ -41,6 +41,7 @@ library , unordered-containers , wai , wai-cors + , wai-extra , warp default-language: Haskell2010 diff --git a/src/Api.hs b/src/Api.hs index 7013edf..a9e9201 100644 --- a/src/Api.hs +++ b/src/Api.hs @@ -10,12 +10,11 @@ import Data.Swagger import Data.Text import Models import Servant.API -import SwaggerGen type CouponApi = - "coupon" :> "add" :> ReqBody '[JSON] Coupon :> Post '[JSON] (Maybe Coupon) + "coupon" :> "add" :> ReqBody '[JSON] Coupon :> Post '[JSON] NoContent :<|> "coupon" :> "get" :> Capture "name" Text :> Get '[JSON] (Maybe Coupon) - :<|> "coupon" :> "del" :> Capture "name" Text :> Get '[JSON] (Maybe Coupon) + :<|> "coupon" :> "del" :> Capture "name" Text :> Get '[JSON] NoContent type BillCouponApi = "billcoupon" :> ReqBody '[JSON] BillCoupon :> Post '[JSON] CouponResult diff --git a/src/App.hs b/src/App.hs index 51f8e3a..749ed65 100644 --- a/src/App.hs +++ b/src/App.hs @@ -6,19 +6,21 @@ module App where import Api +import Control.Monad import Control.Monad.IO.Class -import Control.Monad.Logger (runStderrLoggingT) +import Control.Monad.Logger (runStderrLoggingT) +import Data.Maybe import Data.String.Conversions import Data.Text import Database.Persist import Database.Persist.Postgresql import Database.Persist.Sqlite import Network.Wai -import Network.Wai.Handler.Warp as Warp +import Network.Wai.Handler.Warp as Warp import Network.Wai.Middleware.Cors +import Network.Wai.Middleware.RequestLogger (logStdoutDev) import Servant import SwaggerGen --- import Network.Wai.Middleware.RequestLogger (logStdoutDev) couponServer :: ConnectionPool -> Server CouponApi couponServer pool = @@ -28,29 +30,26 @@ couponServer pool = couponGetH code = liftIO $ couponGet code couponDelH code = liftIO $ couponDel code - couponAdd :: Coupon -> IO (Maybe Coupon) + couponAdd :: Coupon -> IO NoContent couponAdd newCoupon = flip runSqlPersistMPool pool $ do exists <- selectFirst [CouponCode ==. couponCode newCoupon] [] - case exists of - Nothing -> Just <$> insert newCoupon - Just _ -> return Nothing - return Nothing + when (isNothing exists) $ void $ insert newCoupon + return NoContent couponGet :: Text -> IO (Maybe Coupon) couponGet code = flip runSqlPersistMPool pool $ do mUser <- selectFirst [CouponCode ==. code] [] return $ entityVal <$> mUser - couponDel :: Text -> IO (Maybe Coupon) + couponDel :: Text -> IO NoContent couponDel code = flip runSqlPersistMPool pool $ do deleteWhere [CouponCode ==. code] - return Nothing + return NoContent billCouponServer :: ConnectionPool -> Server BillCouponApi -billCouponServer _ = billCouponComputeH - where billCouponComputeH bill = liftIO $ billCouponCompute bill - billCouponCompute bill = do print bill - return $ Applied 100 +billCouponServer _ = liftIO.billCouponCompute + where billCouponCompute bill = do print bill + return $ Applied 100 swaggerServer :: Server SwaggerApi swaggerServer = liftIO $ return $ swaggerDoc couponApi @@ -60,21 +59,29 @@ server pool = couponServer pool :<|> billCouponServer pool :<|> swaggerServer app :: ConnectionPool -> Application -app pool = cors (const $ Just policy) $ serve api $ server pool - where - policy = simpleCorsResourcePolicy { corsRequestHeaders = ["Content-Type"] } +app pool = serve couponApi $ couponServer pool :<|> billCouponServer pool -mkPgApp :: String -> IO Application -mkPgApp sqliteFile = do +appDebug :: ConnectionPool -> Application +appDebug pool = logStdoutDev $ cors (const $ Just policy) $ serve api $ server pool + where policy = simpleCorsResourcePolicy { corsRequestHeaders = ["Content-Type"] } + +mkApp :: String -> IO Application +mkApp sqliteFile = do pool <- runStderrLoggingT $ createPostgresqlPool (cs sqliteFile) 5 runSqlPool (runMigration migrateAll) pool return $ app pool -mkApp :: String -> IO Application -mkApp sqliteFile = do +mkDebugPgApp :: String -> IO Application +mkDebugPgApp sqliteFile = do + pool <- runStderrLoggingT $ createPostgresqlPool (cs sqliteFile) 5 + runSqlPool (runMigration migrateAll) pool + return $ appDebug pool + +mkSqliteApp :: String -> IO Application +mkSqliteApp sqliteFile = do pool <- runStderrLoggingT $ createSqlitePool (cs sqliteFile) 5 runSqlPool (runMigration migrateAll) pool - return $ app pool + return $ appDebug pool run :: String -> IO () -run dbConnStr = Warp.run 3000 =<< mkPgApp dbConnStr +run dbConnStr = Warp.run 3000 =<< mkApp dbConnStr diff --git a/src/Coupon.hs b/src/Coupon.hs index 584b7f5..e246d12 100644 --- a/src/Coupon.hs +++ b/src/Coupon.hs @@ -31,7 +31,7 @@ data BillCoupon = BillCoupon { productList :: [Product] } deriving (Eq, Read, Show, Generic, FromJSON, ToJSON, ToSchema) -data CouponResult = Applied Int | Rejected String | Partial String +data CouponResult = Applied Int | Rejected String deriving (Show, Read, Eq, Generic, FromJSON, ToJSON, ToSchema) data CouponForProduct = CouponForProduct { @@ -52,12 +52,3 @@ instance ToJSON CouponType where toJSON = genericToJSON couponOption derivePersistField "CouponType" - --- prodListEx :: [Product] --- prodListEx = [Product {productName = "Water", productPrice = 15}] - --- billCouponExample :: BillCoupon --- billCouponExample = BillCoupon { customer = "test@email.com", --- coupon = "FLAT100", --- productList = prodListEx } - diff --git a/src/Models.hs b/src/Models.hs index 2e2c107..79b018d 100644 --- a/src/Models.hs +++ b/src/Models.hs @@ -43,6 +43,7 @@ Coupon json min_price Int customer_limit Int usage_limit Int + used Int valid_from UTCTime default=now() valid_till UTCTime default=now() UniqueCode code diff --git a/src/SwaggerGen.hs b/src/SwaggerGen.hs index 28cb423..4de1ecc 100644 --- a/src/SwaggerGen.hs +++ b/src/SwaggerGen.hs @@ -25,23 +25,9 @@ prefixSchemaOptions = defaultSchemaOptions { fieldLabelModifier = modifier } instance ToSchema Coupon where declareNamedSchema = genericDeclareNamedSchema prefixSchemaOptions - --- swaggerDoc :: Swagger swaggerDoc :: HasSwagger api => Proxy api -> Swagger swaggerDoc api = toSwagger api & host ?~ Host {_hostName = "localhost",_hostPort = Just 3000} & info.title .~ "Coupon Api" & info.version .~ "v1" - -- & applyTagsFor billOp ["billcoupon" & description ?~ "Text"] --- genSwaggerDoc :: IO () --- genSwaggerDoc = BL8.writeFile "swagger.json" (encode swaggerDoc) - --- billOp :: Traversal' Swagger Operation --- billOp = subOperations (Proxy :: Proxy BillCouponApi) (Proxy :: Proxy ServerApi) - --- billText :: T.Text --- billText = cs $ encode billCouponExample - --- billCouponSchema :: BL8.ByteString --- billCouponSchema = encode $ toSchema (Proxy::Proxy BillCoupon)