Naive hash chains

HashChain.hs

{-|
A naive implementation of hash chains; can be used for
one-time password systems.
See <https://en.wikipedia.org/wiki/S/KEY>.
-}

module HashChain (
    HashChain(_size, _hash)
  , next
  , init_chain
  , nhash
  , chain2
  ) where

import Crypto.Hash
import qualified Data.ByteString       as SB
import Data.Byteable

------------------------------------------------------------------------

data HashChain a = HashChain
  { _size :: Int
    -- ^ The size of the hash chain, decreased by 1 on each successful
    -- authentication.
    --
    -- A chain of size @n@ can be used @n@ times.
  , _hash :: (Digest a)
    -- ^ The result of @h^n(message)@, where @h@ is the hash function,
    -- @n@ is the number of iterations, and @message@ is a secret.
  } deriving (Show)

-- | Authenticate user input, assumed to be @h^(n - 1)(password)@
-- where @n@ is the size of the hash chain and @h@ is the hash
-- function.
--
-- Authentication succeeds if @h(h^(n - 1)(password))@ matches the
-- recorded hash chain value.
--
-- Each successful authentication attempt consumes a link in the hash chain,
-- until exhaustion.
--
-- On success, the original chain becomes obsolete and must be replaced
-- (permitting subsequent authentications against the same chain defeats
-- its purpose).
--
-- Returns @(success, new)@ where @success@ indicates authentication
-- outcome and @Just new@ is the next state of the chain or @Nothing@ on
-- authentication failure or chain exhaustion.
next :: HashAlgorithm a => Digest a -> HashChain a -> (Bool, Maybe (HashChain a))
next h0 (HashChain n h1) = (v, k)
  where
    v = hash (toBytes h0) == h1

    k | v && n > 0 = Just $ HashChain (n - 1) h0
      | otherwise  = Nothing

-- | Create a new hash chain, to be stored on the server.
init_chain :: HashAlgorithm a => Int -> SB.ByteString -> HashChain a
init_chain n secret = HashChain n (nhash n secret)

-- | @h^n(message)@.
nhash :: HashAlgorithm a => Int -> (SB.ByteString -> Digest a)
nhash n | n < 1 = error "nhash: expecting at least 1 iteration"
nhash n = foldr1 composeHash (replicate n hash)

------------------------------------------------------------------------

-- | @composeHash h1 h2 x = h1 (h2 x)@
composeHash :: (HashAlgorithm a, HashAlgorithm b)
            => (SB.ByteString -> Digest b)
            -> (SB.ByteString -> Digest a)
            -> (SB.ByteString -> Digest b)
composeHash h1 h2 x = h1 (toBytes $ h2 x)

-- | A binary hash chain.
--
-- @chain(h1, h2) = h(h1 + h2)@
chain2 :: (HashAlgorithm a, HashAlgorithm b, HashAlgorithm c) => Digest a -> Digest b -> Digest c
chain2 a b = hash (toBytes a `SB.append` toBytes b)