POX3UAMTGCNS3SU5I6IKDNCCSHEAUSFBZ3WCMQ3EXKPNXETOI6BAC
373LXH2XPXZJYSC4NJGWC7ZX3MBAPNMRQFKOWNB7T2XUHUKSZY2AC
ASF3UPJLCX7KIUCNJD5KAXSPDXCUEJHLL4HBRTRUBPCW73IXOCWQC
A6HKMINBNGQLLX4QJMYWKQ4JAEHVJ4HIRVDKPPDI3FJUO2AAB7OQC
EZQG2APB36DDMIAYDPPDGOIXOD7K2RZZSGC2NKGZIHB2HZBTW7EQC
AVDFWICBJ3QNP3Z3I6OQ6GB6T3SG7K64LF6B4CDGISTE3QBFYP3QC
2XQD6KKKD6QVHFHAEMVE3XXY7X2T7BLTLL7XIILZAXNJJH2YONUQC
7KZP4RHZ3QSYTPPQ257A65Z5UPX44TF2LAI2U5EMULQCLDCEUK2AC
64C6AWH66FDKU6UE6Z6JPX2J2GBM2JOPTH2GL6LHKAIUBGNGDZ5AC
NLZ3JXLOOIL37O3RRQWXHNPNSNEOOLPD6MCB754BEBECQB3KGR2AC
W35DDBFYF6Z4ZPCFEO5RPAONZLYCSNTXUSTS6FIUUVZHCI6Q7GHAC
GCVQD44VRPQVKPZEPIC4AOIXLJIG2ZMV3QI2Y7KALUT6NVUBSGSAC
Z7KS5XHHC6PAMTVBHXY7KUSS3BWAOU6FSYIITUCFOOJZU4OUJHBAC
O5FVTOM6YFBLEPF3S576K6IMT6ZZ5VQCSB3YVXNS4CKBITKCRZ7AC
7HPY3QPFPN35PSPUBVNW2GTFB3CBQZBST4J2BAVJ7QMXLIUN52JAC
RPAJLHMTUJU4AYNBOHVGHGGB4NY2NLY3BVPYN5FMWB3ZIMAUQHCQC
HALRDT2F22DAQ54M334YSKD2XJCAXDXEZPDKGMOWKH7XELBAS6MAC
4U7F3CPIDTK6JSEDMNMHVKSR7HOQDLZQD2PPVMDLHO5SFSIMUXZAC
NVOCQVASZWTKQJG7GPH7KHKZZR7NUG4WLV5YY4KAIRPCJRWCZPIAC
NEDDHXUK3GNFMOFO3KLU7NRIHCTYNWBT3D6HTKZAOXFDE6HMDZ6AC
KNSI575VAW6HRCZYXOEPQ4DTSML4EORML5MV4DJBRKE7TXCPS4EAC
TLQ72DSJD7GGPWN6HGBHAVPBRQFKEQ6KSK43U7JWWID4ZWAF47JAC
SCXG6TJWYIPRUMT27KGKIIF6FYKTUTY74UNZ2FQTT63XZ6HIF3AAC
5DRIWGLUKMQZU2ZPBXSTLAWJKAMOD5YXAHM5LEDQHDFGYYLHWCDQC
QMRKFEPGFBCEWAIXPEIG5ILKAJ2JH5L3TOITHR4HNJXK5FN3KXBQC
unv1 name f v =
let p (Version 1 0) = f
p ver = const . fail $ "Unrecognized " <> name <> " schema version: " <> show ver
in unversion p v
unv1 name f = unversion $ \x -> case x of
Version 1 0 -> f
_ -> badVersion name x
badVersion :: String -> Version -> Value -> Parser a
badVersion name ver = const . fail $ "Unrecognized " <> name <> " schema version: " <> show ver
creditToJSON :: CreditTo -> Value
creditToJSON (CreditToAddress addr) = v2 $ object [ "creditToAddress" .= addr ]
creditToJSON (CreditToUser uid) = v2 $ object [ "creditToUser" .= (uid ^. _UserId) ]
creditToJSON (CreditToProject pid) = v2 $ object [ "creditToProject" .= projectIdJSON pid ]
workIndexJSON :: WorkIndex -> Value
workIndexJSON (WorkIndex widx) = v1 $
toJSON $ (L.toList . fmap intervalJSON) <$> MS.mapKeysMonotonic (^._BtcAddr) widx
workIndexJSONV1 :: WorkIndex -> Value
workIndexJSONV1 (WorkIndex widx) = v1 $
toJSON $ (L.toList . fmap intervalJSON) <$>
MS.mapKeysMonotonic (^? (_CreditToAddress._BtcAddr)) widx
parseEventAmendment t =
let parseA x "timeChange" = TimeChange t <$> x .: "eventTime"
parseA x "addrChage" = do
addrText <- x .: "btcAddr"
maybe
(fail $ show addrText <> "is not a valid BTC address")
(pure . AddressChange t)
$ parseBtcAddr addrText
parseA x "metadataChange" =
MetadataChange t <$> x .: "eventMeta"
parseA _ other =
fail $ "Amendment value " <> other <> " not recognized."
parseEventAmendment t = unversion $ \v -> case v of
Version 1 0 -> parseEventAmendmentV1 t
Version 2 0 -> parseEventAmendmentV2 t
_ -> badVersion "EventAmendment" v
parseEventAmendmentV1 :: ModTime -> Value -> Parser EventAmendment
parseEventAmendmentV1 t v@(Object x) =
let parseA :: Text -> Parser EventAmendment
parseA "timeChange" = TimeChange t <$> x .: "eventTime"
parseA "addrChange" = CreditToChange t <$> parseCreditTo v
parseA "metadataChange" = MetadataChange t <$> x .: "eventMeta"
parseA id = fail . show $ "Amendment type " <> id <> " not recognized."
in x .: "amendment" >>= parseA
parseEventAmendmentV1 t x =
fail $ "Value " <> show x <> " is not a JSON object."
parseEventAmendmentV2 :: ModTime -> Value -> Parser EventAmendment
parseEventAmendmentV2 t v@(Object x) =
let parseA :: Text -> Parser EventAmendment
parseA "timeChange" = TimeChange t <$> x .: "eventTime"
parseA "creditToChange" = CreditToChange t <$> parseCreditTo v
parseA "metadataChange" = MetadataChange t <$> x .: "eventMeta"
parseA id = fail . show $ "Amendment type " <> id <> " not recognized."
in x .: "amendment" >>= parseA
parseEventAmendmentV2 t x =
fail $ "Value " <> show x <> " is not a JSON object."
parseBtcAddrJson :: Value -> Parser BtcAddr
parseBtcAddrJson v = do
t <- parseJSON v
maybe (fail $ show t <> " is not a valid BTC address") pure $ parseBtcAddr t
p (Object x) = x .: "amendment" >>= parseA x
p x = fail $ "Value " <> show x <> " missing 'amendment' field."
in unv1 "amendment" p
parseCreditTo :: Value -> Parser CreditTo
parseCreditTo = unversion $ \x -> case x of
Version 1 0 -> withObject "BtcAddr" parseCreditToV1
Version 2 0 -> withObject "CreditTo" parseCreditToV2
_ -> badVersion "EventAmendment" x
parseCreditToV1 :: Object -> Parser CreditTo
parseCreditToV1 x = CreditToAddress <$> (parseBtcAddrJson =<< (x .: "btcAddr"))
parseCreditToV2 :: Object -> Parser CreditTo
parseCreditToV2 x =
let parseCreditToAddr (Object x') = do
addrText <- O.lookup "creditToAddress" x'
pure (CreditToAddress <$> parseBtcAddrJson addrText)
parseCreditToAddr x' = Nothing
parseCreditToUser (Object x') = Nothing
parseCreditToUser x' = Nothing
parseCreditToProject (Object x') = Nothing
parseCreditToProject x' = Nothing
notFound = fail $ "Value " <> show x <> " does not represent a CreditTo value."
parseV v = (parseCreditToAddr v <|> parseCreditToUser v <|> parseCreditToProject v)
in do
body <- x .: "creditTo"
fromMaybe notFound $ parseV body
( LogEntry(..)
, btcAddr, event, eventMeta
, LogEvent(..)
, eventName, nameEvent, eventTime
( LogEntry(..), creditTo, event, eventMeta
, CreditTo(..), _CreditToAddress, _CreditToUser, _CreditToProject
, LogEvent(..), eventName, nameEvent, eventTime
data CreditTo
-- payouts are made directly to this address, or to an address replacing this one
= CreditToAddress BtcAddr
-- payouts are distributed as requested by the specified contributor
| CreditToUser UserId
-- payouts are distributed to this project's contributors
| CreditToProject ProjectId
deriving (Show, Eq, Ord)
makePrisms ''CreditTo