diff --git a/Application.hs b/Application.hs index 379bdc6..484a5e9 100644 --- a/Application.hs +++ b/Application.hs @@ -34,6 +34,7 @@ import Handler.Common import Handler.Home import Handler.Wallet import Handler.Settings +import Handler.Update -- This line actually creates our YesodDispatch instance. It is the second half -- of the call to mkYesodData which occurs in Foundation.hs. Please see the diff --git a/Foundation.hs b/Foundation.hs index 9cdeab2..e9090fe 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -148,6 +148,11 @@ instance YesodAuth App where , userLastLogin = now , userTokenExpires = expiry , userAccessToken = token + , userWalletTimeout = now + , userStandingsTimeout = now + , userSkillTimeout = now + , userAcc = 0 + , userBr = 0 } Nothing -> return $ ServerError "Problems extracting Access-Token" where diff --git a/Handler/Update.hs b/Handler/Update.hs new file mode 100644 index 0000000..07239bb --- /dev/null +++ b/Handler/Update.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE DoAndIfThenElse #-} + +module Handler.Update where + +import Import +import qualified Eve.Api.Char.WalletTransactions as WT +import qualified Eve.Api.Types as T +import qualified Eve.Api.Char.Standings as ST +import qualified Eve.Api.Char.Skills as SK + +accountingId :: Int64 +accountingId = 16622 +brokerRelationId :: Int64 +brokerRelationId = 3446 + +getUpdateR :: Handler Html +getUpdateR = loginOrDo (\(uid,user) -> do + man <- getHttpManager <$> ask + apiKey <- runDB $ getBy $ UniqueApiUser uid + now <- liftIO getCurrentTime + case apiKey of + Nothing -> return () + Just (Entity _ (Api _ k v)) -> do + let apidata = T.mkComplete k v (userCharId user) + --update skills + when (userSkillTimeout user < now) $ + do + skills <- liftIO $ SK.getSkills man apidata + case skills of + T.QueryResult time' skills' -> runDB $ do + update uid [UserAcc =. findLvl accountingId skills'] + update uid [UserBr =. findLvl brokerRelationId skills'] + update uid [UserSkillTimeout =. time'] + _ -> return () + --update standings + when (userStandingsTimeout user < now) $ + do + standings <- liftIO $ ST.getStandings man apidata + case standings of + T.QueryResult time' (_,cstand,fstand) -> runDB $ do + deleteWhere [CorpStandingsUser ==. uid] + deleteWhere [FactionStandingsUser ==. uid] + insertMany_ (migrateCorpStandings uid <$> cstand) + insertMany_ (migrateFactionStandings uid <$> fstand) + update uid [UserStandingsTimeout =. time'] + _ -> return () + --update transactions + when (userWalletTimeout user < now) $ + do + lastid <- runDB $ selectFirst [TransactionUser ==. uid] [Desc TransactionTransId] + trans <- case lastid of + Just (Entity _ t) -> liftIO $ WT.getWalletTransactionsBackTo man apidata (transactionTransId t) + Nothing -> liftIO $ WT.getWalletTransactionsBackTo man apidata 0 + case trans of + T.QueryResult time' trans' -> runDB $ do + update uid [UserWalletTimeout =. time'] + insertMany_ (migrateTransaction uid <$> trans') + _ -> return () + --let sql = "update" + --runDB $ rawExecute sql [uid] + redirect WalletR + ) + +findLvl :: Int64 -> [SK.Skill] -> Int +findLvl sid skills = case find (\(SK.Skill sid' _ _ _) -> sid' == sid) skills of + Just (SK.Skill _ _ lvl _) -> lvl + Nothing -> 0 + +migrateCorpStandings :: UserId -> ST.Standing -> CorpStandings +migrateCorpStandings u (ST.Standing cid cname standing) = CorpStandings u cid cname standing + +migrateFactionStandings :: UserId -> ST.Standing -> FactionStandings +migrateFactionStandings u (ST.Standing cid cname standing) = FactionStandings u cid cname standing + +migrateTransaction :: UserId -> WT.Transaction -> Transaction +migrateTransaction u (WT.Transaction dt tid q tn ti pc ci cn si sn tt tf jti) = + Transaction u dt tid q (if tis tt then -q else q) tn ti + (fromIntegral pc) ci cn si sn (tis tt) (tfc tf) jti + Nothing Nothing Nothing Nothing False + where + tis :: WT.TransactionType -> Bool + tis WT.Sell = True + tis WT.Buy = False + tfc :: WT.TransactionFor -> Bool + tfc WT.Corporation = True + tfc WT.Personal = False diff --git a/Handler/Wallet.hs b/Handler/Wallet.hs index 4af7cd2..68a3226 100644 --- a/Handler/Wallet.hs +++ b/Handler/Wallet.hs @@ -2,23 +2,26 @@ module Handler.Wallet where import Import -import Eve.Api.Char.MarketOrders -import Eve.Api.Types as T +import Data.Time.Clock getWalletR :: Handler Html -getWalletR = loginOrDo $ (\(uid,user) -> do - man <- getHttpManager <$> ask - apiKey <- runDB $ getBy $ UniqueApiUser uid - acc <- case apiKey of - Just (Entity _ (Api _ k v)) -> do - a <- liftIO $ getMarketOrders man (mkComplete k v (userCharId user)) - return (Just a) - Nothing -> return Nothing - defaultLayout $ [whamlet| -
#{show $ transactionDateTime t} + | #{transactionPriceCents t} + | #{transactionClientName t}
+
+ Statistices for the last #{days} days |] ) diff --git a/README.md b/README.md index 5774fab..400f252 100644 --- a/README.md +++ b/README.md @@ -34,4 +34,14 @@ At the moment there is nothing much to see here but a bit of playing around with 6. install dependencies and setup sandbox (invoke install.sh) -7. run yesod with ```yesod devel``` +7. Get the current postgres-data-dump from `https://www.fuzzwork.co.uk/dump/postgres-latest.dmp.bz2` and restore it into the `neat` database: + + ``` + sudo su postgres + cd /tmp + wget https://www.fuzzwork.co.uk/dump/postgres-latest.dmp.bz2 + bzip2 -d postgres-latest.dmp.bz2 + pg_restore -d neat postgres-latest.dmp + ``` + +8. run yesod with ```yesod devel``` diff --git a/config/models b/config/models index ca950da..e7dba38 100644 --- a/config/models +++ b/config/models @@ -6,6 +6,11 @@ User lastLogin UTCTime tokenExpires UTCTime accessToken Text + walletTimeout UTCTime + standingsTimeout UTCTime + skillTimeout UTCTime + br Int -- Broker-Relations-Skill + acc Int -- Accounting-Skill UniqueUser ident deriving Typeable @@ -21,45 +26,39 @@ Api vCode Text UniqueApiUser user -Character - auth Api - charID Int64 - brokerRelations Int default=0 - accounting Int default=0 - charName Text - escrow Double default=0 - transaction_cu Int64 default=0 - standings_cu Int64 default=0 - balance_cu Int64 default=0 - escrow_cu Int64 default=0 - UniqueChar charID +Transaction + user UserId + dateTime UTCTime + transId Int64 + quantity Int64 + inStock Int64 -- still to process. Positive for Buy-Orders, negative for Sell + typeName Text + typeId Int64 + priceCents Int64 + clientId Int64 + clientName Text + stationId Int64 + stationName Text + transIsSell Bool -- True = sell-order, False = buy-order + transForCorp Bool -- True = corp-order, False = personal order + journalTransId Int64 + profit Int64 Maybe --profit on this transaction + tax Int64 Maybe -- tax paid for selling + fee Int64 Maybe -- broker-fee for putting order up + secondsToSell Int64 Maybe --avg time this item needed to sell + noTax Bool -- True if no taxes should be calculated + +CorpStandings + user UserId + corpId Int64 + corpName Text + corpStanding Double FactionStandings - char Character - factionID Int64 - corpname Text - standing Double - -CharOrders - char Character - typeID Int64 - volRemaining Double - range Int64 - orderID Int64 - volEntered Int64 - minVolume Int64 - isBuy Bool - issueDate UTCTime - duration Int64 - stationID Int64 - regionID Int64 - solarSystemID Int64 - escrow Double - orderState Int64 - accountID Int64 - isCorp Bool - - + user UserId + factionId Int64 + factionName Text + factionStanding Double -- By default this file is used in Model.hs (which is imported by Foundation.hs) diff --git a/config/routes b/config/routes index 9b4de98..77d15e9 100644 --- a/config/routes +++ b/config/routes @@ -6,5 +6,7 @@ / HomeR GET POST /wallet WalletR GET +/wallet/#Int64/#Int64 WalletDetailsR GET -- /register RegisterR GET POST /settings SettingsR GET POST +/update UpdateR GET diff --git a/neat.cabal b/neat.cabal index 2c5f4ff..3929462 100644 --- a/neat.cabal +++ b/neat.cabal @@ -24,6 +24,7 @@ library Handler.Home Handler.Wallet Handler.Settings + Handler.Update if flag(dev) || flag(library-only) cpp-options: -DDEVELOPMENT diff --git a/templates/default-layout-wrapper.hamlet b/templates/default-layout-wrapper.hamlet index 8d5d71e..918a40e 100644 --- a/templates/default-layout-wrapper.hamlet +++ b/templates/default-layout-wrapper.hamlet @@ -53,6 +53,7 @@ $newline never |