created update, put data into the database, modified readme

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

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

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

Handler/Wallet.hs

@@ -2,23 +2,26 @@ module Handler.Wallet where
 
 import Import
 
-import Eve.Api.Char.MarketOrders
+import Data.Time.Clock
-import Eve.Api.Types as T
 
 getWalletR :: Handler Html
-getWalletR = loginOrDo $ (\(uid,user) -> do
+getWalletR = getWalletDetailsR 6 7
-             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
 
-             <h1>Statistices for the last xx days
+getWalletDetailsR :: Int64 -> Int64 -> Handler Html
-             #{show acc}
+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
              |]
              )
 

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```

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
+Transaction
-    auth Api
+    user UserId
-    charID Int64
+    dateTime UTCTime
-    brokerRelations Int  default=0
+    transId Int64
-    accounting Int       default=0
+    quantity Int64
-    charName Text
+    inStock Int64 -- still to process. Positive for Buy-Orders, negative for Sell
-    escrow Double        default=0
+    typeName Text
-    transaction_cu Int64 default=0
+    typeId Int64
-    standings_cu Int64   default=0
+    priceCents Int64
-    balance_cu Int64     default=0
+    clientId Int64
-    escrow_cu Int64      default=0
+    clientName Text
-    UniqueChar charID
+    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
+    user UserId
-    factionID Int64
+    factionId Int64
-    corpname Text
+    factionName Text
-    standing Double
+    factionStanding 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
-
-
 
 
  -- By default this file is used in Model.hs (which is imported by Foundation.hs)

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

neat.cabal

@@ -24,6 +24,7 @@ library
                      Handler.Home
                      Handler.Wallet
                      Handler.Settings
+                     Handler.Update
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT

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}