import Database.PostgreSQL.Simple.ToRow

btcParser f v = fromField f v

btcParser f v = fromRational <$> fromField f v

qdbUserRowParser :: RowParser QDBUser
qdbUserRowParser = QDBUser <$> fieldWith uidParser <*> userRowParser

newtype PBTC = PBTC { pBTC :: BTC }

newtype PBTC = PBTC BTC 

newtype PQDBUser = PQDBUser { pQDBUser :: QDBUser }
instance FromRow PQDBUser where
  fromRow = PQDBUser <$> qdbUserRowParser

createUser' user = do

createUser' user' = do

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

    (user' ^. (username._UserName), user' ^. (userAddress.address), user' ^. userEmail)

findUserByHandle' :: Handle -> ReaderT Connection IO (Maybe QDBUser)
findUserByHandle' = undefined

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

  , findUserByHandle = findUserByHandle'

  , findUserByUserName = findUserByUserName'

  , findUserByHandle = \_ -> pure Nothing

  , findUserByUserName = \_ -> pure Nothing

  , findUserByHandle :: Handle -> m (Maybe QDBUser)

  , findUserByUserName :: UserName -> m (Maybe QDBUser)

                      Quixotic.Users

{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards, TemplateHaskell #-}

{-# LANGUAGE ScopedTypeVariables #-} 
{-# LANGUAGE OverloadedStrings #-} 
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-} 
{-# LANGUAGE FlexibleInstances #-} 
{-# LANGUAGE TemplateHaskell #-}

import Control.Lens.TH
import Control.Monad.Trans.Reader
import qualified Data.Aeson as A

import Control.Monad.Reader
import Control.Monad.State

import Data.Map
import Data.Pool

import Quixotic.Json

import Quixotic.Users

import Snap.Snaplet.Auth

import Snap.Snaplet.PostgresqlSimple
import qualified Snap.Snaplet.Auth as AU

import Snap.Snaplet.PostgresqlSimple

  , _auth :: Snaplet (AuthManager App)

  , _auth :: Snaplet (AU.AuthManager App)

instance HasPostgres (Handler b App) where
    getPostgresState = with db get
    setLocalPostgresState s = local (set (db . snapletValue) s)

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)

logWorkHandler evType = do 
  QDB{..} <- with qdb mempty
  pg <- with db getPostgresState
  authedUser <- with auth currentUser
  qUid <- 

logWorkHandler evType = requireUserId $ \uid -> do 
  QDB{..} <- with qdb get

      btcAddr = fmap decodeUtf8 addrBytes >>= parseBtcAddr
      storeEv uid addr = runReaderT . recordEvent uid $ LogEntry addr workEvent
  maybe (snapError 400 "") (liftPG . storeEv) btcAddr

      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

snapError :: Int -> Text -> Snap ()

snapError :: MonadSnap m => Int -> Text -> m a