Make Your Own Bitcoin Exchange in Haskell

-
A stock exchange is a complex beast, but much of it can be reduced to a single data structure: the Order Book. A Bitcoin exchange uses the same data structure when trading currency pairs of USD, BTC, or ETH. This article will show you how to:
  • Design an order book that can handle limit orders and market orders
  • Install automated sanity checks that run on every write to the order book, preventing hacks and implementation bugs
  • Build an HTTP API that people can use to interact with the order book
We won’t work with actual bitcoins or wallets, since they add a lot of complexity and risk without making the article any more interesting. Instead, we’ll assume the “billing code” has already been written and focus only on the order book portion of the exchange.

Types

So what is an order book, really?
First we’ll define our orders:
import Data.Tagged
import qualified Data.Map as M
import qualified Data.Sequence as Q

type UserId = Integer

type Currency = Text
type CurrencyPair = (Currency, Currency)
type Amount = Integer
type Price = Double

data LimitOrder = LimitOrder {
  _lorder_user         :: UserId,
  _lorder_fromAmount   :: Amount,
  _lorder_toAmount     :: Amount
  } deriving (Eq, Show, Generic)

data TBid
data TAsk

type BidT a = Tagged TBid a
type AskT a = Tagged TAsk a
type Bid = BidT LimitOrder
type Ask = AskT LimitOrder

data MarketOrder = MarketOrder {
  _morder_user   :: UserId,
  _morder_amount :: Amount
  } deriving (Eq, Show, Generic)

type MBid = BidT MarketOrder
type MAsk = AskT MarketOrder

data OrderBookF a = OrderBook {
  _book_fromCurrency :: Currency,
  _book_toCurrency   :: Currency,
  _book_bids         :: M.Map Price (Q.Seq (BidT a)),
  _book_asks         :: M.Map Price (Q.Seq (AskT a))
  } deriving (Eq, Show, Functor, Traversable, Foldable)
type OrderBook = OrderBookF LimitOrder
A couple points to note:
  • We use Seq rather than List or Vector because we need relatively efficient insert and search.
  • The higher order OrderBookF lets us get Traversable, Functor, and Foldableinstances to manipulate the order book without writing any code.
  • Both Bid and Asks are LimitOrders, but I want to track them separately in the type system. So I use Tagged to attach a TBid or TAsk tag.
The OrderBook by itself isn’t enough, because we want to track the final amounts actually transferred between buyers and sellers. Lets add a few types for that:
data SingleEntry = SingleEntry {
  _se_account  :: UserId,
  _se_currency :: Currency,
  _se_amount   :: Amount
  } deriving (Eq, Show, Generic)

data DoubleEntry = DoubleEntry {
  _de_fromAccount :: UserId,
  _de_toAccount   :: UserId,
  _de_currency    :: Currency,
  _de_amount      :: Amount
  } deriving (Eq, Show, Generic)

data TradeF a = Trade {
  _trade_from :: a,
  _trade_to   :: a
  } deriving (Eq, Show, Functor, Traversable, Foldable, Generic)
type Trade = TradeF DoubleEntry

data External
type ExternalTransfer = Tagged External SingleEntry
To “execute” an order causes it to turn into at least one Trade. There are 4 changes to users’ balances whenever a Trade occurs for the USD/BTC pair:
  • The buyer loses his USD
  • The seller gains USD
  • The buyer gains BTC
  • The seller loses BTC
It’s important to use “Double entry accounting” when handling money of any sort. By adding an entry to both sides whenever money changes hands, it’s much more resistant to bookkeeping errors. The total amount of USD and BTC should be zero-sum when transferred internally.
Some accounts are external to our exchange, such as USD held in bank accounts, or BTC held in wallets. In this example, I’ve chosen to eliminate the external account from the exchange’s view, giving us only single-entry bookkeeping for transfers outside the exchange. For accounting purposes, there should be a separate database where full double-entry financial data is held, and it should be routinely reconciled with the exchange, any bank accounts, and any wallets.
Administrators or billing code can create SingleEntry records when creating or destroying money supply in the exchange, while all users will create DoubleEntry records amongst each other.
Finally, here’s the global state that the exchange is going to keep:
data Exchange = Exchange {
  _exchange_external :: TVar (Q.Seq ExternalTransfer),
  _exchange_book     :: TVar OrderBook,
  _exchange_trades   :: TVar (Q.Seq Trade)
  }
