New module Yesod.FedURI: Render routes into FedURI and LocalURI

src/Vervis/Handler/Person.hs

@@ -39,6 +39,7 @@ import Text.Email.Local
 
 import Network.FedURI
 import Web.ActivityPub
+import Yesod.FedURI
 
 --import Vervis.ActivityStreams
 import Vervis.ActorKey
@@ -128,13 +129,9 @@ getPersonNewR = redirect $ AuthR newAccountR
 
 getPerson :: ShrIdent -> Person -> Handler TypedContent
 getPerson shr person = do
-    renderUrl <- getUrlRender
-    let route2uri route =
-            case parseFedURI $ renderUrl route of
-                Left e -> error $ "getRenderUrl produced invalid FedURI!!! " ++ e
-                Right u -> u
-        route2local = snd . f2l . route2uri
-        (host, me) = f2l $ route2uri $ SharerR shr
+    route2fed <- getEncodeRouteFed
+    route2local <- getEncodeRouteLocal
+    let (host, me) = f2l $ route2fed $ SharerR shr
     selectRep $ do
         provideRep $ do
             secure <- getSecure

src/Yesod/FedURI.hs

@@ -0,0 +1,38 @@
+{- This file is part of Vervis.
+ -
+ - Written 2019 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Yesod.FedURI
+    ( getEncodeRouteFed
+    , getEncodeRouteLocal
+    )
+where
+
+import Prelude
+
+import Yesod.Core
+import Yesod.Core.Handler
+
+import Network.FedURI
+
+getEncodeRouteFed :: MonadHandler m => m (Route (HandlerSite m) -> FedURI)
+getEncodeRouteFed = toFed <$> getUrlRender
+    where
+    toFed renderUrl route =
+        case parseFedURI $ renderUrl route of
+            Left e -> error $ "getUrlRender produced invalid FedURI: " ++ e
+            Right u -> u
+
+getEncodeRouteLocal :: MonadHandler m => m (Route (HandlerSite m) -> LocalURI)
+getEncodeRouteLocal = (\ f -> snd . f2l . f) <$> getEncodeRouteFed

vervis.cabal

@@ -95,6 +95,7 @@ library
                        Yesod.Auth.Unverified
                        Yesod.Auth.Unverified.Creds
                        Yesod.Auth.Unverified.Internal
+                       Yesod.FedURI
                        Yesod.Paginate.Local
                        Yesod.SessionEntity