summaryrefslogtreecommitdiff
path: root/fig-web/src/Fig/Web/Exchange.hs
diff options
context:
space:
mode:
Diffstat (limited to 'fig-web/src/Fig/Web/Exchange.hs')
-rw-r--r--fig-web/src/Fig/Web/Exchange.hs67
1 files changed, 0 insertions, 67 deletions
diff --git a/fig-web/src/Fig/Web/Exchange.hs b/fig-web/src/Fig/Web/Exchange.hs
deleted file mode 100644
index 264e73c..0000000
--- a/fig-web/src/Fig/Web/Exchange.hs
+++ /dev/null
@@ -1,67 +0,0 @@
-module Fig.Web.Exchange where
-
-import Control.Error.Util (hush)
-
-import qualified Database.Redis as Redis
-
-import Data.Maybe (mapMaybe)
-import qualified Data.Aeson as Aeson
-import qualified Data.Text.Read as Text.R
-import qualified Data.ByteString.Lazy as BS.Lazy
-import qualified Data.UUID as UUID
-import qualified Data.UUID.V4 as UUID
-
-import Fig.Prelude
-
-adjustUserCurrency :: Text -> Text -> Integer -> Redis.Redis ()
-adjustUserCurrency user cur amt = do
- let key = "currency:" <> encodeUtf8 user
- let ecur = encodeUtf8 cur
- mold <- hush <$> Redis.hget key ecur
- let old = case mold of
- Just (Just o) -> case Text.R.decimal $ decodeUtf8 o of
- Right (num, _) -> num
- _else -> 0
- _else -> 0
- void . Redis.hset key ecur . encodeUtf8 . tshow $ old + amt
-
-data Order = Order
- { creator :: !Text
- , wantCur :: !Text
- , wantAmount :: !Integer
- , haveCur :: !Text
- , haveAmount :: !Integer
- } deriving Generic
-instance Aeson.ToJSON Order
-instance Aeson.FromJSON Order
-
-createOrder :: MonadIO m => Redis.Connection -> Order -> m ByteString
-createOrder c o = liftIO $ Redis.runRedis c do
- let bs = Aeson.encode o
- uuid <- liftIO UUID.nextRandom
- let key = BS.Lazy.toStrict $ UUID.toByteString uuid
- void $ Redis.hset "orders" key (BS.Lazy.toStrict bs)
- pure key
-
-getOrders :: MonadIO m => Redis.Connection -> m [Order]
-getOrders c = liftIO $ Redis.runRedis c do
- Redis.hvals "orders" >>= \case
- Left _ -> pure []
- Right orders -> pure $ mapMaybe (Aeson.decode' . BS.Lazy.fromStrict) orders
-
-cancelOrder :: MonadIO m => Redis.Connection -> ByteString -> m ()
-cancelOrder c key = liftIO $ Redis.runRedis c do
- void $ Redis.hdel "orders" [key]
-
-satisfyOrder :: MonadIO m => Redis.Connection -> ByteString -> Text -> m ()
-satisfyOrder c key buyer = liftIO $ Redis.runRedis c do
- Redis.hget "orders" key >>= \case
- Right (Just bs) -> case Aeson.decode' $ BS.Lazy.fromStrict bs of
- Nothing -> pure ()
- Just (order :: Order) -> do
- adjustUserCurrency buyer order.wantCur (-order.wantAmount)
- adjustUserCurrency order.creator order.wantCur order.wantAmount
- adjustUserCurrency buyer order.haveCur order.haveAmount
- adjustUserCurrency order.creator order.haveCur (-order.haveAmount)
- _else -> pure ()
-