In words: An Exchange is a collection of external transfers that move money in and out of the system, an order book for a single currency pair full of orders waiting to be filled, and the history of previous trades.
This exchange has no trading fees. Those would go on either the Trade or External types, depending on whether we charge people for internal or external transfers.

Order book

What are the fundamental operations we need to use our order book? We want to:
  • Add an order to the book, automatically executing trades if able.
  • Cancel an order from the book
  • List all outstanding orders on the order book
Once we have these, we’ll wrap it in an HTTP API that can be used by scripts or a website to interact with the order book.
I’ll only look at the Bid limit and market orders for now - the Ask versions are very similar. Here are the types for the functions we need:
cancelBid :: Bid -> OrderBook -> OrderBook
fillBid :: Bid -> OrderBook -> ([Trade], OrderBook)
tryFillMBid :: MBid -> Balances -> OrderBook -> (Maybe MBid, [Trade], OrderBook)
listOrders :: OrderBook -> [LimitOrder]
listOrders = toList
Since the generated Foldable instance does listOrders for us, I went ahead and implemented it. I’ll leave the implementation of cancelBid on Github.
For fillBid and tryFillMBid, we’ll write one suitably-generic function for limit orders, and say that a MarketOrder is a LimitOrder that can’t be persisted in the order book, and where the user bids his entire account balance:
fillBid :: Bid -> OrderBook -> ([Trade], OrderBook)
fillBid bid book = case matchBid bid book of
  (Nothing, trades, book) ->
    (trades, book)
  (Just bidRemainder, trades, book) ->
    (trades, unsafe_addBid bidRemainder book)

tryFillMBid :: MBid -> Balances -> OrderBook -> (Maybe MBid, [Trade], OrderBook)
tryFillMBid mbid bals book@OrderBook{..} =
  case M.lookup _book_toCurrency bals of
    Nothing -> (Nothing, [], book)
    Just toBalance ->
      -- A Market order is a non-persistable limit order with the user bidding his entire balance.
      let (Tagged MarketOrder{..}) = mbid
          bid = Tagged $ LimitOrder {
            _lorder_user = _morder_user,
            _lorder_fromAmount = _morder_amount,
            _lorder_toAmount = toBalance
            }
      in case matchBid bid book of
        (Nothing, trades, book) ->
          (Nothing, trades, book)
        (Just bid, trades, book) ->
          (Just $ bidToMbid bid, trades, book)

bidToMBid :: Bid -> MBid
unsafe_addBid :: Ask -> OrderBook -> OrderBook
Our generic matchBid function attempts to fill a limit order on the OrderBook and returns a new Bid for whatever couldn’t be matched, any Trades that were executed, and the new OrderBook:
matchBid :: Bid -> OrderBook -> (Maybe Bid, [Trade], OrderBook)
matchBid bid book =
  let pair = _book_pair book
      loop :: (Bid, [Trade], OrderBook) -> (Maybe Bid, [Trade], OrderBook)
      loop x@(bid, trades, book) =
        case lowestAsk book of
          -- Case 1: The order book has no asks
          (Nothing, _) -> (Just bid, [], book)
          (Just lowestAsk, deletedBook) ->
            case mergeBid pair bid lowestAsk of
              -- Case 2: The bid was unable to be matched
              (Just bid, Just _, Nothing) -> (Just bid, trades, book)
              -- Case 3: The bid was partially matched; repeat the loop
              (Just bidRemainder, Nothing, Just trade) ->
                loop (bidRemainder, trade:trades, deletedBook)
              -- Case 4: The ask was partially matched; terminate the loop.
              (Nothing, Just askRemainder, Just trade) ->
                (Nothing, trade:trades, unsafe_addAsk askRemainder deletedBook)
              -- Case 5: The bid and ask exactly canceled each other out
              (Nothing, Nothing, Just trade) ->
                (Nothing, trade:trades, deletedBook)
              -- Case 6: Impossible cases
              x -> panic $ "fillBid: Unexpected case: " <> show x
  in loop (bid, [], book)

