nuttycom/aftok - Change IZEVQF627FA7VV25KJAWYWGGC35LZUUBBQRPN5ZAINTQLPEDRTEAC

Work in progress replacing sqlite with postgres.

Created by Kris Nuttycombe on January 20, 2015

IZEVQF627FA7VV25KJAWYWGGC35LZUUBBQRPN5ZAINTQLPEDRTEAC

Dependencies

In channels

main

Change contents

Deletion in lib/Quixotic/Auction.hs at line 7 [7.5084]
∅:D[5.116] → [6.3:21]
B:BD[7.5213] → [6.3:21]
```
import Data.Group
```
Replacement in lib/Quixotic/Auction.hs at line 8 [7.5084]
B:BD[6.43] → [6.43:59]
```
import Quixotic
```
[6.43]
[6.59]
```
import Network.Bitcoin
```
Insertion in lib/Quixotic/Auction.hs at line 13 [7.5084]
[8.59]
[7.5248]
```
makePrisms ''AuctionId
```
Deletion in lib/Quixotic/Auction.hs at line 19 [7.5084]
B:BD[7.5323] → [7.5323:5324]
Deletion in lib/Quixotic/Auction.hs at line 27 [7.5084]
∅:D[6.122] → [7.5404:5405]
B:BD[7.5404] → [7.5404:5405]

Replacement in lib/Quixotic/Auction.hs at line 34 [7.5084]

B:BD[8.241] → [8.241:301]

      btc  bid = toRational $ bid ^. (bidAmount . satoshis)

[8.241]

[8.301]

      btc  bid = toRational $ bid ^. bidAmount

Replacement in lib/Quixotic/Auction.hs at line 43 [7.5084]

B:BD[6.538] → [8.343:470]

        | (total ++ x ^. bidAmount) < (auction ^. raiseAmount) = 
          x : (takeWinningBids (total ++ x ^. bidAmount) xs)

[6.538]

[6.652]

        | total + (x ^. bidAmount) < (auction ^. raiseAmount) = 
          x : (takeWinningBids (total + (x ^. bidAmount)) xs)

Replacement in lib/Quixotic/Auction.hs at line 47 [7.5084]

B:BD[6.727] → [5.583:732]

B:BD[5.732] → [8.471:581]

        | total < auction ^. raiseAmount = 
          let remainder = (auction ^. raiseAmount) ++ invert total
              winFraction :: Rational
              winFraction = (toRational $ remainder ^. satoshis) / (toRational $ x ^. (bidAmount . satoshis))

[6.727]

[8.581]

        | total < (auction ^. raiseAmount) = 
          let remainder = (auction ^. raiseAmount) - total
              winFraction = toRational $ remainder / (x ^. bidAmount)

Replacement in lib/Quixotic/Auction.hs at line 57 [7.5084]
B:BD[6.1147] → [6.1147:1188]
```
  in  takeWinningBids mempty $ sort bids
```
[6.1147]
```
  in  takeWinningBids (fromInteger 0) $ sort bids
```

File addition: PostgreSQL.hs (----------)

[9.40]

