created update, put data into the database, modified readme

2015-08-07 00:07:48 +02:00
parent 753b9079e7
commit 05f07155f1
9 changed files with 160 additions and 52 deletions
--- 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
--- 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
--- a/Handler/Update.hs
+++ 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
--- 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|
-             <h1>Transactions in the last xx hours
+getWalletR = getWalletDetailsR 6 7

-             <h1>Statistices for the last xx days
-             #{show acc}
+getWalletDetailsR :: Int64 -> Int64 -> Handler Html
+getWalletDetailsR hrs days = loginOrDo (\(uid,user) -> do
+             now <- liftIO getCurrentTime
+             trans <- runDB $ selectList [TransactionDateTime >. (addUTCTime ((fromIntegral $ -(hrs*3600)) :: NominalDiffTime) now)] [Desc TransactionDateTime]
+             defaultLayout $ [whamlet|
+             <a href=@{WalletDetailsR 168 days}>show last 7 days
+             <h1>Transactions in the last #{hrs} hours
+             <table>
+               $forall Entity _ t <- trans
+                 <tr>
+                   <td>#{show $ transactionDateTime t}
+                   <td>#{transactionPriceCents t}
+                   <td>#{transactionClientName t}
+
+             <h1>Statistices for the last #{days} days
             |]
             )

--- 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```
--- 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)
--- 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
--- 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
--- a/templates/default-layout-wrapper.hamlet
+++ b/templates/default-layout-wrapper.hamlet
@@ -53,6 +53,7 @@ $newline never
                  <li role="separator" class="divider">
                  <li><a href="@SettingsR">Settings</a-->
            <ul class="nav navbar-nav navbar-right">
+              <li><a href="@{UpdateR}">Update</a>
              <li><a href="@{AuthR LogoutR}">Logout</a>
    <div id="main" role="main">
        ^{pageBody pc}