mergeBid :: CurrencyPair -> Bid -> Ask -> (Maybe Bid, Maybe Ask, Maybe Trade)

lowestAsk :: OrderBook -> (Maybe Ask, OrderBook)

unsafe_addAsk :: Ask -> OrderBook -> OrderBook
Here, we repeatedly find the best price Ask on the order book, use it to fill our Bid, and stop when we run out of qualifying Asks.
lowestAsk is pretty easy since our Map is sorted by price. I’ll define it and unsafe_addAsk in the Github repository.
mergeBid is probably the most complex, since it handles 3 distinct things:
  • It generates new orders if either the bid or ask were partially filled
  • It generates a trade if the bid crosses the ask
  • It handles the calculations determining these
mergeBid :: CurrencyPair -> Bid -> Ask -> (Maybe Bid, Maybe Ask, Maybe Trade)
mergeBid (fromCurrency, toCurrency) bid ask =
  let bidOrder = unTagged bid
      askOrder = unTagged ask
      n1 = _lorder_fromAmount bidOrder
      d1 = _lorder_toAmount bidOrder
      n2 = negate $ _lorder_fromAmount askOrder
      d2 = _lorder_toAmount askOrder
      buyer = _lorder_user bidOrder
      seller = _lorder_user askOrder
      fi = fromIntegral
      -- If seller rounds down, price would be below his limit.
      sellerPrice = ceiling (fi n2 / fi d2)
      -- If buyer rounds up, price would be above his limit.
      buyerPrice = floor (fi n1 / fi d1)

      unitPrice = buyerPrice
      numUnits = min n1 n2
      toAmount = ceiling (fi numUnits / fi unitPrice)
      fromTransfer = DoubleEntry {
        _de_fromAccount = seller,
        _de_toAccount   = buyer,
        _de_amount      = numUnits,
        _de_currency    = fromCurrency
        }
      toTransfer = DoubleEntry {
        _de_fromAccount = buyer,
        _de_toAccount   = seller,
        _de_amount      = toAmount,
        _de_currency    = toCurrency
        }
      trade = Trade fromTransfer toTransfer
      (mNewBid, mNewAsk) = case d1 `compare` d2 of
        -- Case 1: Buyer is done; seller still has inventory
        LT -> let newAsk = Tagged $ LimitOrder {
                    _lorder_user       = seller,
                    _lorder_fromAmount = n2 - numUnits,
                    _lorder_toAmount   = sellerPrice
                    }
              in (Nothing, Just newAsk)
        -- Case 2: Seller is out; buyer needs more
        GT -> let newBid = Tagged $ LimitOrder {
                    _lorder_user       = buyer,
                    _lorder_fromAmount = n1 - numUnits,
                    _lorder_toAmount   = buyerPrice
                    }
              in (Just newBid, Nothing)
        -- Case 3: Buyer and seller exactly traded
        EQ -> (Nothing, Nothing)
  in if buyerPrice >= sellerPrice
     -- Bid has crossed the ask, so we can generate a trade.
     then (mNewBid, mNewAsk, Just trade)
     -- Bid is less than ask, so they can't be merged.
     else (Just bid, Just ask, Nothing)
mergeBid is subtle enough that you probably don’t feel comfortable trusting its implementation based on visual inspection alone. In the next section, we’ll install automated sanity checks on every write so that any implementation bugs will be blocked.

Security

How do we stop our exchange from losing money when we inevitably get hacked?
The most important things to secure are the actual Bitcoin or Ethereum wallets our exchange has. Luckily, we avoided that issue by not having any wallets.
The second most important thing is to have append-only backups that we can roll back to if we detect a hack. That’s not ideal, because we still have to tell all of our customers we got hacked.
The third most important thing is to avoid losing the money in the first place.
In my last article, I showed how you can use theorem provers to formally prove that certain properties hold regarding your data structures. We can’t quite do that in Haskell, but let me define a few invariants for you anyways and I’ll show you a trick.

Invariants

Here are our invariants in words:
  • Users can’t trade with themselves
  • Users can’t have negative balances
  • Users can’t have more money in pending trades than they have in their account.
  • Users and OrderBooks can’t have currencies that don’t exist
