apt-get install -y --no-install-recommends cabal-install-1.22 ghc-7.8.4 happy-1.19.4 alex-3.1.3 \

    apt-get install -y --no-install-recommends cabal-install-1.22 ghc-7.10.2 happy-1.19.5 alex-3.1.4 \

ENV PATH /root/.cabal/bin:/opt/cabal/1.22/bin:/opt/ghc/7.8.4/bin:/opt/happy/1.19.4/bin:/opt/alex/3.1.3/bin:$PATH

ENV PATH /root/.cabal/bin:/opt/cabal/1.22/bin:/opt/ghc/7.10.2/bin:/opt/happy/1.19.5/bin:/opt/alex/3.1.4/bin:$PATH

Cabal-version: >= 1.18

Cabal-version: >= 1.22

      base                >= 4     && < 5
    , classy-prelude      >= 0.10.1
    , aeson               >= 0.8.0.2
    , attoparsec          >= 0.12.1.2
    , base64-bytestring   >= 1.0.0.1

      base                >= 4.8.0
    , classy-prelude      == 0.12.*
    , aeson               == 0.8.*
    , attoparsec          == 0.12.*
    , base64-bytestring   == 1.0.*

    , containers          >= 0.5.5.1

    , containers          >= 0.5.6

    , either              >= 4.3.1
    , errors              >= 1.4.7

    , either              >= 4.4.1
    , errors              >= 1.4      && < 1.5

    , groups              >= 0.4
    , heaps               >= 0.3.1

    , groups              >= 0.4      && < 0.5
    , heaps               >= 0.3.1    && < 0.4

    , HsOpenSSL           >= 0.11     && < 0.12

    , lens                >= 4.4.0.2
    , network-bitcoin     >= 1.7.0
    , old-locale
    , postgresql-simple   >= 0.4.9    && < 0.5
    , safe                >= 0.3.8

    , lens                >= 4.11     && < 4.12
    , network-bitcoin     >= 1.8      && < 1.9
    , old-locale          >= 1.0 
    , postgresql-simple   >= 0.4.10   && < 0.5
    , safe                >= 0.3.9    && < 0.4

    , sqlite-simple       >= 0.4.8    && < 0.5

    , text                >= 1.2
    , thyme               >= 0.3.5
    , uuid                >= 1.3

    , text                >= 1.2.1    && < 1.3
    , thyme               >= 0.3.5    && < 0.4
    , uuid                >= 1.3.10   && < 1.4

    , wreq

    , wreq                >= 0.4

    , hspec >= 1.8.1

    , hspec         >= 2.1.7

    , QuickCheck >= 2.7

    , QuickCheck    >= 2.8

    , classy-prelude            >= 0.10.2

    , classy-prelude            

    , HStringTemplate           >= 0.8.3

    , HsOpenSSL           

    , mtl                       >= 2     && < 3
    , MonadCatchIO-transformers >= 0.2.1 && < 0.4

    , mtl                       >= 2.2    && < 3
    , MonadCatchIO-transformers >= 0.3    && < 0.4

    , snap                      >= 0.13  && < 0.14
    , snap-core                 >= 0.9   && < 0.10
    , snap-server               >= 0.9   && < 0.10
    , snaplet-postgresql-simple >= 0.6

    , sendgrid-haskell          >= 1.0
    , snap                      >= 0.14
    , snap-core                 >= 0.9    && < 0.11
    , snap-server               >= 0.9    && < 0.11
    , snaplet-postgresql-simple >= 0.6    && < 0.11

    , uuid                >= 1.3

    , uuid                

import Data.Thyme.Clock as C

  , _auctionEnd :: UTCTime 

  , _auctionEnd :: C.UTCTime 

  , _bidTime    :: UTCTime

  , _bidTime    :: C.UTCTime

