
Hi Pietro, Haskell type classes provide ad-hoc polymorphism. Essentially, they allow you to write a function that works with more than one concrete type. https://wiki.haskell.org/Polymorphism#Ad-hoc_polymorphism Function `hashPassword` has the following type: hashPassword :: (MonadRandom m, ByteArray password, ByteArray hash) => Int -> password -> m hash It has three constraints (listed before the double arrow): Constraint `MonadRandom m` means that the function works in any monad that has a `MonadRandom` instance and can therefore be used to generate random values. If you click `MonadRandom` in the documentation, you can see which instances are built in. There is an `IO` instance, so you can run `hashPassword` in the `IO` monad. Constraint `ByteArray password` means that the function accepts a password of any type that has a `ByteArray` instance. If you click `ByteArray` in the documentation, you can see which instances are built in. There is a `ByteString` instance, so `hashPassword` can handle `ByteString` password arguments. Constraint `ByteArray hash` means that the function can return a hash of any type that has a `ByteArray` instance. The concrete type may be determined by how the return type is used; if your code expects a `ByteString` hash, then that is what you get. Here is a simple demo that hashes the first argument, or `password` if no arguments are provided: {-# LANGUAGE OverloadedStrings #-} module Main (main) where -- https://hackage.haskell.org/package/base import System.Environment (getArgs) -- https://hackage.haskell.org/package/base16-bytestring import qualified Data.ByteString.Base16 as Base16 -- https://hackage.haskell.org/package/cryptonite import qualified Crypto.KDF.BCrypt as BCrypt -- https://hackage.haskell.org/package/text import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TEE import qualified Data.Text.IO as TIO main :: IO () main = do password <- T.pack . head . (++ ["password"]) <$> getArgs TIO.putStrLn $ "password: " <> password hashBS <- BCrypt.hashPassword 11 $ TE.encodeUtf8 password let hashHex = TE.decodeUtf8With TEE.lenientDecode $ Base16.encode hashBS TIO.putStrLn $ "hash: " <> hashHex This demo runs in the `IO` monad, the password is passed to `hashPassword` as a `ByteString`, and the hash returned by `hashPassword` is a `ByteString`. Note that the password is encoded as a `ByteString` via `Text` so that it supports UTF-8. $ hash-password パスワード password: パスワード hash: 24326224313124486e474157773750493667744b6b6270354451613275516863667a68702e6756727a414b474542716751755371314949613549314b Cheers, Travis