And here they are in code:
  • Users can’t trade with themselves
type ConsistencyCheck = Exchange -> STM Bool

consistency_noSelfTrades :: ConsistencyCheck
consistency_noSelfTrades = \exchange -> do
  trades <- readTVar $ _exchange_trades exchange
  return $ all checkTrade trades
  where
    checkDe DoubleEntry{..} = _de_fromAccount /= _de_toAccount
    checkTrade Trade{..} = checkDe _trade_from && checkDe _trade_to
  • Users can’t have negative balances
consistency_noNegativeBalances :: ConsistencyCheck
consistency_noNegativeBalances = \exchange -> do
  bals <- userBalances exchange
  let checkUser (userId, balances) =
        flip all (M.toList balances) $ \(currency, balance) ->
        if balance >= 0
        then True
        else error $ "Negative balance for " <> show (userId, currency, balance)
  return $ all checkUser $ M.toList bals

userBalances :: Exchange -> STM (M.Map UserId Balances)
userBalances = undefined
  • Users can’t have more money in pending trades than they have in their account.
consistency_ordersBackedByAccount :: ConsistencyCheck
consistency_ordersBackedByAccount = \exchange -> do
  usersBals <- userBalances exchange

  let checkUserBalance :: Balances -> (Currency, Amount) -> Bool
      checkUserBalance userBals (currency, bookAmount) =
        case M.lookup currency userBals of
          Nothing -> False
          Just userAmount -> userAmount >= bookAmount

  let checkUser :: (UserId, Balances) -> STM Bool
      checkUser (user, userBals) = do
        bookBals <- userBookBalances exchange user
        let currenciesPending = M.toList bookBals
        return $ all (checkUserBalance userBals) currenciesPending
  allM checkUser $ M.toList usersBals

userBookBalances :: Exchange -> UserId -> STM Balances
userBookBalances = undefined
  • Users and OrderBooks can’t have nonexistent currencies
consistency_allCurrenciesExist :: ConsistencyCheck
consistency_allCurrenciesExist = \exchange -> do
  usersBals <- userBalances exchange
  bookBals <- bookBalances exchange
  let valid currency = currency `elem` allCurrencies
      checkBals bals = all valid $ M.keys bals
      usersCheck = all checkBals usersBals
      booksCheck = all valid $ M.keys bookBals
  return $ usersCheck && booksCheck

bookBalances :: Exchange -> STM Balances
bookBalances = undefined
As long as those functions always return true, we can have some confidence in the rest of our code.
userBalances, bookBalances, and userBookBalances roll up the trades and external transfers to get a final balance. I’ll leave their implementation in the Github repository.

The Trick

People often use triggers or constraints in relational databases to automatically enforce invariants. Using Haskell’s Software Transactional Memory library, we can do something similar:
installSanityChecks :: Exchange -> IO ()
installSanityChecks exchange =
  atomically $ mapM_ installCheck [
    (consistency_noNegativeBalances, "No negative balances"),
    (consistency_ordersBackedByAccount, "Orders must be backed by account"),
    (consistency_allCurrenciesExist, "Non-existent currency"),
    (consistency_noSelfTrades, "Users cannot trade with themselves")
    ]
  where
    installCheck (check, message) = alwaysSucceeds $ do
      b <- check exchange
      if b
        then return ()
        else error message
atomically enters a “transaction” in the STM sense. It’s designed as an efficient way to allow multiple threads to concurrently update a shared data structure. Transactions can abort and retry if there are concurrent updates to the same variable. We can also abort if one of our sanity checks fails.
The alwaysSucceed function will run the sanity check once, and if it passes run it after every transaction afterwards. It will roll back the transaction with an exception if the sanity check fails with an exception.
We’ll call installSanityChecks near the start of our program, after we initialize or load our exchange’s state. Then every write will be automatically sanity-checked and rolled back with an exception. Our HTTP library warp will catch the exception and abort the request.

Networking

We want 5 API endpoints:
  • List orders
  • Cancel an order
  • Add an order
  • Create money on the exchange
  • List balances
Here are the request types:
data Request_ListOrders = Request_ListOrders {
  _reqListOrders_user :: Maybe UserId
  } deriving (Eq, Show, Generic)

