Switch to Postgres + snaplet arch compiles.

Dependencies

• [2] IZEVQF62 Work in progress replacing sqlite with postgres.
• [3] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
• [4] EQXRXRZD Changed to use tasty instead of test-framework
• [5] TCOAKCGG Completed conversion to snap.
• [6] LAROLAYU WIP
• [7] 64VI73NP Server now compiles using abstracted SQLite
• [8] EMVTF2IW WIP moving back to snap.
• [9] RSEB2NFG Replacing Snap with Scotty.
• [10] W35DDBFY Factor common JSON conversions up into client lib module.
• [11] ADMKQQGC Initial empty Snap project.
• [12] TLQ72DSJ Lenses, sqlite-simple
• [13] 7XN3I3QJ Add 'loggedIntervals' endpoint.
• [14] Z3M53KTL Adrift.
• [15] 2Y2QZFVF Switch to more modern cabal2nix-based workflow.
• [*] WO2MINIF Auctions now compile!

Change contents

• edit in lib/Quixotic/Database/PostgreSQL.hs at line 15
  [2.906]→[2.906:946](∅→∅)
  − import Database.PostgreSQL.Simple.ToRow
• replacement in lib/Quixotic/Database/PostgreSQL.hs at line 40
  [2.1575]→[2.1575:1605](∅→∅)
  − btcParser f v = fromField f v
  [2.1575]

  [2.1605]
  + btcParser f v = fromRational <$> fromField f v
• edit in lib/Quixotic/Database/PostgreSQL.hs at line 63
  [2.2289]

  [2.2289]
  + qdbUserRowParser :: RowParser QDBUser

  + qdbUserRowParser = QDBUser <$> fieldWith uidParser <*> userRowParser

  +
• replacement in lib/Quixotic/Database/PostgreSQL.hs at line 67
  [2.2338]→[2.2338:2374](∅→∅)
  − newtype PBTC = PBTC { pBTC :: BTC }
  [2.2338]

  [2.2374]
  + newtype PBTC = PBTC BTC
• edit in lib/Quixotic/Database/PostgreSQL.hs at line 90
  [2.3062]

  [2.3062]
  + newtype PQDBUser = PQDBUser { pQDBUser :: QDBUser }

  + instance FromRow PQDBUser where

  + fromRow = PQDBUser <$> qdbUserRowParser

  +
• replacement in lib/Quixotic/Database/PostgreSQL.hs at line 149
  [2.4914]→[2.4914:4936](∅→∅)
  − createUser' user = do
  [2.4914]

  [2.4936]
  + createUser' user' = do