{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
module Aftok.Database.SQLite (sqliteQDB) where
import ClassyPrelude
import Control.Lens
import Data.Hourglass
import Database.SQLite.Simple
import Database.SQLite.Simple.ToField
import qualified Text.Read as R
import Aftok
import Aftok.Auctions
import Aftok.Projects
import Aftok.Database
import Aftok.TimeLog
import Aftok.Users
newtype PLogEntry = PLogEntry LogEntry
makePrisms ''PLogEntry
instance ToRow PLogEntry where
  toRow (PLogEntry (LogEntry a e)) = 
    toRow (a ^. address, e ^. (eventType . to eventName), e ^. eventTime)
instance FromRow PLogEntry where
  fromRow = 
    let workEventParser = WorkEvent <$> (field >>= nameEvent) <*> field 
        logEntryParser  = LogEntry <$> (fmap BtcAddr field) <*> workEventParser 
    in  fmap PLogEntry logEntryParser
newtype PAuction = PAuction Auction
makePrisms ''PAuction
instance FromRow PAuction where
  fromRow = 
    let auctionParser = Auction <$> fmap R.read field <*> field
    in  fmap PAuction auctionParser
newtype PBid = PBid Bid
makePrisms ''PBid
instance FromRow PBid where
  fromRow = 
    let bidParser = Bid <$> fmap UserId field <*> fmap Seconds field <*> fmap R.read field <*> field
    in  fmap PBid bidParser
newtype PSeconds = PSeconds Seconds
instance ToField PSeconds where 
  toField (PSeconds (Seconds i)) = toField i
newtype PUserId = PUserId UserId
instance ToField PUserId where 
  toField (PUserId (UserId i)) = toField i
newtype PAuctionId = PAuctionId AuctionId
instance ToField PAuctionId where 
  toField (PAuctionId (AuctionId i)) = toField i
-- TODO: Record the user id
recordEvent' :: ProjectId -> UserId -> LogEntry -> ReaderT Connection IO ()
recordEvent' _ _ logEntry = do 
  conn <- ask
  lift $ execute conn 
    "INSERT INTO work_events (btc_addr, event_type, event_time) VALUES (?, ?, ?)" 
    (logEntry ^. (from _PLogEntry))
readWorkIndex' :: ProjectId -> ReaderT Connection IO WorkIndex
readWorkIndex' _ = do
  conn <- ask
  rows <- lift $ query_ conn
    "SELECT btc_addr, event_type, event_time from work_events" 
  lift . pure . workIndex $ fmap (^. _PLogEntry) rows
newAuction' :: ProjectId -> Auction -> ReaderT Connection IO AuctionId
newAuction' _ auc = do
  conn <- ask
  lift $ execute conn
    "INSERT INTO auctions (raise_amount, end_time) VALUES (?, ?)"
    (show $ auc ^. raiseAmount, auc ^. auctionEnd)
  lift . fmap AuctionId $ lastInsertRowId conn
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 $ PAuctionId aucId)
  lift . return . headMay $ fmap (^. _PAuction) rows
recordBid' :: AuctionId -> Bid -> ReaderT Connection IO ()
recordBid' aucId bid = do
  conn <- ask
  lift $ execute conn
    "INSERT INTO bids (auction_id, user_id, bid_seconds, bid_amount, bid_time) values (?, ?, ?, ?, ?)"
    ( PAuctionId aucId
    , PUserId $ bid ^. bidUser
    , PSeconds $ bid ^. bidSeconds
    , show $ bid ^. bidAmount
    , 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 $ PAuctionId aucId)
  lift . return $ fmap (^. _PBid) rows
createUser' :: User -> ReaderT Connection IO UserId
createUser' u = do
  conn <- ask
  lift $ execute conn
    "INSERT INTO users (btc_addr, email) VALUES (?, ?)"
    (u ^. (userAddress . address), u ^. userEmail)
  lift . fmap UserId $ lastInsertRowId conn
sqliteQDB :: QDB (ReaderT Connection IO)
sqliteQDB = QDB 
  { recordEvent = recordEvent'
  , readWorkIndex = readWorkIndex' 
  , newAuction = newAuction'
  , readAuction = readAuction'
  , recordBid = recordBid'
  , readBids = readBids'
  , createUser = createUser'
  , findUser = \_ -> pure Nothing
  , findUserByUserName = \_ -> pure Nothing
  }

module Aftok.Database.PostgreSQL (QDBM(..)) where

module Aftok.Database.PostgreSQL (QDBM(), runQDBM) where

import Control.Monad.Trans.Either

newtype QDBM a = QDBM { runQDBM :: ReaderT Connection IO a }

newtype QDBM a = QDBM (ReaderT Connection (EitherT DBError IO) a)

instance MonadIO QDBM where
  liftIO = QDBM . lift . lift
runQDBM :: Connection -> QDBM a -> EitherT DBError IO a
runQDBM conn (QDBM r) = runReaderT r conn

emailParser :: FieldParser Email
emailParser f v = Email <$> fromField f v

newtype PPid = PPid ProjectId
instance ToField PPid where
  toField (PPid (ProjectId i)) = toField i