data Request_CancelOrder = Request_CancelBid {
  _reqCancelOrder_bid :: Bid
  } | Request_CancelAsk {
  _reqCancelOrder_ask :: Ask
  } deriving (Eq, Show, Generic)

data Request_AddOrder = Request_AddBid {
  _reqAddOrder_bid :: Bid
  } | Request_AddAsk {
  _reqAddOrder_ask :: Ask
  } | Request_AddMBid {
  _reqAddOrder_mbid :: MBid
  } | Request_AddMAsk {
  _reqAddOrder_mask :: MAsk
  } deriving (Eq, Show, Generic)

data Request_CreateMoney = Request_CreateMoney {
  _reqCreateMoney_singleEntry :: SingleEntry
  } deriving (Eq, Show, Generic)

data Request_ListBalances = Request_ListBalances deriving (Eq, Show, Generic)
And the response types:
data Response_ListOrders = Response_ListOrders {
  _resListOrders_orders :: [LimitOrder]
  } deriving (Eq, Show, Generic)

data Response_CancelOrder = Response_CancelOrder deriving (Eq, Show, Generic)
data Response_AddOrder = Response_AddBid {
  _resAddOrder_trades :: [Trade]  
  } | Response_AddAsk {
  _resAddOrder_trades :: [Trade]
  } | Response_AddMBid {
  _resAddOrder_mbidRemainder :: Maybe MBid,
  _resAddOrder_trades        :: [Trade]
  } | Response_AddMAsk {
  _resAddOrder_maskRemainder :: Maybe MAsk,
  _resAddOrder_trades        :: [Trade]
  } deriving (Eq, Show, Generic)

data Response_CreateMoney = Response_CreateMoney deriving (Eq, Show, Generic)

data Response_ListBalances = Response_ListBalances {
  _resListBalances_externals :: [(UserId, Currency, Amount)],
  _resListBalances_internals :: [(UserId, Currency, Amount)],
  _resListBalances_helds     :: [(UserId, Currency, Amount)],
  _resListBalances_totalBals :: [(UserId, Currency, Amount)],
  _resListBalances_bookBals  :: [(Currency, Amount)]
  } deriving (Eq, Show, Generic)
Anyone that wants to interact with our exchange will end up creating a Request and receive an appropriate Response. Here is the actual entrypoint to the server:
import Network.Wai as W
import Network.Wai.Handler.Warp
import Network.HTTP.Types.Method
import Network.HTTP.Types.Status

le_port = 2345

serverMain :: IO ()
serverMain = do
  state <- initialize
  installSanityChecks state
  putStrLn $ "Listening on " ++ show le_port
  run le_port $ \req respond ->
    let ?req = req
        ?respond = respond
        ?state = state
    in do
      print req
      body <- strictRequestBody req
      case (pathInfo req, requestMethod req) of
        ("createMoney" : _, "POST") -> withParsedRequest body api_createMoney
        ("listOrders" : _,  "POST") -> withParsedRequest body api_listOrders
        ("addOrder" : _,    "POST") -> withParsedRequest body api_addOrder
        ("cancelOrder" : _, "POST") -> withParsedRequest body api_cancelOrder
        ("listBalances" : _, "POST") -> withParsedRequest body api_listBalances
        _ -> respond (W.responseLBS status404 [] "Unknown path")

initialize :: IO Exchange
initialize = Exchange <$> newTVarIO Q.empty <*> newTVarIO (newBook ("USD", "BTC")) <*> newTVarIO Q.empty

type HandlerT a = (?req :: Request, ?respond :: (Response -> IO ResponseReceived), ?state :: Exchange) => a -> IO ResponseReceived

withParsedRequest :: FromJSON a => BSL.ByteString -> HandlerT (a -> IO ResponseReceived)
withParsedRequest bs handler = case decode bs of
  Nothing -> ?respond (W.responseLBS status400 [] "Unable to parse")
  Just x -> handler x
And here’s how to implement one of our handlers:
api_listOrders :: HandlerT Request_ListOrders
api_listOrders _ = do
  let Exchange{..} = ?state
  book <- readTVarIO _exchange_book
  ?respond $ W.responseLBS status200 [] $ encode $ Response_ListOrders $ toList book
