2019-lambdaconf-haskell.org

Haskell in Production: Adventures in Blockchain Building

Preamble

Self-introduction

Hi, I’m Colin from Canada.

Haskell Developer at Kadena.

@fosskers on Github, Twitter, etc.

Writing FOSS Haskell since 2011.

This presentation uses patat by Jasper Van der Jeugt.

Overview

What are we doing?

• The Choice of Haskell
• Fast-feedback Development Environments
• Design Choices (a.k.a. “do you really need an App Monad?”)
• Deploying Haskell Software

…

What ought we (all) do?

• Beauty, Correctness, and Good Technique
• Laws and Principles
• Little-known Idioms / Libraries / Functions

Choosing our Software Stack

Requirements

Our technical questions were:

Is there a language that lets us:

• write fast web servers with long uptimes?
• write new languages easily? (i.e. Pact, our smart contract language)
• reuse backend code on the frontend, for a Web REPL? (https://pact.kadena.io/)

…

Our business questions were:

• Will the code be damn correct?
• How much will we have to reinvent the wheel?

…

Our human question was:

• Will the language and its tools fulfill our developers?

Dev Environment

Project Configuration

chainweb.cabal file for project definition, default.nix for CI / deployment. stack.yaml and cabal.project for daily dev.

…

Cabal >= 2.2 (with common stanzas)

common warning-flags
    ghc-options:
        -Wall
        -Werror
        -Wcompat
        -Wincomplete-record-updates
        -Wincomplete-uni-patterns
        -Widentities
        -Wpartial-fields

…

chainweb.cabal has distinct library and executable sections.

…

All peripheral binaries are merged into one to reduce link time and binary sizes.

Editors and Build Tools

Editor of Choice: Emacs / Spacemacs

Feedback Mechanism: ghcid

Design Choices

The Tree of Library Choices

Concern	Library
Prelude	Prelude from base
Testing	tasty + QuickCheck
Streaming	streaming
Binary Encoding	cereal + bytes
Lenses	lens w/ named functions
Web Server	servant
Web Client	servant-client
CLI Flags	configuration-tools
Logging	yet-another-logger

Other Questions

Monad Transformer stack? Extensible Effects? RIO?

Plain IO everywhere. Exceptions are thrown through IO.

…

What do you auto-generate?

We generate our Lenses with Template Haskell, but hand-write all our Aeson instances.

…

How is your app configured?

Automatic YAML support via configuration-tools.

Deployment

NixOS and AWS

We use NixOS, but no nixops.

CI builds binaries with Nix and caches, remote machines pull from cache.

The machines themselves are managed by Terraform.

Beauty, Correctness, and Good Technique

Good Technique

Good technique is that which maximizes the harmony between Beauty and Correctness.

Philosophy: The Law of God’s One-Liner

For any piece of code, there exists a refactor which approaches a one-liner.

…

Corollary:

If you cannot find the refactor, there is a mistake in your design. Solving the mistake will unlock the refactor.

Philosophy: The Principle of Perfect Input

Instead of writing this…

data PriceHistory = ...

shouldIBuyBitcoin :: Maybe PriceHistory -> IO Bool

…

Write this!

shouldIBuyBitcoin :: PriceHistory -> IO Bool

Philosophy: The Principle of Perfect Input (continued)

Instead of writing this…

petTheCat :: [Cat] -> IO ()
petTheCat [] = ...  -- Should I throw?
petTheCat (cat:_) = f cat

…

Write this!

import Data.List.NonEmpty (NonEmpty(..))

petTheCat :: NonEmpty Cat -> IO ()
petTheCat (cat :| _) = f cat

…

We can go further with nonempty-containers , which provides NESet, NEMap, and NESeq.

class Foldable t => Foldable1 t where
  foldMap1 :: Semigroup m => (a -> m) -> t a -> m

Quality-of-Life Libraries

Quality-of-Life Library: base-prelude

Written by Nikita Volkov. Only depends on base.

{-# LANGUAGE NoImplicitPrelude #-}

import BasePrelude

Quality-of-Life Library: errors

comeOnSimonWhereIsThis :: Either a b -> Maybe b

…

With errors by Gabriel Gonzales:

hush  :: Either a b -> Maybe b
hushT :: Monad m => ExceptT a m b -> MaybeT m b

note  :: a -> Maybe b -> Either a b
noteT :: Monad m => a -> MaybeT m b -> ExceptT a m b

hoistMaybe  :: Monad m => Maybe b -> MaybeT m b
hoistEither :: Monad m => Either e a -> ExceptT e m a

failWith :: Applicative m => e -> Maybe a -> ExceptT e m a

Quality-of-Life Library: witherable and compactable

Recall these from base:

mapMaybe :: (a -> Maybe b) -> [a] -> [b]
catMaybes :: [Maybe a] -> [a]
partitionEithers :: [Either a b] -> ([a], [b])

…

From witherable by Kinoshita Fumiaki:

wither :: Applicative f => (a -> f (Maybe b)) -> t a -> f (t b)

…

From compactable by Isaac Shapira:

fmapEither :: Functor t => (a -> Either l r) -> t a -> (t l, t r)

traverseEither :: (Applicative f, Traversable t) =>
  (a -> f (Either l r)) -> t a -> f (t l, t r)

Quality-of-Life Library: scheduler

Recall this from async:

-- This starts a thread for every item in `t`!
mapConcurrently :: Traversable t => (a -> IO b) -> t a -> IO (t b)

…

From scheduler by Alexey Kuleschevich:

-- Also exposed are patterns `Par` and `Par'` which automatically use all
-- available cores.
data Comp = Seq | ParOn [Int] | ParN Word16

-- Like `mapConcurrently`, item order is preserved.
traverseConcurrently :: Traversable t => Comp -> (a -> IO b) -> t a -> IO (t b)

Quality-of-Life Library: generic-lens

Recall a common pattern for generating lenses:

{-# LANGUAGE TemplateHaskell #-}

data Cat = Cat { _name :: Text, _age :: Word, _money :: Double }
makeLenses ''Cat

…

>>> let jack = Cat "Jack" 6 10.0

>>> jack ^. name
"Jack"

>>> jack & money += 5.0
Cat "Jack" 6 15.0

Quality-of-Life Library: generic-lens (continued)

With generic-lens written by Csongor Kiss:

{-# LANGUAGE DeriveGeneric  #-}

data Cat = Cat { name :: Text, age :: Word, money :: Double } deriving (Generic)

…

>>> let jack = Cat "Jack" 6 10.0

>>> jack ^. field @"name"
"Jack"

>>> jack & field @"money" += 5.0
Cat "Jack" 6 15.0

…

But we also get sane ToJSON and FromJSON instances this way!

Quality-of-Life Library: strict-tuple

oracle :: Stream (Of Question) IO r -> Stream (Of (Hint, Warning)) IO r

This causes a space leak.

…

With strict-tuple by Mitchell Rosen:

import Data.Tuple.Strict (T2(..))

oracle :: Stream (Of Question) IO r -> Stream (Of (T2 Hint Warning)) IO r

Pattern: Strict Data

data JohnsWorkout = JohnsWorkout
  { duration   :: Word
  , location   :: Location
  , activities :: [Activity] }

…

{-# LANGUAGE BangPatterns #-}

data JohnsWorkout = JohnsWorkout
  { duration   :: {-# UNPACK #-} !Word
  , location   :: !Location
  , activities :: ![Activity] }

This reduces strain on the strictness checker inside GHC.

Lens: MonadState, (%=), and (.=)

data Env = Env { _foo :: Foo, ... }
makeLenses ''Env

bar :: Foo -> Foo

…

work :: MonadState Env m => ...
work ... = do
  env <- get
  put $ env { _foo = bar $ _foo env }

…

work :: MonadState Env m => ...
work ... = modify' (\env -> env { _foo = bar $ _foo env })

…

work :: MonadState Env m => ...
work ... = foo %= bar

Misc: Pockets of MaybeT and ExceptT

getFriend :: IO (Maybe Friend)
sellData  :: Friend -> IO (Maybe Cash)

facebookKiller :: IO ()
facebookKiller = do
  mfriend <- getFriend
  case mfriend of
    Nothing -> putStrLn "No!"
    Just a  -> do
      mdata <- sellData a
      case mdata of
        Nothing -> putStrLn "Zuckerberg wins again..."
        Just b  -> f b

Misc: Pockets of MaybeT and ExceptT (continued)

facebookKiller :: IO ()
facebookKiller = getFriend >>= \case
  Nothing -> putStrLn "No!"
  Just a  -> sellData a >>= \case
    Nothing -> putStrLn "Zuckerberg wins again..."
    Just b  -> f b

…

import Control.Monad.Trans.Maybe (MaybeT(..))

facebookKiller :: IO ()
facebookKiller = runMaybeT g >>= \case
  Nothing -> putStrLn "Zuckerberg wins again..."
  Just b  -> f b
  where
    g :: MaybeT IO Cash
    g = do
      friend <- MaybeT getFriend
      MaybeT $ sellData friend

Misc: Pockets of MaybeT and ExceptT (continued)

import Control.Monad.Trans.Except (ExceptT(..))

facebookKiller :: IO ()
facebookKiller = runExceptT g >>= \case
  Left e  -> putStrLn e
  Right b -> f b
  where
    g :: ExceptT Text IO Cash
    g = do
      friend <- noteT "Couldn't find a friend..." $ MaybeT getFriend
      noteT "Caught by the government" . MaybeT $ sellData friend

…

facebookKiller :: IO ()
facebookKiller = runExceptT g >>= either putStrLn f
  where
    ...

Thank You

Extra

Quality-of-Life Library: optparse-generic

Written by Gabriel Gonzales.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

data ChainwebEnv w = ChainwebEnv
  { nodes  :: w ::: Word8    <?> "The number of nodes to simulate"
  , config :: w ::: FilePath <?> "Path to config file"
  , peer   :: w ::: [Text]   <?> "Known peers to connect to"
  } deriving (Generic)

instance ParseRecord (ChainwebEnv Wrapped)

main :: IO ()
main = do
  ChainwebEnv n c p <- unwrapRecord "chainweb"
  ...

Misc: Aggressive newtyping

This is another way to adhere to the Principle of Perfect Input.

sendAMuffin :: Text -> Text -> IO ()
sendAMuffin name address = ...

…

newtype Name = Name { name :: Text }
newtype Address = Address { address :: Text }

sendAMuffin :: Name -> Address -> IO ()
sendAMuffin name address = ...

Language Extension: Use LambdaCase

work :: Foo -> IO (Maybe Bar)

solveFamousMathProblem :: Foo -> IO ()
solveFamousMathProblem foo = work foo >>= \mbar ->
  case mbar of
    Nothing  -> ...
    Just bar -> ...

…

{-# LANGUAGE LambdaCase #-}

solveFamousMathProblem :: Foo -> IO ()
solveFamousMathProblem foo = work foo >>= \case
  Nothing  -> ...
  Just bar -> ...

…

solveFamousMathProblem :: Foo -> IO ()
solveFamousMathProblem = work >=> traverse_ f

Language Extension: Avoid RecordWildCards

{-# LANGUAGE RecordWildCards #-}

data LaunchTarget = LaunchTarget { _planet :: Planet, _time :: Time, _orbit :: Orbit }

elon :: LaunchTarget -> IO ()
elon LaunchTarget{..} = do
  f _planet
  g _orbit
  ...

This does code-gen and slows compiles!

Misc: Explicit Exports

This keeps your Haddocks clean and improves compiler performance.

module Noodles
  ( -- * Soups
    -- | Noodles in some sort of broth.
    -- Can be eaten in \(O(\log{n})\) time.

    -- ** Chinese
    beefNoodle, ramen
    -- ** Vietnamese
  , pho
    -- ** Japanese
  , udon, soba
  ) where

…

Even in your main module:

module Main ( main ) where