• replacement in lib/Quixotic/Database/PostgreSQL.hs at line 153
  [2.5055]→[2.5055:5140](∅→∅)
  − (user ^. (username._UserName), user ^. (userAddress.address), user ^. userEmail)
  [2.5055]

  [2.5140]
  + (user' ^. (username._UserName), user' ^. (userAddress.address), user' ^. userEmail)
• replacement in lib/Quixotic/Database/PostgreSQL.hs at line 164
  [2.5425]→[2.5425:5524](∅→∅)
  − findUserByHandle' :: Handle -> ReaderT Connection IO (Maybe QDBUser)

  − findUserByHandle' = undefined
  [2.5425]

  [2.5524]
  + findUserByUserName' :: UserName -> ReaderT Connection IO (Maybe QDBUser)

  + findUserByUserName' (UserName h) = do

  + conn <- ask

  + users <- lift $ query conn

  + "SELECT id, handle, btc_addr, email FROM users WHERE handle = ?"

  + (Only h)

  + pure . fmap pQDBUser $ headMay users
• edit in lib/Quixotic/Database/PostgreSQL.hs at line 172
  [2.5525]

  [2.5525]
  +
• replacement in lib/Quixotic/Database/PostgreSQL.hs at line 183
  [2.5820]→[2.5820:5861](∅→∅)
  − , findUserByHandle = findUserByHandle'
  [2.5820]

  [2.5861]
  + , findUserByUserName = findUserByUserName'
• replacement in lib/Quixotic/Database/SQLite.hs at line 132
  [2.6459]→[2.6459:6501](∅→∅)
  − , findUserByHandle = \_ -> pure Nothing
  [2.6459]

  [3.3270]
  + , findUserByUserName = \_ -> pure Nothing
• replacement in lib/Quixotic/Database.hs at line 27
  [2.7012]→[2.7012:7064](∅→∅)
  − , findUserByHandle :: Handle -> m (Maybe QDBUser)
  [2.7012]

  [3.5159]
  + , findUserByUserName :: UserName -> m (Maybe QDBUser)
• edit in quixotic.cabal at line 27
  [3.751]

  [17.1584]
  + Quixotic.Users
• replacement in server/Main.hs at line 1
  [3.5188]→[3.1384:1459](∅→∅),[3.1459]→[2.7498:7548](∅→∅)
  − {-# LANGUAGE ScopedTypeVariables, OverloadedStrings, NoImplicitPrelude #-}

  − {-# LANGUAGE RecordWildCards, TemplateHaskell #-}
  [3.5188]

  [3.5255]
  + {-# LANGUAGE ScopedTypeVariables #-}

  + {-# LANGUAGE OverloadedStrings #-}

  + {-# LANGUAGE NoImplicitPrelude #-}

  + {-# LANGUAGE RecordWildCards #-}

  + {-# LANGUAGE FlexibleInstances #-}

  + {-# LANGUAGE TemplateHaskell #-}
• replacement in server/Main.hs at line 13
  [3.643]→[2.7549:7572](∅→∅),[3.643]→[3.191:225](∅→∅),[2.7572]→[3.191:225](∅→∅),[3.191]→[3.191:225](∅→∅),[3.225]→[3.2406:2439](∅→∅),[3.2406]→[3.2406:2439](∅→∅)
  − import Control.Lens.TH

  − import Control.Monad.Trans.Reader

  − import qualified Data.Aeson as A
  [3.643]

  [3.112]
  + import Control.Monad.Reader

  + import Control.Monad.State
• edit in server/Main.hs at line 17
  [3.170]→[3.644:660](∅→∅),[3.660]→[2.7573:7590](∅→∅)
  − import Data.Map

  − import Data.Pool
• edit in server/Main.hs at line 22
  [2.7661]→[3.920:941](∅→∅),[3.217]→[3.920:941](∅→∅)
  − import Quixotic.Json
• edit in server/Main.hs at line 23
  [3.2567]

  [3.942]
  + import Quixotic.Users
• replacement in server/Main.hs at line 29
  [2.7682]→[2.7682:7707](∅→∅)
  − import Snap.Snaplet.Auth
  [2.7682]

  [2.7707]
  + import Snap.Snaplet.PostgresqlSimple

  + import qualified Snap.Snaplet.Auth as AU
• edit in server/Main.hs at line 32
  [2.7758]→[2.7758:7795](∅→∅)
  − import Snap.Snaplet.PostgresqlSimple
• replacement in server/Main.hs at line 51
  [2.8110]→[2.8110:8149](∅→∅)
  − , _auth :: Snaplet (AuthManager App)
  [2.8110]

  [2.8149]
  + , _auth :: Snaplet (AU.AuthManager App)
• edit in server/Main.hs at line 55
  [3.315]

  [2.8171]
  + instance HasPostgres (Handler b App) where

  + getPostgresState = with db get

  + setLocalPostgresState s = local (set (db . snapletValue) s)

  +
• edit in server/Main.hs at line 110
  [3.6063]

  [2.9374]
  + requireLogin :: Handler App App a -> Handler App App a

  + requireLogin = AU.requireUser auth (redirect "/login")

  +

  + requireUserId :: (UserId -> Handler App App a) -> Handler App App a

  + requireUserId hf = AU.requireUser auth (redirect "/login") $ do

  + QDB{..} <- with qdb get

  + authedUser <- with auth AU.currentUser

  + qdbUser <- case UserName . AU.unUid <$> (AU.userId =<< authedUser) of

  + Nothing -> snapError 403 "User is authenticated, but session lacks user identifier"

  + Just n -> liftPG . runReaderT $ findUserByUserName n

  + case qdbUser of

  + Nothing -> snapError 403 "Unable to retrieve user record for authenticated user"

  + Just u -> hf (u ^. userId)

  +
• replacement in server/Main.hs at line 125
  [2.9424]→[2.9424:9563](∅→∅)
  − logWorkHandler evType = do

  − QDB{..} <- with qdb mempty

  − pg <- with db getPostgresState

  − authedUser <- with auth currentUser

  − qUid <-
  [2.9424]

  [2.9563]
  + logWorkHandler evType = requireUserId $ \uid -> do

  + QDB{..} <- with qdb get
• replacement in server/Main.hs at line 130
  [2.9679]→[2.9679:9872](∅→∅)
  − btcAddr = fmap decodeUtf8 addrBytes >>= parseBtcAddr

  − storeEv uid addr = runReaderT . recordEvent uid $ LogEntry addr workEvent

  − maybe (snapError 400 "") (liftPG . storeEv) btcAddr
  [2.9679]

  [3.981]
  + storeEv addr = runReaderT . recordEvent uid $ LogEntry addr workEvent

  + case fmap decodeUtf8 addrBytes >>= parseBtcAddr of

  + Nothing -> snapError 400 $ "Unable to parse bitcoin address from " <> (tshow addrBytes)

  + Just addr -> liftPG $ storeEv addr
• replacement in server/Main.hs at line 151
  [3.1017]→[3.1145:1181](∅→∅)
  − snapError :: Int -> Text -> Snap ()
  [3.1017]

  [3.1181]
  + snapError :: MonadSnap m => Int -> Text -> m a