I’ve also included JSON serializers and deserializers in the Github repository.

Testing

How do we actually end-to-end test our Bitcoin exchange?
The first step is to print one of your request values to get its corresponding JSON:
print $ encode $ Request_AddBid $ Tagged $ LimitOrder {
    _lorder_user = 1
    _lorder_fromAmount = 4600,
    _lorder_toAmount = 1
    }
The second step is to use a shell script to send that JSON to the server:
cat <<'EOF' | curl localhost:2345/addOrder -XPOST -d @-
{
  "bid":{
    "toAmount":1,
    "user":1,
    "fromAmount":4600
  },
  "tag":"Request_AddBid"
}
EOF
At this point, you can use any combination of the 5 endpoints to change or inspect the exchange’s state.

Conclusion

We showed how you can implement a simple order book in Haskell, which can be the basis of a full-blown Bitcoin exchange. Future articles may cover:
  • Writing the order book in C for efficiency, and using that in the larger Haskell program.
  • Writing a program that watches for actual Bitcoin to be sent, so money can enter our exchange.
  • Using unit tests to validate the order book implementation.
  • Adding multiple currency pairs to the exchange.
  • Adding authentication, so users won’t have unrestricted access to the exchange.

Comments

Post a Comment

Popular posts from this blog

.NET API

-
autorest  - Swagger (OpenAPI) Specification code generator featuring C# and Razor templates. Supports C#, Java, Node.js, TypeScript, Python and Ruby.  4.5.x or above Flurl  - Fluent URL builder and testable HTTP for .NET  http://tmenier.github.io/Flurl . LightNode  - Micro RPC/REST Framework built on OWIN  http://neuecc.github.io/LightNode . NSwag  - The Swagger API toolchain for .NET, Web API and TypeScript  http://NSwag.org . refit  - The automatic type-safe REST library for Xamarin and .NET  http://paulcbetts.github.io/refit/ . RESTClient .NET  - Simple REST Client for all .NET platforms. RestEase  - Easy-to-use typesafe REST API client library, which is simple and customisable. Swashbuckle  - Seamlessly adds a swagger to WebApi projects. WebAPIContrib for ASP.NET CORE  - Community Contributions for ASP.NET Core. GraphQL graphql-dotnetcore  - GraphQL for .NET Core based on  https://github.com/g...
Read more

How to Write a Shell in C

-
It’s easy to view yourself as “not a  real  programmer.” There are programs out there that everyone uses, and it’s easy to put their developers on a pedestal. Although developing large software projects isn’t easy, many times the basic idea of that software is quite simple. Implementing it yourself is a fun way to show that you have what it takes to be a real programmer. So, this is a walkthrough on how I wrote my own simplistic Unix shell in C, in the hopes that it makes other people feel that way too. The code for the shell described here, dubbed  lsh , is available on  GitHub . University students beware!  Many classes have assignments that ask you to write a shell, and some faculty are aware of this tutorial and code. If you’re a student in such a class, you shouldn’t copy (or copy then modify) this code without permission. And even then, I would  advise  against heavily relying on this tutorial. Basic lifetime of a shell Let’s look at a s...
Read more

.NET Sample Projects

-
AlbumViewerVNext  - West Wind Album Viewer ASP.NET 5 Sample. allReady  - Open-source solution focused on increasing awareness, efficiency and impact of preparedness campaigns as they are delivered by humanitarian and disaster response organizations in local communities.  http://www.htbox.org/projects/allready AspNet5GeoElasticsearch  - ASP.NET Core MVC Geo Elasticsearch Swashbuckle Swagger. aspnet-servicediscovery-patterns  - Samples of implementing Service Discovery patterns with ASP.NET Core. cloudscribe  - ASP.NET Core Multi-tenant web application foundation. distributed-playground  - Distributed service playground with Vagrant, Consul, Docker & ASP.NET Core. DotNetClub  - Tiny club written in ASP.NET Core. Entropy  - Chaotic experimental playground for new features and ideas - check here for small and simple samples for individual features. guidance-identity-management-for-multitenant-apps  - How to manage user identitie...
Read more