Polysemy is fun! - Part 2

31 Jul 2019

If you have not already gone through the previous post, please do so for context. All the code discussed in this post is available at https://gitlab.com/rkaippully/polysemy-password-manager/tree/part2.

Running Effects

So far we have seen how to define an effect as a data type and how to embed such effect values in the Sem monad. But those effects were not “doing” anything. It’s all nice to have a good looking program, but what is the point if it does not do something? How do we run the code so that we have a real password manager?

It is not hard to run effects. Remember me saying that the r in Sem r a is a list of effects? We pick the first effect from that list and find a function that can handle that effect and eliminate it from the list. For example, if we have a program of type Sem [e1, e2] a, we must find a function that will interpret the e1 effect. Applying that function will consume the e1 effect and give us a value of type Sem [e2] a. Repeat this with an interpreter for e2 and you get a Sem [] a. This is a value with no effects. You can use the run function to get the value out of it.

Let us see how this works in practice.

Interpreting CryptoHash

The first step is to define an interpreter for the CryptoHash effect that we defined. We’ll use the BCrypt algorithm to manipulate password hashes as defined in the cryptonite library. The hashPassword and validatePassword functions in cryptonite seem to correspond to the MakeHash and ValidateHash data constructors of CryptoHash.

There is a function named interpret in polysemy that lets you handle an effect such as CryptoHash.

In the first round, we’ll implement ValidateHash.

runCryptoHashAsState :: Sem (CryptoHash : r) a -> Sem r a
runCryptoHashAsState = interpret $ \case
  ValidateHash password hash -> return (validatePassword password hash)

As you can see, interpret takes a function as its only parameter. This function has to transform a CryptoHash m x value into a Sem r x value.

Also, pay close attention to the type signature Sem (CryptoHash : r) a -> Sem r a. You might recall that the first type parameter to Sem is a type-level list of effects. Here (CryptoHash : r) is a list of effects with CryptoHash at its head and r as the tail - the remaining effects. After running the interpret function we eliminate the CryptoHash effect from the type (because it has been interpreted) and return a Sem r a.

Interpreting ValidateHash is straightforward. We just delegate the call to validatePassword and lift the result into Sem r monad.

Effect Dependencies

Interpreting MakeHash via hashPassword is trickier. The type signature of hashPassword is MonadRandom m => Int -> Password -> m PasswordHash. We need to run the hashing in a monad that allows random number generation. One choice is to run it in IO monad. But that will cause our Sem r to be polluted with IO. This will allow some other piece of code in this monad to run arbitrary IO actions. Let us avoid it if we can.

Another choice is to use a pseudo-random number generator with a deterministic random number generator (DRG) initialized by a seed value. If we have access to such a DRG, we can use withDRG function to run hashPassword in a MonadRandom context. But every time we use a DRG, its internal state gets updated and we get a new DRG value. So we need a mechanism to store this updated DRG and pass it to the next MakeHash usage.

This is where State effect comes in. We can use it to retrieve the current value of DRG. Then we invoke withDRG to generate a password hash. This invocation will also return an updated DRG which we’ll save back into the State effect.

The code looks like this:

MakeHash password -> do
  drg <- get
  let (h, drg') = withDRG drg (hashPassword 10 password)
  put drg'
  return h

We managed to interpret the CryptoHash effect but that requires a State effect. We express this in the type signature of runCryptoHashAsState function:

runCryptoHashAsState :: (DRG gen, Member (State gen) r)
                     => Sem (CryptoHash : r) a
                     -> Sem r a
runCryptoHashAsState = interpret $ \case
  ValidateHash password hash -> return (validatePassword password hash)
  MakeHash password          -> do
    drg <- get
    let (hash, drg') = withDRG drg (hashPassword 10 password)
    put drg'
    return hash

The constraint Member (State gen) r indicates that the State gen effect must be present in the list of effects r. We need to find an interpreter for State gen, but let us leave that for later.

Let us go to the next effect we have - KVStore.

Interpreting KVStore

Let us use an SQLite database to store the password hashes. We will assume we have a table named passwords with two columns username and hash to store the data. Interpreting a KVStore with this table is easy:

runKVStoreAsSQLite :: Member (Embed IO) r
                   => Sem (KVStore Username PasswordHash : r) a
                   -> Sem (Input Connection : r) a
runKVStoreAsSQLite = reinterpret $ \case
  LookupKV username -> do
    conn <- input
    hashes <- embed (queryNamed conn
                      "SELECT hash FROM passwords WHERE username = :username"
                      [":username" := username])
    return (fromOnly <$> listToMaybe hashes)
  UpdateKV username maybeHash -> do
    let (query, params) =
      case maybeHash of
        Just hash -> ( "INSERT INTO passwords (username, hash) " <>
                       "VALUES (:username, :hash) " <>
                       "ON CONFLICT (username) DO UPDATE SET hash = excluded.hash"
                     , [":username" := username, ":hash" := hash] )
        Nothing   -> ( "DELETE FROM passwords WHERE username = :username"
                     , [":username" := username] )
    conn <- input
    embed (executeNamed conn query params)

The structure of this handler is similar to the previous one for CryptoHash. But there are some important differences.

First, we make use of the sqlite-simple package for the DB operations. Actions provided by this library run in the IO monad. We have to somehow incorporate that into our interpretation. Polysemy allows embedding arbitrary monadic actions into the Sem monad via the Embed constraint. The Member (Embed IO) r constraint indicates that we have embedded IO monadic actions in the Sem monad. In the code, we can use the embed function to “lift” an IO operation into the Sem monad. This is analogous to liftIO in monad transformers.

Second, we need a database connection to execute our operations. In the case of CryptoHash, a State effect was used because of the need to get and update the DRG. In this case, the DB connection is just an input. Hence, we make use of Input effect instead. We use the input function to get a connection and use it for DB operations.

Third, we are using the function reinterpret here instead of interpret. There is a subtle but important difference - interpret handles and eliminates an effect, while reinterpret merely translates one effect to another. The runCryptoHashAsState handler converted a Sem (CryptoHash : r) a value into a Sem r a value; the CryptoHash effect was eliminated. But runKVStoreAsSQLite handler converts a Sem (KVStore Username PasswordHash : r) value into a Sem (Input Connection : r) a value. The KVStore effect just got reencoded as an Input effect.

But runCryptoHashAsState had a dependency on State effect and that was expressed as a type constraint. How is that different from reinterpret reencoding the KVStore effect?

There are two differences. The Member (State gen) r constraint merely says State gen is one of the effects in r. It can be located anywhere in the list r which means that this effect can be handled in an arbitrary order. The handlers for CryptoHash and State gen are only loosely related to each other. But when reinterpret reencodes an effect into another one, the new effect is added at the head of the effect list and has to be handled next. Typically, the handlers for KVStore Username PasswordHash and Input Connection will get invoked in that order. This shows that they are logically related; both these effects together represent the storage system for the data.

It is also crucial to note that there is a one-to-one correspondence between the two effects in reinterpret. Every time a KVStore effect is handled by runKVStoreAsSQLite handler, a new Input Connection effect is added to the list of effects. If our program had two separate key-value stores, it will need two separate connection inputs as well. This makes sense because we don’t want the data in those two stores mixed up. But there is no such one-to-one correspondence in the Member constraint introduced by runCryptoHashAsState. If we had two CryptoHash handlers, one using bcrypt and another using scrypt, the same DRG can be shared for both. So only one handler for State gen is necessary for any number of CryptoHash handlers.

Final Steps

With all this, we are ready for a complete implementation of our operations. Here is how to implement addUser:

runAddUser :: Username -> Password -> IO ()
runAddUser username password = do
  drg <- getSystemDRG
  withConnection dbFile $ \conn ->
    {-
       Handle effects one by one. The comments on each line indicates
       the list of effects yet to be handled at that point.
    -}
    addUser username password  -- [CryptoHash, KVStore Username Password]
      & runCryptoHashAsState   -- [KVStore Username Password, State gen]
      & runKVStoreAsSQLite     -- [Input Connection, State gen, Embed IO]
      & runInputConst conn     -- [State gen, Embed IO]
      & evalState drg          -- [Embed IO]
      & runM

We get a DRG and a DB connection through the IO monad. Then we start handling the effects in addUser username password. Notice how some effect handlers (such as runCryptoHashAsState) adds new effects to the “pending” list. Eventually, we are left with a Sem [Embed IO] a value. The runM function can convert that to an IO a value.

Some of the handlers are defined in polysemy library itself - you can find the definitions of runInputConst and evalState here and here respectively.

The validatePassword implementation is along similar lines and is left as an exercise for you.

Testing Effects

Polysemy also helps us in writing tests for our effects. We can provide alternate effect handlers in the test code and test our effects for correctness and coverage.

below is such an implementation. Note that this code is pure and does not require the IO monad.

runAddUser :: DRG gen
           => gen
           -> Map Username PasswordHash
           -> Username
           -> Password
           -> Map Username PasswordHash
runAddUser drg m username password =
  addUser username password  -- [CryptoHash, KVStore Username Password]
    & runCryptoHashAsState   -- [KVStore Username Password, State gen]
    & runKVStorePurely m     -- [State gen]
    & evalState drg          -- []
    & run
    & fst

This function takes a map of user names and hashes, performs the add operation, and returns the resultant map. A test can validate that the output map contains expected entries.

For a more interesting example, see https://gitlab.com/rkaippully/polysemy-password-manager/blob/part2/test/Spec.hs

Summary

That was a whirlwind tour of implementing effect handlers. Obviously, there is a lot more functionality in polysemy. The library documentation is quite detailed and informative. Go check it out!