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 AuctionId
createAuction pid a = do
withProjectAuth pid (a ^. A.initiator) $ CreateAuction pid a
{-# LANGUAGE TemplateHaskell #-}
module Aftok.Project where
import ClassyPrelude
import Control.Lens (makeLenses, makePrisms)
import Data.ByteString.Base64.URL as B64
import Data.Thyme.Clock as C
import Data.UUID
import OpenSSL.Random
import Aftok
newtype ProjectId = ProjectId UUID deriving (Show, Eq)
makePrisms ''ProjectId
type ProjectName = Text
data Project = Project
{ _projectName :: ProjectName
, _inceptionDate :: C.UTCTime
, _initiator :: UserId
, _depf :: DepreciationFunction
}
makeLenses ''Project
newtype InvitationCode = InvitationCode ByteString deriving (Eq)
makePrisms ''InvitationCode
randomInvCode :: IO InvitationCode
randomInvCode = InvitationCode <$> randBytes 32
parseInvCode :: Text -> Either String InvitationCode
parseInvCode t = do
code <- B64.decode . encodeUtf8 $ t
if length code == 32
then Right $ InvitationCode code
else Left "Invitation code appears to be invalid."
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 ''Invitation
newtype ProjectId = ProjectId UUID deriving (Show, Eq)
makePrisms ''ProjectId
type ProjectName = Text
data Project = Project
{ _projectName :: ProjectName
, _inceptionDate :: C.UTCTime
, _initiator :: UserId
, _depf :: DepreciationFunction
}
makeLenses ''Project
newtype InvitationCode = InvitationCode ByteString deriving (Eq)
makePrisms ''InvitationCode
randomInvCode :: IO InvitationCode
randomInvCode = InvitationCode <$> randBytes 32
parseInvCode :: Text -> Either String InvitationCode
parseInvCode t = do
code <- B64.decode . encodeUtf8 $ t
if length code == 32
then Right $ InvitationCode code
else Left "Invitation code appears to be invalid."
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 ''Invitation
{-# LANGUAGE TemplateHaskell #-}
module Aftok.Snaplet.Auctions
( auctionCreateHandler
) where
import ClassyPrelude
import Data.Aeson
import Data.Aeson.Types
import Data.Thyme.Clock as C
--import Data.Thyme.Format.Aeson ()
import Aftok.Database (createAuction)
import Aftok.Auction (AuctionId, Auction(..))
import Aftok.Json
import Aftok.Types
import Aftok.Snaplet
import Aftok.Snaplet.Auth
import Snap.Snaplet
data AuctionCreateRequest = CA { raiseAmount :: Word64, auctionEnd :: C.UTCTime }
auctionCreateParser :: Value -> Parser AuctionCreateRequest
auctionCreateParser = unv1 "auctions" $ \v ->
case v of
(Object o) -> CA <$> o .: "raiseAmount"
<*> o .: "auctionEnd"
_ -> mzero
auctionCreateHandler :: Handler App App AuctionId
auctionCreateHandler = do
uid <- requireUserId
pid <- requireProjectId
requestBody <- readRequestJSON 4096
req <- either (snapError 400 . tshow) pure $ parseEither auctionCreateParser requestBody
--t <- liftIO C.getCurrentTime
snapEval . createAuction pid $ Auction uid (Satoshi . raiseAmount $ req) (auctionEnd req)