newtype PUTCTime = PUTCTime C.UTCTime 
instance ToField PUTCTime where
  toField (PUTCTime t) = toField $ fromThyme t

  Auction <$> fieldWith btcParser 
          <*> field

  Auction <$> (fromRational <$> field)
          <*> fieldWith utcParser

      <*> field

      <*> fieldWith utcParser

       <*> field

       <*> (Email <$> field)

          <*> field 

          <*> fieldWith utcParser 

invitationParser :: RowParser Invitation
invitationParser = 
  Invitation <$> fieldWith pidParser
             <*> fieldWith uidParser
             <*> fieldWith emailParser
             <*> fieldWith utcParser
             <*> fmap (fmap toThyme) field

  lift $ execute conn q d

  lift . lift $ execute conn q d

  ids  <- lift $ query conn q d

  ids  <- lift . lift $ query conn q d

  conn <- ask
  lift . lift $ queryWith p conn q d
transactQDBM :: QDBM a -> QDBM a
transactQDBM (QDBM rt) = QDBM $ do

  lift $ queryWith p conn q d

  lift . EitherT $ withTransaction conn (runEitherT $ runReaderT rt conn)

          (pid, uid, PUTCTime e)

          (pid, uid, fromThyme e)

          (pid, uid, PUTCTime s, PUTCTime e)

          (pid, uid, fromThyme s, fromThyme e)

          (pid, uid, PUTCTime s)

          (pid, uid, fromThyme s)

  dbEval (ReadWorkIndex pid) = do

  dbEval (ReadWorkIndex (ProjectId pid)) = do

      (Only $ PPid pid)

      (Only $ pid)

      (pid ^. (_ProjectId), auc ^. (raiseAmount.to PBTC), auc ^. auctionEnd)

      (pid ^. (_ProjectId), auc ^. (raiseAmount.to PBTC), auc ^. (auctionEnd.to fromThyme))

      , bid ^. bidTime

      , bid ^. (bidTime.to fromThyme)

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

      (user' ^. (username._UserName), user' ^. (userAddress._BtcAddr), user' ^. userEmail._Email)

  dbEval (CreateInvitation (ProjectId pid) (UserId uid) (Email e) t) = do
    invCode <- liftIO randomInvCode
    void $ pexec
      "INSERT INTO invitations (project_id, invitor_id, invitee_email, invitation_key, invitation_time) \
      \VALUES (?, ?, ?, ?, ?)"
      (pid, uid, e, renderInvCode invCode, fromThyme t)
    pure invCode

  dbEval (FindInvitation ic) = do
    invitations <- pquery invitationParser
      "SELECT project_id, invitor_id, invitee_email, invitation_time, acceptance_time \
      \FROM invitations WHERE invitation_key = ?"
      (Only $ renderInvCode ic)
    pure $ headMay invitations
  dbEval (AcceptInvitation (UserId uid) ic t) = transactQDBM $ do
    void $ pexec
      "UPDATE invitations SET acceptance_time = ? WHERE invitation_key = ?"
      (fromThyme t, renderInvCode ic)
    void $ pexec
      "INSERT INTO project_companions (project_id, user_id, invited_by, joined_at) \
      \SELECT i.project_id, ?, i.invitor_id, ? \
      \FROM invitations i \
      \WHERE i.invitation_key = ?"
      (uid, fromThyme t, renderInvCode ic)

      (p ^. projectName, p ^. inceptionDate, p ^. (initiator._UserId), toJSON $ p ^. depf)

      (p ^. projectName, p ^. (inceptionDate.to fromThyme), p ^. (initiator._UserId), toJSON $ p ^. depf)

  -- FIXME, these are just placeholders
  dbEval (OpForbidden _ reason _) = fail $ show reason
  dbEval (SubjectNotFound _) = fail "Subject of operation was not found."

  dbEval (RaiseDBError err _) = QDBM . lift $ left err

{-# LANGUAGE GADTs #-}

{-# LANGUAGE GADTs, DeriveDataTypeable #-}

import Data.AffineSpace
import Data.Thyme.Clock as C

  CreateInvitation :: ProjectId -> InvitingUID -> Email -> C.UTCTime -> DBOp InvitationCode
  FindInvitation   :: InvitationCode -> DBOp (Maybe Invitation)
  AcceptInvitation :: UserId -> InvitationCode -> C.UTCTime -> DBOp ()

  OpForbidden      :: forall x. UserId -> OpForbiddenReason -> DBOp x -> DBOp x
  SubjectNotFound  :: forall x. DBOp x -> DBOp x

  RaiseDBError     :: forall x. DBError -> DBOp x -> DBOp x

                       deriving (Eq, Show)

                       | InvitationExpired
                       | InvitationAlreadyAccepted
                       deriving (Eq, Show, Typeable)
data DBError = OpForbidden UserId OpForbiddenReason
             | SubjectNotFound
             deriving (Eq, Show, Typeable)
instance Exception DBError 
raiseOpForbidden :: UserId -> OpForbiddenReason -> DBOp x -> DBOp x
raiseOpForbidden uid r = RaiseDBError (OpForbidden uid r) 
raiseSubjectNotFound :: DBOp x -> DBOp x
raiseSubjectNotFound = RaiseDBError SubjectNotFound 

addUserToProject :: ProjectId -> InvitingUID -> InvitedUID -> DBProg ()
addUserToProject pid current new = 
  withProjectAuth pid current $ AddUserToProject pid current new

    else OpForbidden uid UserNotProjectMember act

    else raiseOpForbidden uid UserNotProjectMember act
addUserToProject :: ProjectId -> InvitingUID -> InvitedUID -> DBProg ()
addUserToProject pid current new = 
  withProjectAuth pid current $ AddUserToProject pid current new
createInvitation :: ProjectId -> InvitingUID -> Email -> C.UTCTime -> DBProg InvitationCode
createInvitation pid current email t =
  withProjectAuth pid current $ CreateInvitation pid current email t
findInvitation :: InvitationCode -> DBProg (Maybe Invitation)
findInvitation ic = fc $ FindInvitation ic
acceptInvitation :: UserId -> InvitationCode -> C.UTCTime -> DBProg ()
acceptInvitation uid ic t = do
  inv <- findInvitation ic
  let act = AcceptInvitation uid ic t
  case inv of
    Nothing -> 
      fc $ raiseSubjectNotFound act
    Just i | t .-. (i ^. invitationTime) > fromSeconds (60 * 60 * 72 :: Int) -> 
      fc $ raiseOpForbidden uid InvitationExpired act
    Just i | isJust (i ^. acceptanceTime) -> 
      fc $ raiseOpForbidden uid InvitationAlreadyAccepted act
    Just i -> 
      withProjectAuth (i ^. projectId) (i ^. invitingUser) act

createEvent p u l = withProjectAuth p u $ CreateEvent p u l

createEvent p u l = withProjectAuth p u $ CreateEvent p u l 

      forbidden = OpForbidden uid UserNotEventLogger act
      missing = SubjectNotFound act

      forbidden = raiseOpForbidden uid UserNotEventLogger act
      missing = raiseSubjectNotFound act

qdbProjectJSON (projectId, project) = v1 $
  object [ "projectId" .=  (tshow $ projectId ^. _ProjectId)

qdbProjectJSON (pid, project) = v1 $
  object [ "projectId" .=  (tshow $ pid ^. _ProjectId)

import Data.ByteString.Base64.URL as B64

import Data.Thyme.Clock as C

import Network.Bitcoin (BTC)

import OpenSSL.Random

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

  , _userEmail :: Text

  , _userEmail :: Email

type ProjectName = Text

  { _projectName :: Text
  , _inceptionDate :: UTCTime

  { _projectName :: ProjectName
  , _inceptionDate :: C.UTCTime

data Invitation = Invitation
  { _invitationProject :: ProjectId
  , _currentMember :: UserId
  , _sentAt :: UTCTime
  , _expiresAt :: UTCTime
  , _toAddr :: BtcAddr
  , _amount :: BTC
  }
makeLenses ''Invitation

newtype InvitationCode = InvitationCode ByteString deriving (Eq)
makePrisms ''InvitationCode
randomInvCode :: IO InvitationCode
randomInvCode = InvitationCode <$> randBytes 256

newtype InvitationId = InvitationId UUID deriving (Show, Eq)

parseInvCode :: Text -> Either String InvitationCode
parseInvCode t = do
  code <- B64.decode . encodeUtf8 $ t
  if length code == 256
    then Right $ InvitationCode code
    else Left "Invitation code appears to be invalid."

data Acceptance = Acceptance
  { _acceptedInvitation :: InvitationId
  , _blockHeight :: Integer
  , _observedAt :: UTCTime

renderInvCode :: InvitationCode -> Text
renderInvCode (InvitationCode bs) = decodeUtf8 $ B64.encode bs
data Invitation = Invitation 
  { _projectId :: ProjectId
  , _invitingUser :: UserId
  , _invitedEmail :: Email
  , _invitationTime :: C.UTCTime
  , _acceptanceTime :: Maybe C.UTCTime

makeLenses ''Acceptance

makeLenses ''Invitation

import qualified Network.Sendgrid.Api as Sendgrid

import System.IO(FilePath)

import System.IO (FilePath)

  , sendgridAuth :: Sendgrid.Authentication
  , templatePath :: System.IO.FilePath

          <*> readSendgridAuth cfg
          <*> C.require cfg "templatePath"
readSendgridAuth :: CT.Config -> IO Sendgrid.Authentication
readSendgridAuth cfg = 
  Sendgrid.Authentication <$> C.require cfg "sendgridUser"
                          <*> C.require cfg "sendgridKey"

import Data.Attoparsec.ByteString (parseOnly)

import Data.UUID(fromASCIIBytes)
import Data.Attoparsec.ByteString(parseOnly, takeByteString)

requireProjectId :: Handler App App ProjectId
requireProjectId = do
  pidMay <- getParam "projectId"
  case ProjectId <$> (readMay =<< fmap decodeUtf8 pidMay) of
    Nothing  -> snapError 400 "Value of parameter projectId could not be parsed to a valid value."
    Just pid -> pure pid

requireProjectId :: MonadSnap m => m ProjectId
requireProjectId = do 
  maybePid <- parseParam "projectId" pidParser 
  maybe (snapError 400 "Value of parameter \"projectId\" cannot be parsed as a valid UUID") 
        pure
        maybePid
  where
    pidParser = do
      bs <- takeByteString
      pure $ ProjectId <$> fromASCIIBytes bs

import Control.Lens

import Data.Attoparsec.ByteString (takeByteString)
import Data.Thyme.Clock as C
import qualified Network.Sendgrid.Api as Sendgrid
import System.IO (FilePath)
import Text.StringTemplate

import Aftok.QConfig

  timestamp <- liftIO getCurrentTime
  snapEval . createProject $ Project (cpn cp) timestamp uid (cpdepf cp)

  t <- liftIO C.getCurrentTime
  snapEval . createProject $ Project (cpn cp) t uid (cpdepf cp)

projectInviteHandler :: QConfig -> Handler App App ()
projectInviteHandler cfg = do
  uid <- requireUserId
  pid <- requireProjectId
  toEmail <- parseParam "email" (fmap (Email . decodeUtf8) takeByteString)
  t <- liftIO C.getCurrentTime
  (Just u, Just p, invCode) <- snapEval $ 
    (,,) <$> findUser uid
         <*> findProject pid uid
         <*> createInvitation pid uid toEmail t
  inviteEmail <- liftIO $ 
    projectInviteEmail (templatePath cfg) (p ^. projectName) (u ^. userEmail) toEmail invCode
  maybeSuccess <- liftIO $ Sendgrid.sendEmail (sendgridAuth cfg) inviteEmail
  maybe
    (snapError 500 "The invitation record was created successfully, but the introductory email could not be sent.")
    (const $ pure ())
    maybeSuccess
projectInviteEmail :: System.IO.FilePath 
                   -> ProjectName 
                   -> Email -> Email 
                   -> InvitationCode 
                   -> IO Sendgrid.EmailMessage 
projectInviteEmail templatePath pn from' to' invCode = do
  templates <- directoryGroup templatePath 
  template <- maybe (fail "Could not find template for invitation email") pure $ 
    getStringTemplate "invitation_email" templates
  let setAttrs = setAttribute "invCode" (renderInvCode invCode)
  return $ Sendgrid.EmailMessage 
    { from = unpack $ from' ^. _Email
    , to = unpack $ to' ^. _Email
    , subject = unpack $ "Welcome to the "<>pn<>" Aftok!"
    , text = render $ setAttrs template
    }

import Data.Thyme.Clock as C

  , _invitationCodes :: [InvitationCode]

    let u = User <$> (UserName <$> v .: "username")
                 <*> (BtcAddr  <$> v .: "btcAddr")
                 <*> v .: "email"
    in  CU <$> u <*> (fromString <$> v .: "password")

    let parseUser = User <$> (UserName <$> v .: "username")
                         <*> (BtcAddr  <$> v .: "btcAddr")
                         <*> (Email    <$> v .: "email")
        parseInvitationCodes c = either 
          (\e -> fail $ "Invitation code was rejected as invalid: " <> e) 
          pure 
          (traverse parseInvCode c)
    in  CU <$> parseUser
           <*> (fromString <$> v .: "password")
           <*> (parseInvitationCodes =<< v .: "invitation_codes")

registerHandler :: Handler App App ()

registerHandler :: Handler App App UserId

  -- allow any number of 'invitationCode' query parameters

  t <- liftIO C.getCurrentTime

      createQUser = snapEval (createUser $ userData ^. cuser)

      createQUser = snapEval $ do
        userId <- createUser $ userData ^. cuser
        void $ traverse (\c -> acceptInvitation userId c t) (userData ^. invitationCodes)
        return userId

  void $ either throwDenied (\_ -> createQUser) authUser 

  either throwDenied (\_ -> createQUser) authUser 

import Control.Monad.Trans.Either

import Data.Attoparsec.ByteString(Parser, parseOnly)

import Aftok

    getPostgresState = with db get
    setLocalPostgresState s = local (set (db . snapletValue) s)

  getPostgresState = with db get
  setLocalPostgresState s = local (set (db . snapletValue) s)

snapEval :: DBProg a -> Handler App App a 
snapEval p = liftPG . runReaderT . runQDBM $ interpret dbEval p

snapEval :: (MonadSnap m, HasPostgres m) => DBProg a -> m a
snapEval p = do
  let handleDBError (OpForbidden (UserId uid) reason) = 
        snapError 403 $ tshow reason <> " (User " <> tshow uid <> ")"
      handleDBError (SubjectNotFound) = 
        snapError 404 "The subject of the requested operation could not be found."
  e <- liftPG $ \conn -> runEitherT (runQDBM conn $ interpret dbEval p)
  either handleDBError pure e

parseParam :: MonadSnap m => ByteString -> Parser a -> m a
parseParam name parser = do
  maybeBytes <- getParam name
  case maybeBytes of
    Nothing -> snapError 400 $ "Parameter "<> tshow name <>" is required"
    Just bytes -> either
      (const . snapError 400 $ "Value of parameter "<> tshow name <>" could not be parsed to a valid value.")
      pure
      (parseOnly parser bytes)

appInit QConfig{..} = makeSnaplet "aftok" "Aftok Time Tracker" Nothing $ do

appInit cfg = makeSnaplet "aftok" "Aftok Time Tracker" Nothing $ do

           initCookieSessionManager authSiteKey "quookie" cookieTimeout
  pgs   <- nestSnaplet "db" db $ pgsInit' pgsConfig

           initCookieSessionManager (authSiteKey cfg) "quookie" (cookieTimeout cfg)
  pgs   <- nestSnaplet "db" db $ pgsInit' (pgsConfig cfg)

      projectCreateRoute = void $ method POST projectCreateHandler
      listProjectsRoute  = serveJSON (fmap qdbProjectJSON) $ method GET projectListHandler

      projectRoute       = serveJSON projectJSON $ method GET projectGetHandler

      payoutsRoute       = serveJSON payoutsJSON $ method GET payoutsHandler
      inviteRoute        = void . method POST $ projectInviteHandler cfg

      projectCreateRoute = void $ method POST projectCreateHandler
      projectRoute       = serveJSON projectJSON $ method GET projectGetHandler
      listProjectsRoute  = serveJSON (fmap qdbProjectJSON) $ method GET projectListHandler
      payoutsRoute       = serveJSON payoutsJSON $ method GET payoutsHandler

            , ("events/:eventId/amend", amendEventRoute)

            , ("projects", projectCreateRoute)
            , ("projects", listProjectsRoute)
            , ("projects/:projectId",                   projectRoute)

            , ("projects", projectCreateRoute)
            , ("projects", listProjectsRoute)
            , ("projects/:projectId", projectRoute)
            , ("projects/:projectId/payouts", payoutsRoute)

            , ("projects/:projectId/payouts",           payoutsRoute)
            , ("projects/:projectId/invite",            inviteRoute)
            , ("events/:eventId/amend", amendEventRoute)

alter table project_companions 
add joined_at timestamp with time zone not null 
default (now() at time zone "UTC");

create table invitations (
  id uuid primary key default uuid_generate_v4(),
  project_id uuid references projects(id) not null,
  invitor_id uuid references users (id) not null,
  invitee_email text not null,
  invitation_key text not null,
  invitation_time timestamp with time zone not null default (now() at time zone 'UTC'),
  acceptance_time timestamp with time zone
);