{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
module Quixotic.Database.PostgreSQL (postgresQDB) where
import Blaze.ByteString.Builder (fromByteString)
import ClassyPrelude
import Control.Lens
import Data.Fixed
import Data.Hourglass
import qualified Data.List as DL
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.ToField
import Database.PostgreSQL.Simple.FromField
import Database.PostgreSQL.Simple.ToRow
import Database.PostgreSQL.Simple.FromRow
import Network.Bitcoin
import Quixotic
import Quixotic.Auction
import Quixotic.Database
import Quixotic.TimeLog
import Quixotic.Users
eventTypeParser :: FieldParser EventType
eventTypeParser f v = fromField f v >>= nameEvent
uidParser :: FieldParser UserId
uidParser f v = UserId <$> fromField f v
secondsParser :: FieldParser Seconds
secondsParser f v = Seconds <$> fromField f v
usernameParser :: FieldParser UserName
usernameParser f v = UserName <$> fromField f v
btcAddrParser :: FieldParser BtcAddr
btcAddrParser f v = BtcAddr <$> fromField f v
btcParser :: FieldParser BTC
btcParser f v = fromField f v
workEventParser :: RowParser WorkEvent
workEventParser = WorkEvent <$> fieldWith eventTypeParser <*> field 
logEntryParser :: RowParser LogEntry
logEntryParser  = LogEntry <$> fieldWith btcAddrParser <*> workEventParser 
auctionRowParser :: RowParser Auction
auctionRowParser = Auction <$> fieldWith btcParser <*> field
bidRowParser :: RowParser Bid
bidRowParser = Bid <$> fieldWith uidParser 
                   <*> fieldWith secondsParser 
                   <*> fieldWith btcParser 
                   <*> field
userRowParser :: RowParser User
userRowParser = User <$> fieldWith usernameParser
                     <*> fieldWith btcAddrParser
                     <*> field
-- Local newtypes to permit field serialization 
newtype PBTC = PBTC { pBTC :: BTC }
instance ToField PBTC where
  toField (PBTC btc) = Plain . fromByteString . fromString $ showFixed False btc
-- Local newtypes to permit row deserialization via
-- typeclass. Wish I could just pass the RowParser instances
newtype PLogEntry = PLogEntry { pLogEntry :: LogEntry } 
instance FromRow PLogEntry where
  fromRow = PLogEntry <$> logEntryParser
newtype PBid = PBid { pBid :: Bid }
instance FromRow PBid where
  fromRow = PBid <$> bidRowParser
newtype PUser = PUser { pUser :: User }
instance FromRow PUser where
  fromRow = PUser <$> userRowParser
newtype PAuction = PAuction { pAuction :: Auction }
instance FromRow PAuction where
  fromRow = PAuction <$> auctionRowParser
recordEvent' :: UserId -> LogEntry -> ReaderT Connection IO ()
recordEvent' (UserId uid) (LogEntry a e) = do 
  conn <- ask
  void . lift $ execute conn 
    "INSERT INTO work_events (user_id, btc_addr, event_type, event_time) VALUES (?, ?, ?, ?)" 
    ( uid
    , a ^. address
    , e ^. (eventType . to eventName)
    , e ^. eventTime
    )
readWorkIndex' :: ReaderT Connection IO WorkIndex
readWorkIndex' = do
  conn <- ask
  rows <- lift $ query_ conn
    "SELECT btc_addr, event_type, event_time from work_events" 
  pure . workIndex $ fmap pLogEntry rows
newAuction' :: Auction -> ReaderT Connection IO AuctionId
newAuction' auc = do
  conn <- ask
  aucIds <- lift $ query conn
    "INSERT INTO auctions (raise_amount, end_time) VALUES (?, ?) RETURNING id"
    (auc ^. (raiseAmount.to PBTC), auc ^. auctionEnd)
  pure . AuctionId . fromOnly $ DL.head aucIds
readAuction' :: AuctionId -> ReaderT Connection IO (Maybe Auction)
readAuction' aucId = do
  conn <- ask
  rows <- lift $ query conn
    "SELECT raise_amount, end_time FROM auctions WHERE ROWID = ?" 
    (Only (aucId ^. _AuctionId))
  pure . fmap pAuction $ headMay rows
recordBid' :: AuctionId -> Bid -> ReaderT Connection IO ()
recordBid' (AuctionId aucId) bid = do
  conn <- ask
  void . lift $ execute conn
    "INSERT INTO bids (auction_id, user_id, bid_seconds, bid_amount, bid_time) values (?, ?, ?, ?, ?)"
    ( aucId 
    , bid ^. (bidUser._UserId)
    , case bid ^. bidSeconds of (Seconds i) -> i
    , bid ^. (bidAmount.to PBTC)
    , bid ^. bidTime
    )
readBids' :: AuctionId -> ReaderT Connection IO [Bid]
readBids' aucId = do
  conn <- ask
  rows <- lift $ query conn
    "SELECT user_id, bid_seconds, bid_amount, bid_time FROM bids WHERE auction_id = ?"
    (Only $ (aucId ^. _AuctionId))
  pure $ fmap pBid rows
createUser' :: User -> ReaderT Connection IO UserId
createUser' user = do
  conn <- ask
  uids <- lift $ query conn
    "INSERT INTO users (handle, btc_addr, email) VALUES (?, ?) RETURNING id"
    (user ^. (username._UserName), user ^. (userAddress.address), user ^. userEmail)
  pure . UserId . fromOnly $ DL.head uids
findUser' :: UserId -> ReaderT Connection IO (Maybe User)
findUser' (UserId uid) = do
  conn <- ask
  users <- lift $ query conn
    "SELECT handle, btc_addr, email FROM users WHERE id = ?"
    (Only uid)
  pure . fmap pUser $ headMay users
findUserByHandle' :: Handle -> ReaderT Connection IO (Maybe QDBUser)
findUserByHandle' = undefined
postgresQDB :: QDB (ReaderT Connection IO)
postgresQDB = QDB 
  { recordEvent = recordEvent'
  , readWorkIndex = readWorkIndex' 
  , newAuction = newAuction'
  , readAuction = readAuction'
  , recordBid = recordBid'
  , readBids = readBids'
  , createUser = createUser'
  , findUser = findUser'
  , findUserByHandle = findUserByHandle'
  }

Insertion in lib/Quixotic/Database/SQLite.hs at line 11 [11.3612]
[2.65]
[10.102]
```
import qualified Text.Read as R
```

Replacement in lib/Quixotic/Database/SQLite.hs at line 37 [11.3612]

B:BD[8.1399] → [8.1399:1462]

    let auctionParser = Auction <$> (fmap BTC field) <*> field

[8.1399]

[8.1462]

    let auctionParser = Auction <$> fmap R.read field <*> field

Replacement in lib/Quixotic/Database/SQLite.hs at line 45 [11.3612]

B:BD[2.151] → [2.151:249]

    let bidParser = Bid <$> fmap UserId field <*> fmap Seconds field <*> fmap BTC field <*> field

[2.151]

[2.249]

    let bidParser = Bid <$> fmap UserId field <*> fmap Seconds field <*> fmap R.read field <*> field

Deletion in lib/Quixotic/Database/SQLite.hs at line 62 [11.3612]
B:BD[2.631] → [2.631:656]
```
newtype PBTC = PBTC BTC
```

Replacement in lib/Quixotic/Database/SQLite.hs at line 63 [11.3612]

B:BD[2.657] → [2.657:722]

∅:D[2.722] → [12.797:798]

∅:D[8.1498] → [12.797:798]

B:BD[12.797] → [12.797:798]

B:BD[12.798] → [8.1499:1580]

instance ToField PBTC where
  toField (PBTC (BTC i)) = toField i
recordEvent' :: LogEntry -> ReaderT Connection IO ()
recordEvent' logEntry = do

[2.657]

[8.1580]

-- TODO: Record the user id
recordEvent' :: UserId -> LogEntry -> ReaderT Connection IO ()
recordEvent' _ logEntry = do

Replacement in lib/Quixotic/Database/SQLite.hs at line 83 [11.3612]

B:BD[8.2151] → [8.2151:2208]

    (auc ^. (raiseAmount . satoshis), auc ^. auctionEnd)

[8.2151]

[8.2208]

    (show $ auc ^. raiseAmount, auc ^. auctionEnd)

Replacement in lib/Quixotic/Database/SQLite.hs at line 102 [11.3612]
B:BD[2.895] → [2.895:925]
```
    , PBTC $ bid ^. bidAmount
```
[2.895]
[2.925]
```
    , show $ bid ^. bidAmount
```
Replacement in lib/Quixotic/Database/SQLite.hs at line 115 [11.3612]
B:BD[8.2989] → [2.1227:1249]
```
createUser' user = do
```
[8.2989]
[2.1249]
```
createUser' u = do
```

Replacement in lib/Quixotic/Database/SQLite.hs at line 119 [11.3612]

B:BD[2.1341] → [2.1341:1398]

    (user ^. (userAddress . address), user ^. userEmail)

[2.1341]

[2.1398]

    (u ^. (userAddress . address), u ^. userEmail)

Replacement in lib/Quixotic/Database/SQLite.hs at line 122 [11.3612]
B:BD[13.736] → [8.3014:3045]
```
sqliteQDB :: QDB IO Connection
```
[13.736]
[8.3045]
```
sqliteQDB :: QDB (ReaderT Connection IO)
```
Insertion in lib/Quixotic/Database/SQLite.hs at line 131 [11.3612]
[8.3270]
[8.3270]
```
  , findUser = \_ -> pure Nothing
  , findUserByHandle = \_ -> pure Nothing
```
Replacement in lib/Quixotic/Database.hs at line 1 [11.4936]
B:BD[11.4936] → [10.391:426]
```
{-# LANGUAGE NoImplicitPrelude #-}
```
[11.4936]
[10.426]
```
{-# LANGUAGE NoImplicitPrelude, TemplateHaskell #-}
```
Insertion in lib/Quixotic/Database.hs at line 6 [11.4936]
[14.838]
[7.5521]
```
import Control.Lens
```

Replacement in lib/Quixotic/Database.hs at line 12 [11.4936]

B:BD[11.5045] → [15.161:181]

∅:D[15.181] → [7.5568:5614]

B:BD[11.5065] → [7.5568:5614]

B:BD[7.5614] → [14.839:882]

∅:D[14.882] → [7.5674:5725]

B:BD[7.5674] → [7.5674:5725]

B:BD[7.5725] → [8.3276:3388]

B:BD[8.3388] → [2.1444:1491]

∅:D[2.1491] → [7.5885:5930]

B:BD[7.5885] → [7.5885:5930]

data QDB m a = QDB 
  { recordEvent :: LogEntry -> ReaderT a m ()
  , readWorkIndex :: ReaderT a m WorkIndex
  , newAuction :: Auction -> ReaderT a m AuctionId
  , readAuction :: AuctionId -> ReaderT a m (Maybe Auction)
  , recordBid :: AuctionId -> Bid -> ReaderT a m ()
  , readBids :: AuctionId -> ReaderT a m [Bid]
  , createUser :: User -> ReaderT a m UserId

[11.5045]

[11.5159]

data QDBUser = QDBUser 
  { _userId :: UserId 
  , _user :: User
  }
makeLenses ''QDBUser
data QDB m = QDB 
  { recordEvent :: UserId -> LogEntry -> m ()
  , readWorkIndex :: m WorkIndex
  , newAuction :: Auction -> m AuctionId
  , readAuction :: AuctionId -> m (Maybe Auction)
  , recordBid :: AuctionId -> Bid -> m ()
  , readBids :: AuctionId -> m [Bid]
  , createUser :: User -> m UserId
  , findUser :: UserId -> m (Maybe User)
  , findUserByHandle :: Handle -> m (Maybe QDBUser)

Insertion in lib/Quixotic/Users.hs at line 11 [7.5932]
[2.1598]
[7.6088]
```
makePrisms ''UserId
```

Insertion in lib/Quixotic/Users.hs at line 13 [7.5932]

[7.6089]

newtype UserName = UserName Text deriving (Show, Eq)
makePrisms ''UserName

Replacement in lib/Quixotic/Users.hs at line 17 [7.5932]
B:BD[7.6106] → [2.1599:1627]
```
  { _userAddress :: BtcAddr
```
[7.6106]
[2.1627]
```
  { _username :: UserName
  , _userAddress :: BtcAddr
```
Deletion in lib/Quixotic/Users.hs at line 21 [7.5932]
B:BD[7.6159] → [2.1651:1652]
Insertion in lib/Quixotic/Users.hs at line 22 [7.5932]
[2.1670]
Deletion in lib/Quixotic.hs at line 9 [17.2457]
B:BD[16.1787] → [6.1270:1288]
```
import Data.Group
```
Deletion in lib/Quixotic.hs at line 12 [17.2457]
∅:D[18.1198] → [17.2661:2662]
∅:D[5.1932] → [17.2661:2662]
B:BD[17.2661] → [17.2661:2662]
B:BD[17.2662] → [8.4901:4967]
∅:D[12.1272] → [5.1996:2013]
∅:D[8.4967] → [5.1996:2013]
B:BD[5.1996] → [5.1996:2013]
∅:D[5.2013] → [6.1354:1384]
B:BD[6.1354] → [6.1354:1384]
B:BD[6.1384] → [8.4968:5009]
∅:D[5.2053] → [6.1427:1514]
∅:D[8.5009] → [6.1427:1514]
B:BD[6.1427] → [6.1427:1514]
B:BD[6.1514] → [8.5010:5046]
∅:D[5.2091] → [6.1553:1581]
∅:D[8.5046] → [6.1553:1581]
B:BD[6.1553] → [6.1553:1581]
```
newtype BTC = BTC { _satoshis :: Int64 } deriving (Show, Eq, Ord)
makeLenses ''BTC
instance Semigroup BTC where
  (<>) (BTC b1) (BTC b2) = BTC $ b1 + b2
instance Monoid BTC where
  mempty = BTC 0
  mappend = (<>)
instance Group BTC where
  invert (BTC b) = BTC . negate $ b
instance Abelian BTC where
```

Insertion in quixotic.cabal at line 23 [11.1]

[11.672]

                      Quixotic.Database.PostgreSQL

Insertion in quixotic.cabal at line 40 [11.1]

[8.5169]

[6.1947]

    , postgresql-simple    >= 0.4.9    && < 0.5
    , blaze-builder

Insertion in quixotic.cabal at line 88 [11.1]

[19.3216]

[20.443]

    , postgresql-simple
    , snap                      >= 0.13  && < 0.14

Insertion in quixotic.cabal at line 92 [11.1]

[20.545]

[19.3217]

    , snaplet-postgresql-simple >= 0.6
    , resource-pool-catchio

Replacement in server/Main.hs at line 2 [22.5188]
B:BD[10.1459] → [21.95:128]
```
{-# LANGUAGE RecordWildCards #-}
```
[10.1459]
[22.5255]
```
{-# LANGUAGE RecordWildCards, TemplateHaskell #-}
```
Insertion in server/Main.hs at line 9 [22.5188]
[23.643]
[21.191]
```
import Control.Lens.TH
```
Replacement in server/Main.hs at line 15 [22.5188]
∅:D[24.170] → [21.226:256]
∅:D[23.660] → [21.226:256]
B:BD[25.122] → [21.226:256]
```
import Database.SQLite.Simple
```
[23.660]
[26.918]
```
import Data.Pool
import Database.PostgreSQL.Simple
```
Replacement in server/Main.hs at line 20 [22.5188]
B:BD[11.2543] → [25.185:217]
```
import Quixotic.Database.SQLite
```
[11.2543]
[26.920]
```
import Quixotic.Database.PostgreSQL
```

Insertion in server/Main.hs at line 27 [22.5188]

[24.218]

[22.5492]

import Snap.Snaplet
import Snap.Snaplet.Auth
import Snap.Snaplet.Auth.Backends.PostgresqlSimple
import Snap.Snaplet.PostgresqlSimple
import Snap.Snaplet.Session
import Snap.Snaplet.Session.Backends.CookieSession

Deletion in server/Main.hs at line 34 [22.5188]
B:BD[22.5493] → [27.1478:1492]
B:BD[27.1492] → [20.1634:1644]
B:BD[20.1644] → [24.219:255]
∅:D[24.255] → [21.257:284]
B:BD[28.189] → [21.257:284]
B:BD[21.284] → [24.256:339]
∅:D[28.246] → [11.2594:2595]
∅:D[25.304] → [11.2594:2595]
∅:D[21.334] → [11.2594:2595]
∅:D[24.339] → [11.2594:2595]
∅:D[20.1673] → [11.2594:2595]
∅:D[7.6332] → [11.2594:2595]
B:BD[27.1492] → [11.2594:2595]
B:BD[11.2595] → [15.207:245]
B:BD[15.245] → [21.335:353]
B:BD[21.353] → [4.2:210]
∅:D[4.210] → [7.6540:6545]
∅:D[21.504] → [7.6540:6545]
B:BD[7.6540] → [7.6540:6545]
∅:D[7.6545] → [20.1931:1932]
B:BD[20.1931] → [20.1931:1932]
```
main :: IO ()
main = do
  cfg <- loadQConfig "quixotic.cfg"
  db  <- open $ dbName cfg
  sconf <- snapConfig cfg
  simpleHttpServe sconf $ runReaderT (site sqliteQDB) db
site :: QDB IO a -> ReaderT a Snap ()
site qdb = route 
  [ ("logStart/:btcAddr", logWorkHandler qdb StartWork)
  , ("logEnd/:btcAddr",   logWorkHandler qdb StopWork)
  , ("loggedIntervals/:btcAddr", loggedIntervalsHandler qdb)
  , ("payouts", payoutsHandler qdb)
  ] 
```

Insertion in server/Main.hs at line 37 [22.5188]

[24.383]

[3.42]

  , authSiteKey :: FilePath
  , cookieTimeout :: Maybe Int

Replacement in server/Main.hs at line 41 [22.5188]
∅:D[3.95] → [28.288:309]
∅:D[24.430] → [28.288:309]
B:BD[28.288] → [28.288:309]
```
  , dbName :: String
```
[3.95]
[28.309]
```
  -- , dbName :: String
```

Insertion in server/Main.hs at line 43 [22.5188]

[28.314]


type PQDB = QDB (ReaderT Connection IO)
data App = App 
  { _qdb  :: Snaplet PQDB
  , _sess :: Snaplet SessionManager
  , _db   :: Snaplet Postgres
  , _auth :: Snaplet (AuthManager App)
  }
makeLenses ''App

Insertion in server/Main.hs at line 54 [22.5188]

[28.315]

[24.431]

main :: IO ()
main = do
  cfg <- loadQConfig "quixotic.cfg"
  sconf <- snapConfig cfg
  --simpleHttpServe sconf $ runReaderT (site sqliteQDB) db
  serveSnaplet sconf $ appInit cfg
appInit :: QConfig -> SnapletInit App App
appInit QConfig{..} = makeSnaplet "quixotic" "Quixotic Time Tracker" Nothing $ do
  qdbs  <- nestSnaplet "qdb" qdb qdbpgSnapletInit
  sesss <- nestSnaplet "sessions" sess $ 
           initCookieSessionManager (fpToString authSiteKey) "quookie" cookieTimeout
  pgs   <- nestSnaplet "db" db pgsInit
  auths <- nestSnaplet "auth" auth $ initPostgresAuth sess pgs
  addRoutes [ ("logStart/:btcAddr", logWorkHandler StartWork)
            , ("logEnd/:btcAddr",   logWorkHandler StopWork)
--            , ("loggedIntervals/:btcAddr", loggedIntervalsHandler qdb)
--            , ("payouts", payoutsHandler qdb)
            ] 
  return $ App qdbs sesss pgs auths

Insertion in server/Main.hs at line 84 [22.5188]

[3.143]

          <*> (fmap fpFromText $ C.require cfg "siteKey")
          <*> C.lookup cfg "cookieTimeout"

Replacement in server/Main.hs at line 88 [22.5188]
∅:D[3.264] → [24.795:829]
B:BD[24.795] → [24.795:829]
```
          <*> C.require cfg "db" 
```
[3.264]
[24.829]
```
          -- <*> C.require cfg "db" 
```
Replacement in server/Main.hs at line 98 [22.5188]
B:BD[24.1078] → [24.1078:1126]
```
snapConfig :: QConfig -> IO (SC.Config Snap ())
```
[24.1078]
[24.1126]
```
snapConfig :: QConfig -> IO (SC.Config Snap a)
```

Replacement in server/Main.hs at line 101 [22.5188]

B:BD[22.5696] → [4.211:300]

∅:D[4.300] → [21.649:669]

B:BD[21.649] → [21.649:669]

∅:D[21.669] → [7.6623:6664]

B:BD[25.620] → [7.6623:6664]

B:BD[7.6664] → [21.670:884]

logWorkHandler :: QDB IO a -> EventType -> ReaderT a Snap ()
logWorkHandler qdb ev = do 
  let QDB{..} = qdb
  addrBytes <- lift $ getParam "btcAddr"
  timestamp <- lift $ liftIO getCurrentTime
  maybe 
    (lift $ snapError 400 "")
    (\a -> mapReaderT liftIO $ recordEvent (LogEntry a (WorkEvent ev timestamp)))
    (fmap decodeUtf8 addrBytes >>= parseBtcAddr)

[22.5696]

[22.6062]

qdbpgSnapletInit :: SnapletInit a PQDB
qdbpgSnapletInit = makeSnaplet "qdbpg" "QDB on Postgresql" Nothing $ do
  return postgresQDB

Replacement in server/Main.hs at line 105 [22.5188]

B:BD[22.6063] → [4.301:389]

∅:D[4.389] → [23.790:981]

B:BD[23.790] → [23.790:981]

loggedIntervalsHandler :: QDB IO a -> ReaderT a Snap ()
loggedIntervalsHandler qdb = do
  let QDB{..} = qdb
  widx <- mapReaderT liftIO $ readWorkIndex
  lift . modifyResponse $ addHeader "content-type" "application/json"
  lift . writeLBS . A.encode $ mapKeys (^. address) widx

[22.6063]

[23.981]

logWorkHandler :: EventType -> Handler App App ()
logWorkHandler evType = do 
  QDB{..} <- with qdb mempty
  pg <- with db getPostgresState
  authedUser <- with auth currentUser
  qUid <- 
  addrBytes <- getParam "btcAddr"
  timestamp <- liftIO getCurrentTime
  let workEvent = WorkEvent evType timestamp
      btcAddr = fmap decodeUtf8 addrBytes >>= parseBtcAddr
      storeEv uid addr = runReaderT . recordEvent uid $ LogEntry addr workEvent
  maybe (snapError 400 "") (liftPG . storeEv) btcAddr

Replacement in server/Main.hs at line 118 [22.5188]

B:BD[23.982] → [4.390:463]

∅:D[4.463] → [21.910:985]

B:BD[21.910] → [21.910:985]

B:BD[25.759] → [21.986:1072]

B:BD[21.1072] → [3.412:482]

∅:D[3.482] → [21.1072:1144]

B:BD[21.1072] → [21.1072:1144]

payoutsHandler :: QDB IO a -> ReaderT a Snap ()
payoutsHandler qdb = do 
  let QDB{..} = qdb
      dep = linearDepreciation (Months 6) (Months 60) 
  ptime <- lift . liftIO $ getCurrentTime
  widx <- mapReaderT liftIO $ readWorkIndex
  lift . modifyResponse $ addHeader "content-type" "application/json"
  lift . writeLBS . A.encode . PayoutsResponse $ payouts dep ptime widx

[23.982]

[25.1016]

--loggedIntervalsHandler :: QDB IO a -> ReaderT a Snap ()
--loggedIntervalsHandler qdb = do
--  let QDB{..} = qdb
--  widx <- mapReaderT liftIO $ readWorkIndex
--  lift . modifyResponse $ addHeader "content-type" "application/json"
--  lift . writeLBS . A.encode $ mapKeys (^. address) widx
--
--payoutsHandler :: QDB IO a -> ReaderT a Snap ()
--payoutsHandler qdb = do 
--  let QDB{..} = qdb
--      dep = linearDepreciation (Months 6) (Months 60) 
--  ptime <- lift . liftIO $ getCurrentTime
--  widx <- mapReaderT liftIO $ readWorkIndex
--  lift . modifyResponse $ addHeader "content-type" "application/json"
--  lift . writeLBS . A.encode . PayoutsResponse $ payouts dep ptime widx

Work in progress replacing sqlite with postgres.

Dependencies

In channels

Change contents

Deletion in lib/Quixotic/Auction.hs at line 7 [7.5084]

Replacement in lib/Quixotic/Auction.hs at line 8 [7.5084]

Insertion in lib/Quixotic/Auction.hs at line 13 [7.5084]

Deletion in lib/Quixotic/Auction.hs at line 19 [7.5084]

Deletion in lib/Quixotic/Auction.hs at line 27 [7.5084]

Replacement in lib/Quixotic/Auction.hs at line 34 [7.5084]

Replacement in lib/Quixotic/Auction.hs at line 43 [7.5084]

Replacement in lib/Quixotic/Auction.hs at line 47 [7.5084]

Replacement in lib/Quixotic/Auction.hs at line 57 [7.5084]

File addition: PostgreSQL.hs (----------)

Insertion in lib/Quixotic/Database/SQLite.hs at line 11 [11.3612]

Replacement in lib/Quixotic/Database/SQLite.hs at line 37 [11.3612]

Replacement in lib/Quixotic/Database/SQLite.hs at line 45 [11.3612]

Deletion in lib/Quixotic/Database/SQLite.hs at line 62 [11.3612]

Replacement in lib/Quixotic/Database/SQLite.hs at line 63 [11.3612]

Replacement in lib/Quixotic/Database/SQLite.hs at line 83 [11.3612]

Replacement in lib/Quixotic/Database/SQLite.hs at line 102 [11.3612]

Replacement in lib/Quixotic/Database/SQLite.hs at line 115 [11.3612]

Replacement in lib/Quixotic/Database/SQLite.hs at line 119 [11.3612]

Replacement in lib/Quixotic/Database/SQLite.hs at line 122 [11.3612]

Insertion in lib/Quixotic/Database/SQLite.hs at line 131 [11.3612]

Replacement in lib/Quixotic/Database.hs at line 1 [11.4936]

Insertion in lib/Quixotic/Database.hs at line 6 [11.4936]

Replacement in lib/Quixotic/Database.hs at line 12 [11.4936]

Insertion in lib/Quixotic/Users.hs at line 11 [7.5932]

Insertion in lib/Quixotic/Users.hs at line 13 [7.5932]

Replacement in lib/Quixotic/Users.hs at line 17 [7.5932]

Deletion in lib/Quixotic/Users.hs at line 21 [7.5932]

Insertion in lib/Quixotic/Users.hs at line 22 [7.5932]

Deletion in lib/Quixotic.hs at line 9 [17.2457]

Deletion in lib/Quixotic.hs at line 12 [17.2457]

Insertion in quixotic.cabal at line 23 [11.1]

Insertion in quixotic.cabal at line 40 [11.1]

Insertion in quixotic.cabal at line 88 [11.1]

Insertion in quixotic.cabal at line 92 [11.1]

Replacement in server/Main.hs at line 2 [22.5188]

Insertion in server/Main.hs at line 9 [22.5188]

Replacement in server/Main.hs at line 15 [22.5188]

Replacement in server/Main.hs at line 20 [22.5188]

Insertion in server/Main.hs at line 27 [22.5188]

Deletion in server/Main.hs at line 34 [22.5188]