Z7KS5XHHC6PAMTVBHXY7KUSS3BWAOU6FSYIITUCFOOJZU4OUJHBAC
SLL7262CJUE7TZDDZZXFROHCVVDA527WA4PHXCKEGZUJF2EN5MQAC
VJPT6HDRMJAJD5PT3VOYJYW43ISKLICEHLSDWSROX2XZWO2OFZPQC
BXGLKYRXO2O4NRM3BLNWQ7AWVPQXAMFS57MFYHJNOZZEZZW5BH6AC
5XFJNUAZUCQ3WCGW4QRIAWR764QYDOPHOIVO2TRMGSSG7UDX2M2AC
5W5M56VJFJEBXMGBVKGCKPHOEMVTKUOQMLPJP7VNDQLTYNJXXLHQC
LAROLAYUGJ4Q5AEFV5EJMIA2ZKBNCBWHHHPCJ3CKCNIUIYUKRFVQC
JKMHA2QGDSVHD4DKDYQUYNJJ3LUQCOPOWEC3543BDWDXLYIBBZXQC
WO2MINIF4TXOHWSE7JWXRZYN64XRVLYIRFMF4SMPSOXKA2V77KMQC
IZEVQF627FA7VV25KJAWYWGGC35LZUUBBQRPN5ZAINTQLPEDRTEAC
4IQVQL4TS35GL2GYZJG254TKJLL5EHMRSFT77Z4VTRZIG2TMBM3QC
TNR3TEHKVADAEZSTOD2XLSUTSW5AWST2YUW4CWK5KE7DSC6XHZNAC
TZQJVHBAMDNWDBYCDE3SDVGBG2T5FOE3J5JAD6NENRW36XBHUUFQC
64C6AWH66FDKU6UE6Z6JPX2J2GBM2JOPTH2GL6LHKAIUBGNGDZ5AC
TLQ72DSJD7GGPWN6HGBHAVPBRQFKEQ6KSK43U7JWWID4ZWAF47JAC
LUM4VQJIHJKQWWD5NVWTVSNPKQTMGQQICTFOTM6W4BMME2G3G5RQC
FRPWIKCNGK6PM6VCKEHEUG5A2LWL7WFN66L4CPQ7DLN4WAS3TIZQC
EQXRXRZDYCM7BDAVBOXQYPG6C7IJT3OFGNIXCDAHJJBRKAXNGL7AC
EMVTF2IWNQGRL44FC4JNG5FYYQTZSFPNM6SOM7IAEH6T7PPK2NVAC
7XN3I3QJHYMKU2DCUXX34WQMSJ4ZJOWW7FME34EANO3E5W4Q632AC
N4NDAZYTLSI2W22KT3SYXL257DBMSH3UT2BXOYM7LH7FSZAY4RLAC
W35DDBFYF6Z4ZPCFEO5RPAONZLYCSNTXUSTS6FIUUVZHCI6Q7GHAC
NVOCQVASZWTKQJG7GPH7KHKZZR7NUG4WLV5YY4KAIRPCJRWCZPIAC
75N3UJ4JK56KXF56GASGPAWLFYGJDETVJNYTF4KXFCQM767JUU5AC
GKGVYBZGPJXO7N7GLHLRNYQPXFHBQSNQN53OKRFCXLQEYDTC5I4QC
Y35QCWYW2OTZ27ZVTH2BA3XJTUCJ2WMLKU32ZCOCDY3AW7TIZXRAC
BROSTG5KP3NUNLSYPVQID254TE47E5RKQAKLPIY7PGWETE6JNMTAC
ADMKQQGCGVSHHIMVQ4XFRDCG544SBJCYALSKZV45CQQBZ4ACUH2AC
{-# LANGUAGE TemplateHaskell #-}
module Quixotic.Projects where
import ClassyPrelude
import Control.Lens
import Network.Bitcoin
import Quixotic
import Quixotic.Users
newtype ProjectId = ProjectId Int64 deriving (Show, Eq)
makePrisms ''ProjectId
data Project = Project
{ _projectName :: Text
, _inceptionDate :: UTCTime
, _initiator :: UserId
}
makeLenses ''Project
data Invitation = Invitation
{ _projectId :: ProjectId
, _currentMember :: UserId
, _sentAt :: UTCTime
, _toAddr :: BtcAddr
, _amount :: BTC
}
makeLenses ''Invitation
data Acceptance = Acceptance
{ _acceptedInvitation :: Int64
, _blockHeight :: Integer
, _observedAt :: UTCTime
}
makeLenses ''Acceptance
data Cancellation = Cancellation
{ _cancelledInvitation :: Int64
, _requestedAt :: UTCTime
}
makeLenses ''Cancellation
{-# LANGUAGE TemplateHaskell #-}
module Quixotic.Users where
import ClassyPrelude
newtype UserName = UserName Text deriving (Show, Eq)
makePrisms ''UserName
data User = User
}
makeLenses ''User
, _userEmail :: Text
{ _username :: UserName
, _userAddress :: BtcAddr
newtype UserId = UserId Int64 deriving (Show, Eq)
makePrisms ''UserId
import Control.Lens
import Quixotic
recordEvent' :: UserId -> LogEntry -> ReaderT Connection IO ()
recordEvent' (UserId uid) (LogEntry a e) = do
recordEvent' :: ProjectId -> UserId -> LogEntry -> ReaderT Connection IO ()
recordEvent' (ProjectId pid) (UserId uid) (LogEntry a e) = do
"INSERT INTO auctions (raise_amount, end_time) VALUES (?, ?) RETURNING id"
(auc ^. (raiseAmount.to PBTC), auc ^. auctionEnd)
"INSERT INTO auctions (project_id, raise_amount, end_time) VALUES (?, ?, ?) RETURNING id"
(pid ^. (_ProjectId), auc ^. (raiseAmount.to PBTC), auc ^. auctionEnd)
, readAuction :: ProjectId -> AuctionId -> m (Maybe Auction)
, recordBid :: ProjectId -> AuctionId -> Bid -> m ()
, readBids :: ProjectId -> AuctionId -> m [Bid]
, readAuction :: AuctionId -> m (Maybe Auction)
, recordBid :: AuctionId -> Bid -> m ()
, readBids :: AuctionId -> m [Bid]
instance ToJSON Interval where
toJSON (Interval s e) =
object ["start" .= s, "end" .= e]
instance FromJSON Interval where
parseJSON (Object v) = Interval <$> v .: "start" <*> v .: "end"
parseJSON _ = mzero
fmap (PayoutsResponse . mapKeys BtcAddr) $ parseJSON v
PayoutsJ . mapKeys BtcAddr <$> parseJSON v
newtype IntervalJ = IntervalJ Interval
makePrisms ''IntervalJ
instance ToJSON IntervalJ where
toJSON (IntervalJ ival) =
object ["start" .= (ival ^. start), "end" .= (ival ^. end)]
instance FromJSON IntervalJ where
parseJSON (Object v) =
fmap IntervalJ $ interval <$> v .: "start" <*> v .: "end"
parseJSON _ = mzero
instance FromJSON BtcAddr where
parseJSON (JV.String t) = return $ BtcAddr t
parseJSON _ = mzero
newtype UserId = UserId Int64 deriving (Show, Eq)
makePrisms ''UserId
newtype UserName = UserName Text deriving (Show, Eq)
makePrisms ''UserName
data User = User
{ _username :: UserName
, _userAddress :: BtcAddr
, _userEmail :: Text
}
makeLenses ''User
--instance FromField BtcAddr where
-- fromField f m = fmap BtcAddr $ fromField f m
newtype ProjectId = ProjectId Int64 deriving (Show, Eq)
makePrisms ''ProjectId
data Project = Project
{ _projectName :: Text
, _inceptionDate :: UTCTime
, _initiator :: UserId
}
makeLenses ''Project
data Invitation = Invitation
{ _projectId :: ProjectId
, _currentMember :: UserId
, _sentAt :: UTCTime
, _expiresAt :: UTCTime
, _toAddr :: BtcAddr
, _amount :: BTC
}
makeLenses ''Invitation
newtype InvitationId = InvitationId Int64
data Acceptance = Acceptance
{ _acceptedInvitation :: InvitationId
, _blockHeight :: Integer
, _observedAt :: UTCTime
}
makeLenses ''Acceptance
, ("logStart/:btcAddr", logWorkHandler StartWork)
, ("logEnd/:btcAddr", logWorkHandler StopWork)
, ("loggedIntervals/:btcAddr", loggedIntervalsHandler)
, ("payouts", payoutsHandler)
, ("logStart/:projectId/:btcAddr", logWorkHandler StartWork)
, ("logEnd/:projectId/:btcAddr", logWorkHandler StopWork)
, ("loggedIntervals/:projectId/:btcAddr", loggedIntervalsHandler)
, ("projects/:projectId", ok)
, ("payouts/:projectId", payoutsHandler)