From 3f2a17883073be30c0c026f6d703bee0aab5878f Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Wed, 20 Mar 2019 10:08:36 +0000
Subject: [PATCH] New module Yesod.FedURI: Render routes into FedURI and
 LocalURI

---
 src/Vervis/Handler/Person.hs | 11 ++++-------
 src/Yesod/FedURI.hs          | 38 ++++++++++++++++++++++++++++++++++++
 vervis.cabal                 |  1 +
 3 files changed, 43 insertions(+), 7 deletions(-)
 create mode 100644 src/Yesod/FedURI.hs

diff --git a/src/Vervis/Handler/Person.hs b/src/Vervis/Handler/Person.hs
index 2801119..9d0bc0c 100644
--- a/src/Vervis/Handler/Person.hs
+++ b/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
diff --git a/src/Yesod/FedURI.hs b/src/Yesod/FedURI.hs
new file mode 100644
index 0000000..0df472a
--- /dev/null
+++ b/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
diff --git a/vervis.cabal b/vervis.cabal
index deed69b..1301209 100644
--- a/vervis.cabal
+++ b/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