Add support for PGP keys on the h-card - can support an arbitrary number of keys, although I only have one

src/Widget/Hcard.hs

@@ -6,6 +6,7 @@ module Widget.Hcard (hcard) where
 import Import
 import Data.Maybe (fromJust)
 import qualified Data.Map as M
+import qualified Data.Text as T
 import qualified Network.Libravatar as L
 
 entityToTuple :: Entity t -> (Key t, t)
@@ -17,6 +18,13 @@ arrangeProfiles sites profiles = sortBy icon $ zip profileSites profiles
           profileSites = findSite <$> profiles
           icon = comparing $ siteIcon . fst
 
+prettyPgp :: PgpKey -> Text
+prettyPgp = T.unwords . T.chunksOf 4 . pgpKeyFingerprint
+
+routeFromPgp :: PgpKey -> Route App
+routeFromPgp PgpKey { pgpKeyFingerprint = f, pgpKeyHash = h } =
+    StaticR $ StaticRoute ["pgp", f, h, T.takeEnd 8 f ++ ".asc"] []
+
 hcard :: Entity User -> Widget
 hcard (Entity userId user) = do
     maybeAvatar <- liftIO $ L.avatarUrl (L.Email $ userEmail user) def { L.optSecure = True, L.optSize = L.Size 512 }
@@ -24,4 +32,5 @@ hcard (Entity userId user) = do
         profiles <- map entityVal <$> selectList [ProfileUserId ==. userId] []
         sites <- M.fromList . map entityToTuple <$> selectList [SiteId <-. (profileSiteId <$> profiles)] []
         return $ arrangeProfiles sites profiles
+    pgpKeys <- handlerToWidget . runDB $ map entityVal <$> selectList [PgpKeyUserId ==. userId] []
     $(widgetFile "hcard")