A6HKMINBNGQLLX4QJMYWKQ4JAEHVJ4HIRVDKPPDI3FJUO2AAB7OQC
XTBSG4C7SCZUFOU2BTNFR6B6TCGYI35BWUV4PVTS3N7KNH5VEARQC
EZQG2APB36DDMIAYDPPDGOIXOD7K2RZZSGC2NKGZIHB2HZBTW7EQC
4IQVQL4TS35GL2GYZJG254TKJLL5EHMRSFT77Z4VTRZIG2TMBM3QC
Z7KS5XHHC6PAMTVBHXY7KUSS3BWAOU6FSYIITUCFOOJZU4OUJHBAC
IZEVQF627FA7VV25KJAWYWGGC35LZUUBBQRPN5ZAINTQLPEDRTEAC
LD4GLVSF6YTA7OZWIGJ45H6TUXGM4WKUIYXKWQFNUP36WDMYSMXAC
TNR3TEHKVADAEZSTOD2XLSUTSW5AWST2YUW4CWK5KE7DSC6XHZNAC
PBD7LZYQHXAA3KLH2ZUX5GW4UFML6BQ32KXZF4KZ6OYFASUYFJ5QC
2G3GNDDUOVPF45PELJ65ZB2IXEHJJXJILFRVHZXGPXUL4BVNZJFQC
5XFJNUAZUCQ3WCGW4QRIAWR764QYDOPHOIVO2TRMGSSG7UDX2M2AC
64C6AWH66FDKU6UE6Z6JPX2J2GBM2JOPTH2GL6LHKAIUBGNGDZ5AC
N4NDAZYTLSI2W22KT3SYXL257DBMSH3UT2BXOYM7LH7FSZAY4RLAC
EQXRXRZDYCM7BDAVBOXQYPG6C7IJT3OFGNIXCDAHJJBRKAXNGL7AC
W35DDBFYF6Z4ZPCFEO5RPAONZLYCSNTXUSTS6FIUUVZHCI6Q7GHAC
Y35QCWYW2OTZ27ZVTH2BA3XJTUCJ2WMLKU32ZCOCDY3AW7TIZXRAC
TLQ72DSJD7GGPWN6HGBHAVPBRQFKEQ6KSK43U7JWWID4ZWAF47JAC
NVOCQVASZWTKQJG7GPH7KHKZZR7NUG4WLV5YY4KAIRPCJRWCZPIAC
SLL7262CJUE7TZDDZZXFROHCVVDA527WA4PHXCKEGZUJF2EN5MQAC
7DBNV3GV773FH5ZLQWFX4RBOS4Q3CIK2RYZNNABY3ZOETYZCXRNQC
EMVTF2IWNQGRL44FC4JNG5FYYQTZSFPNM6SOM7IAEH6T7PPK2NVAC
GKGVYBZGPJXO7N7GLHLRNYQPXFHBQSNQN53OKRFCXLQEYDTC5I4QC
7XN3I3QJHYMKU2DCUXX34WQMSJ4ZJOWW7FME34EANO3E5W4Q632AC
4QX5E5ACVN57KJLCWOM4JEI6JSV4XZNCWVYPOTKSOMUW3SOMCNJAC
OBFPJS2GHO2PEHBHGEHKIUOUAFIQHPIZXEVD2YIE3ZIE2PVMH5VAC
HE3JTXO37O4MOMWPZ4BRBHP53KBPZDG3PCSUCVNOKIS7IY26OCIAC
I2KHGVD44KT4MQJXGCTVSQKMBO6TVCY72F26TLXGWRL6PHGF6RNQC
ADMKQQGCGVSHHIMVQ4XFRDCG544SBJCYALSKZV45CQQBZ4ACUH2AC
BROSTG5KP3NUNLSYPVQID254TE47E5RKQAKLPIY7PGWETE6JNMTAC
the invitation
* Timeline
* Amend Event
* Amend operations targeting events older than <commit_delay hours> fail.
* MAYBE garnish/reimburse based approach?
* Secure the transaction log via inclusion of periodic hashes of the log
into the public blockchain?
the invitation + script
# * Timeline
# * Amend Event
# * Amend operations targeting events older than <commit_delay hours> fail.
Future Work
===========
Library
-------
* Timeline
* Amend Event
* MAYBE garnish/reimburse based approach?
* Secure the transaction log via inclusion of periodic hashes of the log
into the public blockchain?
* User
* Add public keys that can be used to sign requests. How does this interact
with certificate-based auth from browsers? Require openpgpjs?
* Payouts
* History of payouts (read from blockchain?)
Webserver
---------
* Login
* Evaluate OpenID options
* Companion Creation
* Require user to provide the PGP public key that will be used to authenticate requests
* Authentication
* Require bodies of all requests to be PGP-signed; this will take the place of
other authentication.
Payouts Service
---------------
void . lift $ execute conn
"INSERT INTO work_events (project_id, user_id, btc_addr, event_type, event_time, event_meta) \
\VALUES (?, ?, ?, ?, ?, ?)"
lift $ query conn q d
pexec :: (ToRow d) => Query -> d -> QDBM Int64
pexec q d = do
conn <- ask
lift $ execute conn q d
recordEvent' :: ProjectId -> UserId -> LogEntry -> QDBM EventId
recordEvent' (ProjectId pid) (UserId uid) (LogEntry a e) = do
eventIds <- pquery
"INSERT INTO work_events (project_id, user_id, btc_addr, event_type, event_time, event_metadata) \
\VALUES (?, ?, ?, ?, ?, ?) \
\RETURNING id"
readWorkIndex' :: ProjectId -> ReaderT Connection IO WorkIndex
amendEvent' :: EventId -> LogModification -> QDBM ()
amendEvent' (EventId eid) (TimeChange mt t) =
void $ pexec
"INSERT INTO event_time_amendments (event_id, mod_time, event_time) VALUES (?, ?, ?)"
( eid, mt ^. _ModTime, t )
amendEvent' (EventId eid) (AddressChange mt addr) =
void $ pexec
"INSERT INTO event_addr_amendments (event_id, mod_time, btc_addr) VALUES (?, ?, ?)"
( eid, mt ^. _ModTime, addr ^. _BtcAddr )
amendEvent' (EventId eid) (MetadataChange mt v) =
void $ pexec
"INSERT INTO event_metadata_amendments (event_id, mod_time, btc_addr) VALUES (?, ?, ?)"
( eid, mt ^. _ModTime, v )
readWorkIndex' :: ProjectId -> QDBM WorkIndex
intervalJSON :: Interval -> Value
intervalJSON ival = object ["start" .= (ival ^. start), "end" .= (ival ^. end)]
parseIntervalJSON :: Value -> Parser Interval
parseIntervalJSON (Object v) = interval <$> v .: "start" <*> v .: "end"
parseIntervalJSON _ = mzero
instance FromJSON PayoutsJ where
parseJSON v =
PayoutsJ . M.mapKeys BtcAddr <$> parseJSON v
printVersion :: Version -> Text
printVersion Version{..} = intercalate "." (fmap tshow [majorVersion, minorVersion, trivialVersion])
newtype IntervalJ = IntervalJ Interval
makePrisms ''IntervalJ
versionParser :: P.Parser Version
versionParser = Version <$> P.decimal <*> (P.char '.' >> P.decimal) <*> (P.char '.' >> P.decimal)
versioned :: Version -> Value -> Value
versioned ver v = object [ "schemaVersion" .= printVersion ver
, "value" .= v ]
instance ToJSON IntervalJ where
toJSON (IntervalJ ival) =
object ["start" .= (ival ^. start), "end" .= (ival ^. end)]
version :: QuasiQuoter
version = QuasiQuoter { quoteExp = quoteVersionExp
, quotePat = error "Pattern quasiquotation of versions not supported."
, quoteType = error "Type quasiquotation of versions not supported."
, quoteDec = error "Dec quasiquotation of versions not supported."
}
instance ToJSON ProjectJ where
toJSON (ProjectJ p) =
object [ "projectName" .= (p ^. projectName)
, "inceptionDate" .= (p ^. inceptionDate)
, "initiator" .= (p ^. (initiator._UserId)) ]
unversion :: (Version -> Value -> Parser a) -> Value -> Parser a
unversion f (Object v) = do
vers <- v .: "schemaVersion"
vers' <- either (\_ -> mzero) pure $ P.parseOnly versionParser (encodeUtf8 vers)
value <- v .: "value"
f vers' value
unversion _ _ = mzero
type Payouts = Map BtcAddr Rational
newtype Payouts = Payouts (Map BtcAddr Rational)
makePrisms ''Payouts
payoutsJSON :: Payouts -> Value
payoutsJSON (Payouts m) = toJSON $ MS.mapKeys (^. _BtcAddr) m
parsePayoutsJSON :: Value -> Parser Payouts
parsePayoutsJSON v =
Payouts . MS.mapKeys BtcAddr <$> parseJSON v
instance A.ToJSON Payouts where
toJSON = versioned (Version 1 0 0) . payoutsJSON
instance A.FromJSON Payouts where
parseJSON v = let parsePayouts (Version 1 0 0) = parsePayoutsJSON
parsePayouts v' = \_ -> fail . show $ printVersion v'
in unversion parsePayouts $ v
, ("projects/:projectId/logStart/:btcAddr", method POST $ logWorkHandler StartWork)
, ("projects/:projectId/logEnd/:btcAddr", method POST $ logWorkHandler StopWork)
, ("projects/:projectId/log/:btcAddr", serveJSON WidxJ $ method GET loggedIntervalsHandler)
, ("projects/:projectId", serveJSON ProjectJ $ method GET projectGetHandler)
, ("projects/:projectId/logStart/:btcAddr", serveJSON eventIdJSON . method POST $ logWorkHandler StartWork)
, ("projects/:projectId/logEnd/:btcAddr", serveJSON eventIdJSON . method POST $ logWorkHandler StopWork)
, ("projects/:projectId/log/:btcAddr", serveJSON workIndexJSON $ method GET loggedIntervalsHandler)
, ("projects/:projectId", serveJSON projectJSON $ method GET projectGetHandler)