HALRDT2F22DAQ54M334YSKD2XJCAXDXEZPDKGMOWKH7XELBAS6MAC EKI57EJR65DA5FPILAHGHHAIU5ITVGHA6V3775OX7GV5XD67OWRQC 4U7F3CPIDTK6JSEDMNMHVKSR7HOQDLZQD2PPVMDLHO5SFSIMUXZAC 64C6AWH66FDKU6UE6Z6JPX2J2GBM2JOPTH2GL6LHKAIUBGNGDZ5AC KEP5WUFJXTMKRRNZLYTGYYWA4VLFCMHTKTJYF5EA5IWBYFMU6WYQC M4KM76DGO77VC4O6N5FFA5MTZH5GI5AJ3OUJU7INLAOY2M3LRLLAC NEDDHXUK3GNFMOFO3KLU7NRIHCTYNWBT3D6HTKZAOXFDE6HMDZ6AC LAROLAYUGJ4Q5AEFV5EJMIA2ZKBNCBWHHHPCJ3CKCNIUIYUKRFVQC IZEVQF627FA7VV25KJAWYWGGC35LZUUBBQRPN5ZAINTQLPEDRTEAC GCVQD44VRPQVKPZEPIC4AOIXLJIG2ZMV3QI2Y7KALUT6NVUBSGSAC 2XQD6KKKD6QVHFHAEMVE3XXY7X2T7BLTLL7XIILZAXNJJH2YONUQC QMRKFEPGFBCEWAIXPEIG5ILKAJ2JH5L3TOITHR4HNJXK5FN3KXBQC EKY7U7SKPF45OOUAHJBEQKXSUXWOHFBQFFVJWPBN5ARFJUFM2BPAC O5FVTOM6YFBLEPF3S576K6IMT6ZZ5VQCSB3YVXNS4CKBITKCRZ7AC NLZ3JXLOOIL37O3RRQWXHNPNSNEOOLPD6MCB754BEBECQB3KGR2AC W35DDBFYF6Z4ZPCFEO5RPAONZLYCSNTXUSTS6FIUUVZHCI6Q7GHAC NVOCQVASZWTKQJG7GPH7KHKZZR7NUG4WLV5YY4KAIRPCJRWCZPIAC Z7KS5XHHC6PAMTVBHXY7KUSS3BWAOU6FSYIITUCFOOJZU4OUJHBAC GKGVYBZGPJXO7N7GLHLRNYQPXFHBQSNQN53OKRFCXLQEYDTC5I4QC RPAJLHMTUJU4AYNBOHVGHGGB4NY2NLY3BVPYN5FMWB3ZIMAUQHCQC 6L5BK5EHPAOQX3JCKUJ273UDNAC23LPQL4HIJGM4AV3P3QK5OKIQC I2KHGVD44KT4MQJXGCTVSQKMBO6TVCY72F26TLXGWRL6PHGF6RNQC PBD7LZYQHXAA3KLH2ZUX5GW4UFML6BQ32KXZF4KZ6OYFASUYFJ5QC BROSTG5KP3NUNLSYPVQID254TE47E5RKQAKLPIY7PGWETE6JNMTAC ADMKQQGCGVSHHIMVQ4XFRDCG544SBJCYALSKZV45CQQBZ4ACUH2AC MGOF7IUFGXYQKZOKMM2GGULFFVAULEHLZDSHMUW6B5DBKVXXR74AC "INSERT INTO auctions (project_id, raise_amount, end_time) \\VALUES (?, ?, ?) RETURNING id"(pid ^. _ProjectId, auc ^. (raiseAmount.to fromSatoshi), auc ^. (auctionEnd.to fromThyme))
"INSERT INTO auctions (project_id, user_id, raise_amount, end_time) \\VALUES (?, ?, ?, ?) RETURNING id"( pid ^. _ProjectId, auc ^. (A.initiator . _UserId), auc ^. (raiseAmount.to fromSatoshi), auc ^. (auctionEnd.to fromThyme))
createAuction :: ProjectId -> Auction -> DBProg AuctionIdcreateAuction pid a = dowithProjectAuth pid (a ^. A.initiator) $ CreateAuction pid a
{-# LANGUAGE TemplateHaskell #-}module Aftok.Project whereimport ClassyPreludeimport Control.Lens (makeLenses, makePrisms)import Data.ByteString.Base64.URL as B64import Data.Thyme.Clock as Cimport Data.UUIDimport OpenSSL.Randomimport Aftoknewtype ProjectId = ProjectId UUID deriving (Show, Eq)makePrisms ''ProjectIdtype ProjectName = Textdata Project = Project{ _projectName :: ProjectName, _inceptionDate :: C.UTCTime, _initiator :: UserId, _depf :: DepreciationFunction}makeLenses ''Projectnewtype InvitationCode = InvitationCode ByteString deriving (Eq)makePrisms ''InvitationCoderandomInvCode :: IO InvitationCoderandomInvCode = InvitationCode <$> randBytes 32parseInvCode :: Text -> Either String InvitationCodeparseInvCode t = docode <- B64.decode . encodeUtf8 $ tif length code == 32then Right $ InvitationCode codeelse Left "Invitation code appears to be invalid."renderInvCode :: InvitationCode -> TextrenderInvCode (InvitationCode bs) = decodeUtf8 $ B64.encode bsdata Invitation = Invitation{ _projectId :: ProjectId, _invitingUser :: UserId, _invitedEmail :: Email, _invitationTime :: C.UTCTime, _acceptanceTime :: Maybe C.UTCTime}makeLenses ''Invitation
newtype ProjectId = ProjectId UUID deriving (Show, Eq)makePrisms ''ProjectIdtype ProjectName = Textdata Project = Project{ _projectName :: ProjectName, _inceptionDate :: C.UTCTime, _initiator :: UserId, _depf :: DepreciationFunction}makeLenses ''Projectnewtype InvitationCode = InvitationCode ByteString deriving (Eq)makePrisms ''InvitationCoderandomInvCode :: IO InvitationCoderandomInvCode = InvitationCode <$> randBytes 32parseInvCode :: Text -> Either String InvitationCodeparseInvCode t = docode <- B64.decode . encodeUtf8 $ tif length code == 32then Right $ InvitationCode codeelse Left "Invitation code appears to be invalid."renderInvCode :: InvitationCode -> TextrenderInvCode (InvitationCode bs) = decodeUtf8 $ B64.encode bsdata Invitation = Invitation{ _projectId :: ProjectId, _invitingUser :: UserId, _invitedEmail :: Email, _invitationTime :: C.UTCTime, _acceptanceTime :: Maybe C.UTCTime}makeLenses ''Invitation
{-# LANGUAGE TemplateHaskell #-}module Aftok.Snaplet.Auctions( auctionCreateHandler) whereimport ClassyPreludeimport Data.Aesonimport Data.Aeson.Typesimport Data.Thyme.Clock as C--import Data.Thyme.Format.Aeson ()import Aftok.Database (createAuction)import Aftok.Auction (AuctionId, Auction(..))import Aftok.Jsonimport Aftok.Typesimport Aftok.Snapletimport Aftok.Snaplet.Authimport Snap.Snapletdata AuctionCreateRequest = CA { raiseAmount :: Word64, auctionEnd :: C.UTCTime }auctionCreateParser :: Value -> Parser AuctionCreateRequestauctionCreateParser = unv1 "auctions" $ \v ->case v of(Object o) -> CA <$> o .: "raiseAmount"<*> o .: "auctionEnd"_ -> mzeroauctionCreateHandler :: Handler App App AuctionIdauctionCreateHandler = douid <- requireUserIdpid <- requireProjectIdrequestBody <- readRequestJSON 4096req <- either (snapError 400 . tshow) pure $ parseEither auctionCreateParser requestBody--t <- liftIO C.getCurrentTimesnapEval . createAuction pid $ Auction uid (Satoshi . raiseAmount $ req) (auctionEnd req)