Written in Scotty. The code is not great.

module Main where

import Control.Monad (replicateM)
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as BC
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import qualified Data.Text.Lazy as TL
import qualified Database.Redis as R
import Network.URI (parseURI)
import qualified System.Random as SR
import Web.Scotty

alphaNum = ['A'..'Z'] ++ ['0'..'9']
randomElement l = SR.randomRIO (0, ((length l) - 1)) >>= \d -> return (l !! d)

shortyGen = replicateM 7 (randomElement alphaNum)

saveURI conn shortURI uri = R.runRedis conn $ R.set shortURI uri
getURI  conn shortURI     = R.runRedis conn $ R.get shortURI

main = scotty 3000 $ do
  rConn <- liftIO (R.connect R.defaultConnectInfo)
  get "/" $ do
    uri <- param "uri"
    case parseURI (TL.unpack uri) of
      Just _  -> do
        shawty <- liftIO shortyGen
        let shorty = BC.pack shawty
        resp <- liftIO (saveURI rConn shorty (encodeUtf8 (TL.toStrict uri)))
        text $ TL.concat [(TL.pack (show resp)), " shorty is: ", TL.pack shawty]
      Nothing -> text (TL.concat [uri, " wasn't a url"])
  get "/:short" $ do
    short <- param "short"
    uri <- liftIO (getURI rConn short)
    case uri of
      Left reply -> text (TL.pack (show reply))
      Right mbBS -> case mbBS of
        Nothing -> text "uri not found"
        Just bs -> html $ TL.concat ["<a href=\"", tbs, "\">", tbs, "</a>"]
          where tbs = TL.fromStrict (decodeUtf8 bs)