diff --git a/config/models b/config/models
index 8dbac42..4e2804e 100644
--- a/config/models
+++ b/config/models
@@ -106,7 +106,7 @@ Forwarding
     UniqueForwarding recipient activity
 
 VerifKey
-    ident    LocalURI
+    ident    LocalRefURI
     instance InstanceId
     expires  UTCTime Maybe
     public   PublicVerifKey
@@ -137,7 +137,7 @@ RemoteActor
     UniqueRemoteActor instance ident
 
 Instance
-    host Text
+    host Host
 
     UniqueInstance host
 
diff --git a/migrations/2019_05_24.model b/migrations/2019_05_24.model
index bb58171..d684820 100644
--- a/migrations/2019_05_24.model
+++ b/migrations/2019_05_24.model
@@ -43,7 +43,7 @@ LocalMessage
     UniqueLocalMessage rest
 
 Instance
-    host Text
+    host Host
 
     UniqueInstance host
 
diff --git a/src/Data/Aeson/Local.hs b/src/Data/Aeson/Local.hs
index 123d646..8891aa6 100644
--- a/src/Data/Aeson/Local.hs
+++ b/src/Data/Aeson/Local.hs
@@ -20,6 +20,7 @@ module Data.Aeson.Local
     , (.:|)
     , (.:|?)
     , (.:+)
+    , (.:+?)
     , (.=?)
     , (.=%)
     , (.=+)
@@ -64,6 +65,11 @@ o .:|? t = optional $ o .:| t
 (.:+) :: (FromJSON a, FromJSON b) => Object -> Text -> Parser (Either a b)
 o .:+ t = Left <$> o .: t <|> Right <$> o .: t
 
+(.:+?)
+    :: (FromJSON a, FromJSON b)
+    => Object -> Text -> Parser (Maybe (Either a b))
+o .:+? t = optional $ o .:+ t
+
 infixr 8 .=?
 (.=?) :: ToJSON v => Text -> Maybe v -> Series
 _ .=? Nothing  = mempty
diff --git a/src/Network/FedURI.hs b/src/Network/FedURI.hs
index c814eba..bbcb80c 100644
--- a/src/Network/FedURI.hs
+++ b/src/Network/FedURI.hs
@@ -16,165 +16,325 @@
 {-# LANGUAGE DeriveGeneric #-}
 
 module Network.FedURI
-    ( FedURI (..)
-    , parseFedURI
-    , toURI
-    , renderFedURI
-
-    {-
-    , InstanceURI (..)
-    , i2f
-    , f2i
-    -}
-
+    ( Authority (..)
+    , renderAuthority
     , LocalURI (..)
-    , l2f
-    , f2l
-
-    , FedPageURI (..)
+    , topLocalURI
+    , LocalSubURI (..)
     , LocalPageURI (..)
-    , lp2fp
-    , fp2lp
+    , LocalRefURI (..)
+    , UriMode ()
+    , Fed ()
+    , Dev ()
+    , ObjURI (..)
+    , parseObjURI
+    , uriFromObjURI
+    , renderObjURI
+    , SubURI (..)
+    , uriFromSubURI
+    , PageURI (..)
+    , RefURI (..)
+    , parseRefURI
     )
 where
 
-import Control.Monad ((<=<))
+import Control.Monad
 import Data.Aeson
-import Data.Bifunctor (bimap, first)
+import Data.Bifunctor
 import Data.Char
 import Data.Hashable
-import Data.Maybe (fromJust)
+import Data.Maybe
 import Data.Text (Text)
 import Data.Text.Encoding
-import Database.Persist.Class (PersistField (..))
-import Database.Persist.Sql (PersistFieldSql (..))
+import Data.Word
+import Database.Persist.Class
+import Database.Persist.Sql
 import GHC.Generics (Generic)
-import Network.HTTP.Types.URI
-import Network.URI
 import Text.Read
+import Network.HTTP.Types.URI
+import Network.URI hiding (scheme, path, query, fragment)
 
 import qualified Data.Text as T
 
--- | An absolute URI with the following properties:
---
--- * The scheme is HTTPS
--- * The authority part is present
--- * The authority part doesn't have userinfo
--- * The authority host needs to match certain rules
--- * The authority part doesn't have a port number
--- * There is no query part
--- * A fragment part may be present
-data FedURI = FedURI
-    { furiHost     :: Text
-    , furiPath     :: Text
-    , furiFragment :: Text
+data Scheme = Plain | Secure deriving Eq
+
+data Full
+
+data Authority t = Authority
+    { authorityHost :: Text
+    , authorityPort :: Maybe Word16
     }
-    deriving (Eq, Generic)
+    deriving (Eq, Ord, Generic)
 
-instance Hashable FedURI
+instance UriMode t => Hashable (Authority t)
 
-instance FromJSON FedURI where
-    parseJSON = withText "FedURI" $ either fail return . parseFedURI
+parseAuthority :: UriMode t => Text -> Either String (Authority t)
+parseAuthority t = do
+    FullObjURI s a l <- toFullObjURI =<< parseFullURI ("https://" <> t)
+    unless (s == Secure && l == topLocalURI) $
+        Left "parseAuthority: Unexpected FullObjURI"
+    let s' = case authorityPort a of
+                Nothing -> Secure
+                Just _ -> Plain
+    checkAuthority s' a
 
-instance ToJSON FedURI where
-    toJSON = error "toJSON FedURI"
-    toEncoding = toEncoding . renderFedURI
+renderAuthority :: Authority t -> Text
+renderAuthority (Authority h Nothing)  = h
+renderAuthority (Authority h (Just p)) = T.concat [h, ":", T.pack $ show p]
 
-instance PersistField FedURI where
-    toPersistValue = toPersistValue . renderFedURI
-    fromPersistValue = first T.pack . parseFedURI <=< fromPersistValue
+instance UriMode t => FromJSON (Authority t) where
+    parseJSON = withText "Authority" $ either fail return . parseAuthority
 
-instance PersistFieldSql FedURI where
-    sqlType = sqlType . fmap renderFedURI
+instance UriMode t => ToJSON (Authority t) where
+    toJSON = toJSON . renderAuthority
+    toEncoding = toEncoding . renderAuthority
 
-parseFedURI :: Text -> Either String FedURI
-parseFedURI t = do
-    uri <- case parseURI $ T.unpack t of
-        Nothing -> Left "Invalid absolute URI"
-        Just u -> Right u
-    if uriScheme uri == "https:"
-        then Right ()
-        else Left "URI scheme isn't https"
-    URIAuth ui h p <- case uriAuthority uri of
-        Nothing -> Left "URI has empty authority"
-        Just a -> Right a
-    if ui == ""
-        then Right ()
-        else Left "URI has non-empty userinfo"
-    if p == ""
-        then Right ()
-        else Left "URI has non-empty port"
-    if any (== '.') h
-        then Right ()
-        else Left "Host doesn't contain periods"
-    if any isAsciiLetter h
-        then Right ()
-        else Left "Host doesn't contain ASCII letters"
-    if uriQuery uri == ""
-        then Right ()
-        else Left "URI query is non-empty"
-    Right FedURI
-        { furiHost     = T.pack h
-        , furiPath     = T.pack $ uriPath uri
-        , furiFragment = T.pack $ uriFragment uri
+instance UriMode t => PersistField (Authority t) where
+    toPersistValue = toPersistValue . renderAuthority
+    fromPersistValue = first T.pack . parseAuthority <=< fromPersistValue
+
+instance UriMode t => PersistFieldSql (Authority t) where
+    sqlType = sqlType . fmap renderAuthority
+
+data FullURI = FullURI
+    { fullUriScheme    :: Scheme
+    , fullUriAuthority :: Authority Full
+    , fullUriPath      :: Text
+    , fullUriQuery     :: Text
+    , fullUriFragment  :: Text
+    }
+
+parseFullURI :: Text -> Either String FullURI
+parseFullURI t = do
+    uri <-
+        case parseURI $ T.unpack t of
+            Nothing -> Left "Invalid absolute URI"
+            Just u -> Right u
+    scheme <-
+        case uriScheme uri of
+            "http:" -> Right Plain
+            "https:" -> Right Secure
+            _ -> Left "URI scheme isn't http/s"
+    URIAuth userInfo host port <-
+        case uriAuthority uri of
+            Nothing -> Left "URI has empty authority"
+            Just a -> Right a
+    unless (userInfo == "") $
+        Left "URI has non-empty userinfo"
+    portNumber <-
+        case port of
+            [] -> Right Nothing
+            c:p ->
+                case (c, readMaybe p) of
+                    (':', Just n) ->
+                        if n == 80 || n == 443
+                            then Left "Unexpected port number"
+                            else Right $ Just n
+                    _ -> Left "Unexpected port number format"
+    when (any (== ':') host) $
+        Left "Host contains a colon"
+    unless (any isAsciiLetter host) $
+        Left "Host doesn't contain ASCII letters"
+    Right FullURI
+        { fullUriScheme    = scheme
+        , fullUriAuthority = Authority
+            { authorityHost = T.pack host
+            , authorityPort = portNumber
+            }
+        , fullUriPath      = T.pack $ uriPath uri
+        , fullUriQuery     = T.pack $ uriQuery uri
+        , fullUriFragment  = T.pack $ uriFragment uri
         }
     where
     isAsciiLetter c = isAsciiLower c || isAsciiUpper c
 
-toURI :: FedURI -> URI
-toURI (FedURI h p f) = URI
-    { uriScheme    = "https:"
-    , uriAuthority = Just $ URIAuth "" (T.unpack h) ""
-    , uriPath      = T.unpack p
-    , uriQuery     = ""
-    , uriFragment  = T.unpack f
+fromFullURI :: FullURI -> URI
+fromFullURI (FullURI scheme (Authority host mport) path query fragment) = URI
+    { uriScheme    =
+        case scheme of
+            Plain -> "http:"
+            Secure -> "https:"
+    , uriAuthority = Just URIAuth
+        { uriUserInfo = ""
+        , uriRegName  = T.unpack host
+        , uriPort     = maybe "" ((':' :) . show) mport
+        }
+    , uriPath      = T.unpack path
+    , uriQuery     = T.unpack query
+    , uriFragment  = T.unpack fragment
     }
 
-renderFedURI :: FedURI -> Text
-renderFedURI = T.pack . flip (uriToString id) "" . toURI
+renderFullURI :: FullURI -> Text
+renderFullURI = T.pack . flip (uriToString id) "" . fromFullURI
 
--- | A 'FedURI' with a page number specified as a query parameter
-data FedPageURI = FedPageURI
-    { fpuriResource :: FedURI
-    , fpuriParam    :: Text
-    , fpuriPage     :: Int
+instance FromJSON FullURI where
+    parseJSON = withText "FullURI" $ either fail return . parseFullURI
+
+instance ToJSON FullURI where
+    toJSON = error "toJSON FullURI"
+    toEncoding = toEncoding . renderFullURI
+
+instance PersistField FullURI where
+    toPersistValue = toPersistValue . renderFullURI
+    fromPersistValue = first T.pack . parseFullURI <=< fromPersistValue
+
+instance PersistFieldSql FullURI where
+    sqlType = sqlType . fmap renderFullURI
+
+data LocalURI = LocalURI
+    { localUriPath :: Text
     }
     deriving (Eq, Generic)
 
-instance Hashable FedPageURI
+instance Hashable LocalURI
 
-instance FromJSON FedPageURI where
-    parseJSON = withText "FedPageURI" $ either fail return . parseFedPageURI
+dummyAuthority :: Authority Fed
+dummyAuthority = Authority "h.h" Nothing
 
-instance ToJSON FedPageURI where
-    toJSON = error "toJSON FedPageURI"
-    toEncoding = toEncoding . renderFedPageURI
+dummyPrefix :: Text
+dummyPrefix = renderObjURI $ ObjURI dummyAuthority topLocalURI
 
-parseFedPageURI :: Text -> Either String FedPageURI
-parseFedPageURI t = do
-    uri <- case parseURI $ T.unpack t of
-        Nothing -> Left "Invalid absolute URI"
-        Just u -> Right u
-    if uriScheme uri == "https:"
-        then Right ()
-        else Left "URI scheme isn't https"
-    URIAuth ui h p <- case uriAuthority uri of
-        Nothing -> Left "URI has empty authority"
-        Just a -> Right a
-    if ui == ""
-        then Right ()
-        else Left "URI has non-empty userinfo"
-    if p == ""
-        then Right ()
-        else Left "URI has non-empty port"
-    if any (== '.') h
-        then Right ()
-        else Left "Host doesn't contain periods"
-    if any isAsciiLetter h
-        then Right ()
-        else Left "Host doesn't contain ASCII letters"
+instance PersistField LocalURI where
+    toPersistValue = toPersistValue . renderLocalURI
+        where
+        renderLocalURI
+            = fromJust
+            . T.stripPrefix dummyPrefix
+            . renderObjURI
+            . ObjURI dummyAuthority
+    fromPersistValue
+        =   bimap T.pack objUriLocal . parseObjURI' . (dummyPrefix <>)
+        <=< fromPersistValue
+        where
+        parseObjURI' :: Text -> Either String (ObjURI Fed)
+        parseObjURI' = parseObjURI
+
+instance PersistFieldSql LocalURI where
+    sqlType = sqlType . fmap localUriPath
+
+topLocalURI :: LocalURI
+topLocalURI = LocalURI ""
+
+data FullObjURI = FullObjURI
+    { _fullObjUriScheme    :: Scheme
+    , _fullObjUriAuthority :: Authority Full
+    , _fullObjUriLocal     :: LocalURI
+    }
+
+toFullObjURI :: FullURI -> Either String FullObjURI
+toFullObjURI (FullURI s a p q f) = do
+    unless (q == "") $
+        Left "URI query is non-empty"
+    unless (f == "") $
+        Left "URI fragment is non-empty"
+    Right $ FullObjURI s a $ LocalURI p
+
+fromFullObjURI :: FullObjURI -> FullURI
+fromFullObjURI (FullObjURI s a (LocalURI p)) = FullURI s a p "" ""
+
+instance FromJSON FullObjURI where
+    parseJSON = either fail return . toFullObjURI <=< parseJSON
+
+instance ToJSON FullObjURI where
+    toJSON = toJSON . fromFullObjURI
+    toEncoding = toEncoding . fromFullObjURI
+
+instance PersistField FullObjURI where
+    toPersistValue = toPersistValue . fromFullObjURI
+    fromPersistValue = first T.pack . toFullObjURI <=< fromPersistValue
+
+instance PersistFieldSql FullObjURI where
+    sqlType = sqlType . fmap fromFullObjURI
+
+data LocalSubURI = LocalSubURI
+    { localSubUriResource :: LocalURI
+    , localSubUriFragment :: Text
+    }
+    deriving (Eq, Generic)
+
+instance Hashable LocalSubURI
+
+instance PersistField LocalSubURI where
+    toPersistValue = toPersistValue . renderLocalSubURI
+        where
+        renderLocalSubURI
+            = fromJust
+            . T.stripPrefix dummyPrefix
+            . renderSubURI
+            . SubURI dummyAuthority
+            where
+            renderSubURI :: UriMode t => SubURI t -> Text
+            renderSubURI = renderFullURI . fromFullSubURI . fromSubURI
+    fromPersistValue
+        =   bimap T.pack subUriLocal . parseSubURI' . (dummyPrefix <>)
+        <=< fromPersistValue
+        where
+        parseSubURI' :: Text -> Either String (SubURI Fed)
+        parseSubURI' = parseSubURI
+            where
+            parseSubURI :: UriMode t => Text -> Either String (SubURI t)
+            parseSubURI = toSubURI <=< toFullSubURI <=< parseFullURI
+
+instance PersistFieldSql LocalSubURI where
+    sqlType = sqlType . fmap localSubUriResource
+
+data FullSubURI = FullSubURI
+    { _fullSubUriScheme    :: Scheme
+    , _fullSubUriAuthority :: Authority Full
+    , _fullSubUriLocal     :: LocalSubURI
+    }
+
+toFullSubURI :: FullURI -> Either String FullSubURI
+toFullSubURI (FullURI s a p q f) = do
+    unless (T.null q) $
+        Left "URI query is non-empty"
+    case T.uncons f of
+        Nothing -> Left "No URI fragment"
+        Just ('#', f') ->
+            when (T.null f') $
+                Left "URI fragment is empty"
+        _ -> Left "URI fragment unexpectedly doesn't start with a '#'"
+    when (T.null f) $
+        Left "URI fragment is empty"
+    Right $ FullSubURI s a $ LocalSubURI (LocalURI p) f
+
+fromFullSubURI :: FullSubURI -> FullURI
+fromFullSubURI (FullSubURI s a (LocalSubURI (LocalURI p) f)) =
+    FullURI s a p "" f
+
+instance FromJSON FullSubURI where
+    parseJSON = either fail return . toFullSubURI <=< parseJSON
+
+instance ToJSON FullSubURI where
+    toJSON = toJSON . fromFullSubURI
+    toEncoding = toEncoding . fromFullSubURI
+
+instance PersistField FullSubURI where
+    toPersistValue = toPersistValue . fromFullSubURI
+    fromPersistValue = first T.pack . toFullSubURI <=< fromPersistValue
+
+instance PersistFieldSql FullSubURI where
+    sqlType = sqlType . fmap fromFullSubURI
+
+data LocalPageURI = LocalPageURI
+    { localPageUriResource :: LocalURI
+    , localPageUriParam    :: Text
+    , localPageUriPage     :: Int
+    }
+    deriving (Eq, Generic)
+
+instance Hashable LocalPageURI
+
+data FullPageURI = FullPageURI
+    { _fullPageUriScheme    :: Scheme
+    , _fullPageUriAuthority :: Authority Full
+    , _fullPageUriLocal     :: LocalPageURI
+    }
+
+toFullPageURI :: FullURI -> Either String FullPageURI
+toFullPageURI (FullURI s a p q f) = do
     (param, mval) <-
-        case parseQueryText $ encodeUtf8 $ T.pack $ uriQuery uri of
+        case parseQueryText $ encodeUtf8 q of
             [] -> Left "URI query is empty"
             [qp] -> Right qp
             _ -> Left "URI has multiple query parameters"
@@ -186,85 +346,240 @@ parseFedPageURI t = do
         case readMaybe $ T.unpack val of
             Nothing -> Left "URI query param value isn't an integer"
             Just n -> Right n
-    if page >= 1
-        then Right ()
-        else Left "URI page number isn't positive"
-    Right FedPageURI
-        { fpuriResource = FedURI
-            { furiHost     = T.pack h
-            , furiPath     = T.pack $ uriPath uri
-            , furiFragment = T.pack $ uriFragment uri
-            }
-        , fpuriParam = param
-        , fpuriPage  = page
-        }
+    unless (page >= 1) $
+        Left "URI page number isn't positive"
+    unless (f == "") $
+        Left "URI fragment is non-empty"
+    Right $ FullPageURI s a $ LocalPageURI (LocalURI p) param page
+
+fromFullPageURI :: FullPageURI -> FullURI
+fromFullPageURI (FullPageURI s a (LocalPageURI (LocalURI p) param page)) =
+    FullURI s a p q ""
     where
-    isAsciiLetter c = isAsciiLower c || isAsciiUpper c
+    q = T.concat ["?", param, "=", T.pack $ show page]
 
-toPageURI :: FedPageURI -> URI
-toPageURI (FedPageURI (FedURI h p f) qp qv) = URI
-    { uriScheme    = "https:"
-    , uriAuthority = Just $ URIAuth "" (T.unpack h) ""
-    , uriPath      = T.unpack p
-    , uriQuery     = "?" ++ T.unpack qp ++ "=" ++ show qv
-    , uriFragment  = T.unpack f
+instance FromJSON FullPageURI where
+    parseJSON = either fail return . toFullPageURI <=< parseJSON
+
+instance ToJSON FullPageURI where
+    toJSON = toJSON . fromFullPageURI
+    toEncoding = toEncoding . fromFullPageURI
+
+instance PersistField FullPageURI where
+    toPersistValue = toPersistValue . fromFullPageURI
+    fromPersistValue = first T.pack . toFullPageURI <=< fromPersistValue
+
+instance PersistFieldSql FullPageURI where
+    sqlType = sqlType . fmap fromFullPageURI
+
+newtype LocalRefURI = LocalRefURI (Either LocalURI LocalSubURI)
+    deriving (Eq, Generic)
+
+instance Hashable LocalRefURI
+
+instance PersistField LocalRefURI where
+    toPersistValue (LocalRefURI u) = either toPersistValue toPersistValue u
+    fromPersistValue v =
+        LocalRefURI <$>
+            aor (Left <$> fromPersistValue v) (Right <$> fromPersistValue v)
+        where
+        aor :: Either a b -> Either a b -> Either a b
+        aor (Left _)    y = y
+        aor a@(Right _) _ = a
+
+instance PersistFieldSql LocalRefURI where
+    sqlType = sqlType . fmap f
+        where
+        f (LocalRefURI u) = either id localSubUriResource u
+
+data FullRefURI = FullRefURI
+    { _fullRefUriScheme    :: Scheme
+    , _fullRefUriAuthority :: Authority Full
+    , _fullRefUriLocal     :: LocalRefURI
     }
 
-renderFedPageURI :: FedPageURI -> Text
-renderFedPageURI = T.pack . flip (uriToString id) "" . toPageURI
+toFullRefURI :: FullURI -> Either String FullRefURI
+toFullRefURI fu =
+    case toFullObjURI fu of
+        Left _ -> sub2ref <$> toFullSubURI fu
+        Right ou -> Right $ obj2ref ou
+    where
+    obj2ref (FullObjURI s a l) = FullRefURI s a $ LocalRefURI $ Left l
+    sub2ref (FullSubURI s a l) = FullRefURI s a $ LocalRefURI $ Right l
 
-{-
-newtype InstanceURI = InstanceURI
-    { iuriHost :: Text
+fromFullRefURI :: FullRefURI -> FullURI
+fromFullRefURI (FullRefURI s a (LocalRefURI e)) =
+    case e of
+        Left l -> fromFullObjURI $ FullObjURI s a l
+        Right l -> fromFullSubURI $ FullSubURI s a l
+
+instance FromJSON FullRefURI where
+    parseJSON = either fail return . toFullRefURI <=< parseJSON
+
+instance ToJSON FullRefURI where
+    toJSON = toJSON . fromFullRefURI
+    toEncoding = toEncoding . fromFullRefURI
+
+instance PersistField FullRefURI where
+    toPersistValue = toPersistValue . fromFullRefURI
+    fromPersistValue = first T.pack . toFullRefURI <=< fromPersistValue
+
+instance PersistFieldSql FullRefURI where
+    sqlType = sqlType . fmap fromFullRefURI
+
+class UriMode a where
+    checkAuthority  :: Scheme -> Authority Full -> Either String (Authority a)
+    authorityScheme :: Authority a -> Scheme
+
+toFull :: UriMode a => Authority a -> Authority Full
+toFull (Authority h mp) = Authority h mp
+
+data Fed
+
+instance UriMode Fed where
+    checkAuthority s (Authority h mp)
+        | s /= Secure      = Left "Scheme isn't HTTPS"
+        | isJust mp        = Left "Port number present"
+        | T.all (/= '.') h = Left "Host doesn't contain periods"
+        | otherwise        = Right $ Authority h mp
+    authorityScheme _ = Secure
+
+data Dev
+
+instance UriMode Dev where
+    checkAuthority s (Authority h mp)
+        | s /= Plain       = Left "Scheme isn't HTTP"
+        | isNothing mp     = Left "Port number missing"
+        | T.any (== '.') h = Left "Host contains periods"
+        | otherwise        = Right $ Authority h mp
+    authorityScheme _ = Plain
+
+data ObjURI t = ObjURI
+    { objUriAuthority :: Authority t
+    , objUriLocal     :: LocalURI
     }
-    deriving Eq
+    deriving (Eq, Generic)
 
-i2f :: InstanceURI -> FedURI
-i2f (InstanceURI h) = FedURI h "" ""
+instance UriMode t => Hashable (ObjURI t)
 
-f2i :: FedURI -> InstanceURI
-f2i = InstanceURI . furiHost
--}
+toObjURI :: UriMode t => FullObjURI -> Either String (ObjURI t)
+toObjURI (FullObjURI s a l) = flip ObjURI l <$> checkAuthority s a
 
-data LocalURI = LocalURI
-    { luriPath     :: Text
-    , luriFragment :: Text
+fromObjURI :: UriMode t => ObjURI t -> FullObjURI
+fromObjURI (ObjURI a l) = FullObjURI (authorityScheme a) (toFull a) l
+
+parseObjURI :: UriMode t => Text -> Either String (ObjURI t)
+parseObjURI = toObjURI <=< toFullObjURI <=< parseFullURI
+
+uriFromObjURI :: UriMode t => ObjURI t -> URI
+uriFromObjURI = fromFullURI . fromFullObjURI . fromObjURI
+
+renderObjURI :: UriMode t => ObjURI t -> Text
+renderObjURI = renderFullURI . fromFullObjURI . fromObjURI
+
+instance UriMode t => FromJSON (ObjURI t) where
+    parseJSON = either fail return . toObjURI <=< parseJSON
+
+instance UriMode t => ToJSON (ObjURI t) where
+    toJSON = toJSON . fromObjURI
+    toEncoding = toEncoding . fromObjURI
+
+instance UriMode t => PersistField (ObjURI t) where
+    toPersistValue = toPersistValue . fromObjURI
+    fromPersistValue = first T.pack . toObjURI <=< fromPersistValue
+
+instance UriMode t => PersistFieldSql (ObjURI t) where
+    sqlType = sqlType . fmap fromObjURI
+
+data SubURI t = SubURI
+    { subUriAuthority :: Authority t
+    , subUriLocal     :: LocalSubURI
     }
-    deriving Eq
+    deriving (Eq, Generic)
 
-dummyHost :: Text
-dummyHost = "h.h"
+instance UriMode t => Hashable (SubURI t)
 
-dummyPrefix :: Text
-dummyPrefix = "https://" <> dummyHost
+toSubURI :: UriMode t => FullSubURI -> Either String (SubURI t)
+toSubURI (FullSubURI s a l) = flip SubURI l <$> checkAuthority s a
 
-renderLocalURI :: LocalURI -> Text
-renderLocalURI = fromJust . T.stripPrefix dummyPrefix . renderFedURI . l2f dummyHost
+fromSubURI :: UriMode t => SubURI t -> FullSubURI
+fromSubURI (SubURI a l) = FullSubURI (authorityScheme a) (toFull a) l
 
-instance PersistField LocalURI where
-    toPersistValue = toPersistValue . renderLocalURI
-    fromPersistValue = bimap T.pack (snd . f2l) . parseFedURI . (dummyPrefix <>) <=< fromPersistValue
+uriFromSubURI :: UriMode t => SubURI t -> URI
+uriFromSubURI = fromFullURI . fromFullSubURI . fromSubURI
 
-instance PersistFieldSql LocalURI where
-    sqlType = sqlType . fmap renderLocalURI
+instance UriMode t => FromJSON (SubURI t) where
+    parseJSON = either fail return . toSubURI <=< parseJSON
 
-l2f :: Text -> LocalURI -> FedURI
-l2f h (LocalURI p f) = FedURI h p f
+instance UriMode t => ToJSON (SubURI t) where
+    toJSON = toJSON . fromSubURI
+    toEncoding = toEncoding . fromSubURI
 
-f2l :: FedURI -> (Text, LocalURI)
-f2l (FedURI h p f) = (h, LocalURI p f)
+instance UriMode t => PersistField (SubURI t) where
+    toPersistValue = toPersistValue . fromSubURI
+    fromPersistValue = first T.pack . toSubURI <=< fromPersistValue
 
-data LocalPageURI = LocalPageURI
-    { lpuriResource :: LocalURI
-    , lpuriParam    :: Text
-    , lpuriPage     :: Int
+instance UriMode t => PersistFieldSql (SubURI t) where
+    sqlType = sqlType . fmap fromSubURI
+
+data PageURI t = PageURI
+    { pageUriAuthority :: Authority t
+    , pageUriLocal     :: LocalPageURI
     }
-    deriving Eq
+    deriving (Eq, Generic)
 
-lp2fp :: Text -> LocalPageURI -> FedPageURI
-lp2fp h (LocalPageURI lu p n) = FedPageURI (l2f h lu) p n
+instance UriMode t => Hashable (PageURI t)
 
-fp2lp :: FedPageURI -> (Text, LocalPageURI)
-fp2lp (FedPageURI fu p n) =
-    let (h, lu) = f2l fu
-    in  (h, LocalPageURI lu p n)
+toPageURI :: UriMode t => FullPageURI -> Either String (PageURI t)
+toPageURI (FullPageURI s a l) = flip PageURI l <$> checkAuthority s a
+
+fromPageURI :: UriMode t => PageURI t -> FullPageURI
+fromPageURI (PageURI a l) = FullPageURI (authorityScheme a) (toFull a) l
+
+instance UriMode t => FromJSON (PageURI t) where
+    parseJSON = either fail return . toPageURI <=< parseJSON
+
+instance UriMode t => ToJSON (PageURI t) where
+    toJSON = toJSON . fromPageURI
+    toEncoding = toEncoding . fromPageURI
+
+instance UriMode t => PersistField (PageURI t) where
+    toPersistValue = toPersistValue . fromPageURI
+    fromPersistValue = first T.pack . toPageURI <=< fromPersistValue
+
+instance UriMode t => PersistFieldSql (PageURI t) where
+    sqlType = sqlType . fmap fromPageURI
+
+data RefURI t = RefURI
+    { refUriAuthority :: Authority t
+    , refUriLocal     :: LocalRefURI
+    }
+    deriving (Eq, Generic)
+
+instance UriMode t => Hashable (RefURI t)
+
+toRefURI :: UriMode t => FullRefURI -> Either String (RefURI t)
+toRefURI (FullRefURI s a l) = flip RefURI l <$> checkAuthority s a
+
+fromRefURI :: UriMode t => RefURI t -> FullRefURI
+fromRefURI (RefURI a l) = FullRefURI (authorityScheme a) (toFull a) l
+
+parseRefURI :: UriMode t => Text -> Either String (RefURI t)
+parseRefURI = toRefURI <=< toFullRefURI <=< parseFullURI
+
+uriFromRefURI :: UriMode t => RefURI t -> URI
+uriFromRefURI = fromFullURI . fromFullRefURI . fromRefURI
+
+instance UriMode t => FromJSON (RefURI t) where
+    parseJSON = either fail return . toRefURI <=< parseJSON
+
+instance UriMode t => ToJSON (RefURI t) where
+    toJSON = toJSON . fromRefURI
+    toEncoding = toEncoding . fromRefURI
+
+instance UriMode t => PersistField (RefURI t) where
+    toPersistValue = toPersistValue . fromRefURI
+    fromPersistValue = first T.pack . toRefURI <=< fromPersistValue
+
+instance UriMode t => PersistFieldSql (RefURI t) where
+    sqlType = sqlType . fmap fromRefURI
diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs
index e179b3d..8d07802 100644
--- a/src/Vervis/API.hs
+++ b/src/Vervis/API.hs
@@ -99,6 +99,7 @@ import Yesod.Persist.Local
 import Vervis.ActivityPub
 import Vervis.ActorKey
 import Vervis.API.Recipient
+import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
@@ -145,7 +146,7 @@ parseComment luParent = do
 -- | Handle a Note submitted by a local user to their outbox. It can be either
 -- a comment on a local ticket, or a comment on some remote context. Return an
 -- error message if the Note is rejected, otherwise the new 'LocalMessageId'.
-createNoteC :: Text -> Note -> Handler (Either Text LocalMessageId)
+createNoteC :: Host -> Note URIMode -> Handler (Either Text LocalMessageId)
 createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source content) = runExceptT $ do
     verifyHostLocal host "Attributed to non-local actor"
     verifyNothingE mluNote "Note specifies an id"
@@ -169,7 +170,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
                 mmidParent <- for mparent $ \ parent ->
                     case parent of
                         Left (shrParent, lmidParent) -> getLocalParentMessageId did shrParent lmidParent
-                        Right (hParent, luParent) -> do
+                        Right (ObjURI hParent luParent) -> do
                             mrm <- lift $ runMaybeT $ do
                                 iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
                                 MaybeT $ getValBy $ UniqueRemoteMessageIdent iid luParent
@@ -183,7 +184,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
                 return (did, Left <$> mmidParent, Just (sid, ticketFollowers t, ibidProject, fsidProject))
             Nothing -> do
                 (rd, rdnew) <- lift $ do
-                    let (hContext, luContext) = f2l uContext
+                    let ObjURI hContext luContext = uContext
                     iid <- either entityKey id <$> insertBy' (Instance hContext)
                     mrd <- getValBy $ UniqueRemoteDiscussionIdent iid luContext
                     case mrd of
@@ -203,12 +204,12 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
                         Left (shrParent, lmidParent) -> do
                             when rdnew $ throwE "Local parent inexistent, RemoteDiscussion is new"
                             Left <$> getLocalParentMessageId did shrParent lmidParent
-                        Right (hParent, luParent) -> do
+                        Right p@(ObjURI hParent luParent) -> do
                             mrm <- lift $ runMaybeT $ do
                                 iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
                                 MaybeT $ getValBy $ UniqueRemoteMessageIdent iid luParent
                             case mrm of
-                                Nothing -> return $ Right $ l2f hParent luParent
+                                Nothing -> return $ Right p
                                 Just rm -> Left <$> do
                                     let mid = remoteMessageRest rm
                                     m <- lift $ getJust mid
@@ -222,15 +223,15 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
                     <p>
                       <a href=@{SharerR shrUser}>#{shr2text shrUser}
                       \ commented on a #
-                      <a href=#{renderFedURI uContext}>ticket</a>.
+                      <a href=#{renderObjURI uContext}>ticket</a>.
                 |]
         (lmid, obiid, doc) <- lift $ insertMessage luAttrib shrUser pid obid uContext did muParent meparent source content summary
         moreRemotes <- deliverLocal pid obiid localRecips mcollections
         unless (federation || null moreRemotes) $
             throwE "Federation disabled but remote collection members found"
-        remotesHttp <- lift $ deliverRemoteDB' (furiHost uContext) obiid remoteRecips moreRemotes
+        remotesHttp <- lift $ deliverRemoteDB' (objUriAuthority uContext) obiid remoteRecips moreRemotes
         return (lmid, obiid, doc, remotesHttp)
-    lift $ forkWorker "Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp (furiHost uContext) obiid doc remotesHttp
+    lift $ forkWorker "Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp (objUriAuthority uContext) obiid doc remotesHttp
     return lmid
     where
     nonEmptyE :: Monad m => [a] -> e -> ExceptT e m (NonEmpty a)
@@ -243,16 +244,16 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
         :: FedURI
         -> Maybe FedURI
         -> ExceptT Text Handler
-            ( Maybe (Either (ShrIdent, LocalMessageId) (Text, LocalURI))
+            ( Maybe (Either (ShrIdent, LocalMessageId) FedURI)
             , [ShrIdent]
             , Maybe (ShrIdent, PrjIdent, Int)
-            , [(Text, NonEmpty LocalURI)]
+            , [(Host, NonEmpty LocalURI)]
             )
     parseRecipsContextParent uContext muParent = do
         (localsSet, remotes) <- do
             mrecips <- parseAudience aud
             fromMaybeE mrecips "Note without recipients"
-        let (hContext, luContext) = f2l uContext
+        let ObjURI hContext luContext = uContext
         parent <- parseParent uContext muParent
         local <- hostIsLocal hContext
         if local
@@ -264,17 +265,17 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
                 shrs <- verifyOnlySharers localsSet
                 return (parent, shrs, Nothing, remotes)
         where
-        parseParent :: FedURI -> Maybe FedURI -> ExceptT Text Handler (Maybe (Either (ShrIdent, LocalMessageId) (Text, LocalURI)))
+        parseParent :: FedURI -> Maybe FedURI -> ExceptT Text Handler (Maybe (Either (ShrIdent, LocalMessageId) FedURI))
         parseParent _        Nothing        = return Nothing
         parseParent uContext (Just uParent) =
             if uParent == uContext
                 then return Nothing
                 else Just <$> do
-                    let (hParent, luParent) = f2l uParent
+                    let ObjURI hParent luParent = uParent
                     parentLocal <- hostIsLocal hParent
                     if parentLocal
                         then Left <$> parseComment luParent
-                        else return $ Right (hParent, luParent)
+                        else return $ Right uParent
 
         parseContextTicket :: Monad m => LocalURI -> ExceptT Text m (ShrIdent, PrjIdent, Int)
         parseContextTicket luContext = do
@@ -326,7 +327,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
         -> Text
         -> Text
         -> Html
-        -> AppDB (LocalMessageId, OutboxItemId, Doc Activity)
+        -> AppDB (LocalMessageId, OutboxItemId, Doc Activity URIMode)
     insertMessage luAttrib shrUser pid obid uContext did muParent meparent source content summary = do
         now <- liftIO getCurrentTime
         mid <- insert Message
@@ -358,7 +359,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
                         }
                     }
                 }
-            tempUri = LocalURI "" ""
+            tempUri = topLocalURI
         obiid <- insert OutboxItem
             { outboxItemOutbox    = obid
             , outboxItemActivity  =
@@ -391,7 +392,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
         -> OutboxItemId
         -> [ShrIdent]
         -> Maybe (SharerId, FollowerSetId, InboxId, FollowerSetId)
-        -> ExceptT Text AppDB [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
+        -> ExceptT Text AppDB [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
     deliverLocal pidAuthor obid recips mticket = do
         recipPids <- traverse getPersonId $ nub recips
         when (pidAuthor `elem` recipPids) $
@@ -446,8 +447,8 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
 offerTicketC
     :: ShrIdent
     -> TextHtml
-    -> Audience
-    -> Offer
+    -> Audience URIMode
+    -> Offer URIMode
     -> Handler (Either Text OutboxItemId)
 offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT $ do
     (hProject, shrProject, prjProject) <- parseTarget uTarget
@@ -631,7 +632,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
                             , activitySummary  = Just summary
                             , activityAudience = Audience recips [] [] [] [] []
                             , activitySpecific = AcceptActivity Accept
-                                { acceptObject = l2f hLocal luOffer
+                                { acceptObject = ObjURI hLocal luOffer
                                 , acceptResult =
                                     encodeRouteLocal $ TicketR shrProject prjProject num
                                 }
@@ -678,11 +679,12 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
                 insert_ $ Follow pidAuthor fsid False
             publishAccept pidAuthor sid jid fsid luOffer num obiid doc = do
                 now <- liftIO getCurrentTime
+                let dont = Authority "dont-do.any-forwarding" Nothing
                 remotesHttp <- do
                     moreRemotes <- deliverLocal now sid fsid obiid
-                    deliverRemoteDB' "dont-do.any-forwarding" obiid [] moreRemotes
+                    deliverRemoteDB' dont obiid [] moreRemotes
                 site <- askSite
-                liftIO $ runWorker (deliverRemoteHttp "dont-do.any-forwarding" obiid doc remotesHttp) site
+                liftIO $ runWorker (deliverRemoteHttp dont obiid doc remotesHttp) site
                 where
                 deliverLocal now sid fsid obiid = do
                     (pidsTeam, remotesTeam) <- getProjectTeam sid
@@ -727,6 +729,6 @@ getFollowersCollection here getFsid = do
             , collectionLast       = Nothing
             , collectionItems      =
                 map (encodeRouteHome . SharerR) locals ++
-                map (uncurry l2f . bimap E.unValue E.unValue) remotes
+                map (uncurry ObjURI . bimap E.unValue E.unValue) remotes
             }
     provideHtmlAndAP followersAP $ redirect (here, [("prettyjson", "true")])
diff --git a/src/Vervis/API/Recipient.hs b/src/Vervis/API/Recipient.hs
index ebf1d9b..92691a3 100644
--- a/src/Vervis/API/Recipient.hs
+++ b/src/Vervis/API/Recipient.hs
@@ -47,6 +47,7 @@ import Yesod.MonadSite
 import Data.List.NonEmpty.Local
 
 import Vervis.ActivityPub
+import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model.Ident
 
@@ -252,7 +253,7 @@ parseRecipients recips = do
     unless (null lusInvalid) $
         throwE $
             "Local recipients are invalid routes: " <>
-            T.pack (show $ map (renderFedURI . l2f hLocal) lusInvalid)
+            T.pack (show $ map (renderObjURI . ObjURI hLocal) lusInvalid)
     unless (null routesInvalid) $ do
         renderUrl <- askUrlRender
         throwE $
@@ -260,10 +261,10 @@ parseRecipients recips = do
             T.pack (show $ map renderUrl routesInvalid)
     return (localsSet, remotes)
     where
-    splitRecipients :: Text -> NonEmpty FedURI -> ([LocalURI], [FedURI])
+    splitRecipients :: Host -> NonEmpty FedURI -> ([LocalURI], [FedURI])
     splitRecipients home recips =
-        let (local, remote) = NE.partition ((== home) . furiHost) recips
-        in  (map (snd . f2l) local, remote)
+        let (local, remote) = NE.partition ((== home) . objUriAuthority) recips
+        in  (map objUriLocal local, remote)
 
     parseLocalRecipients
         :: [LocalURI] -> ([LocalURI], [Route App], LocalRecipientSet)
@@ -287,8 +288,8 @@ parseRecipients recips = do
 
 parseAudience
     :: (MonadSite m, SiteEnv m ~ App)
-    => Audience
-    -> ExceptT Text m (Maybe (LocalRecipientSet, [(Text, NonEmpty LocalURI)]))
+    => Audience URIMode
+    -> ExceptT Text m (Maybe (LocalRecipientSet, [(Host, NonEmpty LocalURI)]))
 parseAudience audience = do
     let recips = concatRecipients audience
     for (nonEmpty recips) $ \ recipsNE -> do
@@ -296,5 +297,5 @@ parseAudience audience = do
         return
             (localsSet, groupByHost $ remotes \\ audienceNonActors audience)
     where
-    groupByHost :: [FedURI] -> [(Text, NonEmpty LocalURI)]
-    groupByHost = groupAllExtract furiHost (snd . f2l)
+    groupByHost :: [FedURI] -> [(Host, NonEmpty LocalURI)]
+    groupByHost = groupAllExtract objUriAuthority objUriLocal
diff --git a/src/Vervis/ActivityPub.hs b/src/Vervis/ActivityPub.hs
index f80ab58..63a6493 100644
--- a/src/Vervis/ActivityPub.hs
+++ b/src/Vervis/ActivityPub.hs
@@ -102,18 +102,19 @@ import Data.List.NonEmpty.Local
 import Data.Tuple.Local
 import Database.Persist.Local
 
+import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.RemoteActorStore
 import Vervis.Settings
 
-hostIsLocal :: (MonadSite m, SiteEnv m ~ App) => Text -> m Bool
+hostIsLocal :: (MonadSite m, SiteEnv m ~ App) => Host -> m Bool
 hostIsLocal h = asksSite $ (== h) . appInstanceHost . appSettings
 
 verifyHostLocal
     :: (MonadSite m, SiteEnv m ~ App)
-    => Text -> Text -> ExceptT Text m ()
+    => Host -> Text -> ExceptT Text m ()
 verifyHostLocal h t = do
     local <- hostIsLocal h
     unless local $ throwE t
@@ -121,9 +122,9 @@ verifyHostLocal h t = do
 parseContext
     :: (MonadSite m, SiteEnv m ~ App)
     => FedURI
-    -> ExceptT Text m (Either (ShrIdent, PrjIdent, Int) (Text, LocalURI))
+    -> ExceptT Text m (Either (ShrIdent, PrjIdent, Int) FedURI)
 parseContext uContext = do
-    let c@(hContext, luContext) = f2l uContext
+    let ObjURI hContext luContext = uContext
     local <- hostIsLocal hContext
     if local
         then Left <$> do
@@ -133,14 +134,14 @@ parseContext uContext = do
             case route of
                 TicketR shr prj num -> return (shr, prj, num)
                 _ -> throwE "Local context isn't a ticket route"
-        else return $ Right c
+        else return $ Right uContext
 
 parseParent
     :: (MonadSite m, SiteEnv m ~ App)
     => FedURI
-    -> ExceptT Text m (Either (ShrIdent, LocalMessageId) (Text, LocalURI))
+    -> ExceptT Text m (Either (ShrIdent, LocalMessageId) FedURI)
 parseParent uParent = do
-    let p@(hParent, luParent) = f2l uParent
+    let ObjURI hParent luParent = uParent
     local <- hostIsLocal hParent
     if local
         then Left <$> do
@@ -154,7 +155,7 @@ parseParent uParent = do
                             "Local parent has non-existent message \
                             \hashid"
                 _ -> throwE "Local parent isn't a message route"
-        else return $ Right p
+        else return $ Right uParent
 
 newtype FedError = FedError Text deriving Show
 
@@ -183,7 +184,7 @@ getLocalParentMessageId did shr lmid = do
         throwE "Local parent belongs to a different discussion"
     return mid
 
-concatRecipients :: Audience -> [FedURI]
+concatRecipients :: Audience u -> [ObjURI u]
 concatRecipients (Audience to bto cc bcc gen _) = concat [to, bto, cc, bcc, gen]
 
 getPersonOrGroupId :: SharerId -> AppDB (Either PersonId GroupId)
@@ -194,7 +195,7 @@ getPersonOrGroupId sid = do
         "Found sharer that is neither person nor group"
         "Found sharer that is both person and group"
 
-getTicketTeam :: SharerId -> AppDB ([PersonId], [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))])
+getTicketTeam :: SharerId -> AppDB ([PersonId], [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))])
 getTicketTeam sid = do
     id_ <- getPersonOrGroupId sid
     (,[]) <$> case id_ of
@@ -205,7 +206,7 @@ getTicketTeam sid = do
 
 getProjectTeam = getTicketTeam
 
-getFollowers :: FollowerSetId -> AppDB ([PersonId], [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))])
+getFollowers :: FollowerSetId -> AppDB ([PersonId], [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))])
 getFollowers fsid = do
     local <- selectList [FollowTarget ==. fsid] [Asc FollowPerson]
     remote <- E.select $ E.from $ \ (rf `E.InnerJoin` rs `E.InnerJoin` i) -> do
@@ -230,15 +231,15 @@ getFollowers fsid = do
                 remote
         )
     where
-    groupRemotes :: [(InstanceId, Text, RemoteActorId, LocalURI, LocalURI, Maybe UTCTime)] -> [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
+    groupRemotes :: [(InstanceId, Host, RemoteActorId, LocalURI, LocalURI, Maybe UTCTime)] -> [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
     groupRemotes = groupWithExtractBy ((==) `on` fst) fst snd . map toTuples
         where
         toTuples (iid, h, rsid, luA, luI, ms) = ((iid, h), (rsid, luA, luI, ms))
 
 unionRemotes
-    :: [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
-    -> [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
-    -> [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
+    :: [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
+    -> [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
+    -> [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
 unionRemotes = unionGroupsOrdWith fst fst4
 
 insertMany' mk xs = zip' xs <$> insertMany (NE.toList $ mk <$> xs)
@@ -271,32 +272,32 @@ isInstanceErrorG (Just e) =
 
 deliverHttp
     :: (MonadSite m, SiteEnv m ~ App)
-    => Doc Activity
+    => Doc Activity URIMode
     -> Maybe LocalURI
-    -> Text
+    -> Host
     -> LocalURI
     -> m (Either APPostError (Response ()))
 deliverHttp doc mfwd h luInbox =
-    deliverActivity (l2f h luInbox) (l2f h <$> mfwd) doc
+    deliverActivity (ObjURI h luInbox) (ObjURI h <$> mfwd) doc
 
 deliverHttpBL
     :: (MonadSite m, SiteEnv m ~ App)
     => BL.ByteString
     -> Maybe LocalURI
-    -> Text
+    -> Host
     -> LocalURI
     -> m (Either APPostError (Response ()))
 deliverHttpBL body mfwd h luInbox =
-    deliverActivityBL' (l2f h luInbox) (l2f h <$> mfwd) body
+    deliverActivityBL' (ObjURI h luInbox) (ObjURI h <$> mfwd) body
 
 deliverRemoteDB
     :: BL.ByteString
     -> RemoteActivityId
     -> ProjectId
     -> ByteString
-    -> [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
+    -> [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
     -> AppDB
-        [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, ForwardingId))]
+        [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, ForwardingId))]
 deliverRemoteDB body ractid jid sig recips = do
     let body' = BL.toStrict body
         deliv raid msince = Forwarding raid ractid body' jid sig $ isNothing msince
@@ -316,12 +317,12 @@ deliverRemoteHTTP
     -> PrjIdent
     -> BL.ByteString
     -> ByteString
-    -> [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, ForwardingId))]
+    -> [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, ForwardingId))]
     -> Handler ()
 deliverRemoteHTTP now shrRecip prjRecip body sig fetched = do
     let deliver h inbox =
             let sender = ProjectR shrRecip prjRecip
-            in  forwardActivity (l2f h inbox) sig sender body
+            in  forwardActivity (ObjURI h inbox) sig sender body
     traverse_ (fork . deliverFetched deliver now) fetched
     where
     fork = forkHandler $ \ e -> logError $ "Project inbox handler: delivery failed! " <> T.pack (displayException e)
@@ -386,7 +387,7 @@ checkForward shrRecip prjRecip = join <$> do
             Just h -> return h
 
 parseTarget u = do
-    let (h, lu) = f2l u
+    let ObjURI h lu = u
     (shr, prj) <- parseProject lu
     return (h, shr, prj)
     where
@@ -437,14 +438,14 @@ data Recip
     | RecipRC (Entity RemoteCollection)
 
 deliverRemoteDB'
-    :: Text
+    :: Host
     -> OutboxItemId
-    -> [(Text, NonEmpty LocalURI)]
-    -> [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
+    -> [(Host, NonEmpty LocalURI)]
+    -> [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
     -> AppDB
-        ( [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, DeliveryId))]
-        , [((InstanceId, Text), NonEmpty (UnfetchedRemoteActorId, LocalURI, UnlinkedDeliveryId))]
-        , [((InstanceId, Text), NonEmpty (UnfetchedRemoteActorId, LocalURI, UnlinkedDeliveryId))]
+        ( [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, DeliveryId))]
+        , [((InstanceId, Host), NonEmpty (UnfetchedRemoteActorId, LocalURI, UnlinkedDeliveryId))]
+        , [((InstanceId, Host), NonEmpty (UnfetchedRemoteActorId, LocalURI, UnlinkedDeliveryId))]
         )
 deliverRemoteDB' hContext obid recips known = do
     recips' <- for recips $ \ (h, lus) -> do
@@ -503,12 +504,12 @@ deliverRemoteDB' hContext obid recips known = do
         noError ((_ , _  , _  , Just _ ), _  ) = Nothing
 
 deliverRemoteHttp
-    :: Text
+    :: Host
     -> OutboxItemId
-    -> Doc Activity
-    -> ( [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, DeliveryId))]
-        , [((InstanceId, Text), NonEmpty (UnfetchedRemoteActorId, LocalURI, UnlinkedDeliveryId))]
-        , [((InstanceId, Text), NonEmpty (UnfetchedRemoteActorId, LocalURI, UnlinkedDeliveryId))]
+    -> Doc Activity URIMode
+    -> ( [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, DeliveryId))]
+        , [((InstanceId, Host), NonEmpty (UnfetchedRemoteActorId, LocalURI, UnlinkedDeliveryId))]
+        , [((InstanceId, Host), NonEmpty (UnfetchedRemoteActorId, LocalURI, UnlinkedDeliveryId))]
         )
     -> Worker ()
 deliverRemoteHttp hContext obid doc (fetched, unfetched, unknown) = do
@@ -518,16 +519,17 @@ deliverRemoteHttp hContext obid doc (fetched, unfetched, unknown) = do
             (isJust fwd',) <$> deliverHttp doc fwd' h inbox
     now <- liftIO getCurrentTime
     logDebug' $
-        "Launching fetched " <> T.pack (show $ map (snd . fst) fetched)
+        "Launching fetched " <> showHosts fetched
     traverse_ (fork . deliverFetched deliver now) fetched
     logDebug' $
-        "Launching unfetched " <> T.pack (show $ map (snd . fst) unfetched)
+        "Launching unfetched " <> showHosts unfetched
     traverse_ (fork . deliverUnfetched deliver now) unfetched
     logDebug' $
-        "Launching unknown " <> T.pack (show $ map (snd . fst) unknown)
+        "Launching unknown " <> showHosts unknown
     traverse_ (fork . deliverUnfetched deliver now) unknown
     logDebug' "Done (async delivery may still be running)"
     where
+    showHosts = T.pack . show . map (renderAuthority . snd . fst)
     logDebug' t = logDebug $ prefix <> t
         where
         prefix =
@@ -545,7 +547,7 @@ deliverRemoteHttp hContext obid doc (fetched, unfetched, unknown) = do
                 Left err -> do
                     logError $ T.concat
                         [ "Outbox DL delivery #", T.pack $ show dlid
-                        , " error for <", renderFedURI $ l2f h luActor
+                        , " error for <", renderObjURI $ ObjURI h luActor
                         , ">: ",  T.pack $ displayException err
                         ]
                     return $
@@ -573,14 +575,14 @@ deliverRemoteHttp hContext obid doc (fetched, unfetched, unknown) = do
                                 Left err -> do
                                     logError $ T.concat
                                         [ "Outbox DL delivery #", T.pack $ show dlid
-                                        , " error for <", renderFedURI $ l2f h luActor
+                                        , " error for <", renderObjURI $ ObjURI h luActor
                                         , ">: ",  T.pack $ displayException err
                                         ]
                                     updateWhere [RemoteActorId ==. raid, RemoteActorErrorSince ==. Nothing] [RemoteActorErrorSince =. Just now]
                                     update dlid [DeliveryRunning =. False]
                                 Right _resp -> delete dlid
         where
-        logDebug'' t = logDebug' $ T.concat ["deliverFetched ", h, t]
+        logDebug'' t = logDebug' $ T.concat ["deliverFetched ", renderAuthority h, t]
     deliverUnfetched deliver now ((iid, h), recips@(r :| rs)) = do
         logDebug'' "Starting"
         let (uraid, luActor, udlid) = r
@@ -634,4 +636,4 @@ deliverRemoteHttp hContext obid doc (fetched, unfetched, unknown) = do
                                             insert_ $ Delivery raid obid fwd False
                                         Right _ -> delete udlid
         where
-        logDebug'' t = logDebug' $ T.concat ["deliverUnfetched ", h, t]
+        logDebug'' t = logDebug' $ T.concat ["deliverUnfetched ", renderAuthority h, t]
diff --git a/src/Vervis/Discussion.hs b/src/Vervis/Discussion.hs
index 7870d52..5fc2a59 100644
--- a/src/Vervis/Discussion.hs
+++ b/src/Vervis/Discussion.hs
@@ -20,7 +20,6 @@ module Vervis.Discussion
     )
 where
 
-import Control.Arrow (second)
 import Data.Graph.Inductive.Graph (mkGraph, lab')
 import Data.Graph.Inductive.PatriciaTree (Gr)
 import Data.Graph.Inductive.Query.DFS (dffWith)
@@ -35,12 +34,14 @@ import qualified Data.HashMap.Lazy as M (fromList, lookup)
 import Network.FedURI
 
 import Data.Tree.Local (sortForestOn)
+
+import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model
 
 data MessageTreeNodeAuthor
     = MessageTreeNodeLocal LocalMessageId Sharer
-    | MessageTreeNodeRemote Text LocalURI LocalURI (Maybe Text)
+    | MessageTreeNodeRemote Host LocalURI LocalURI (Maybe Text)
 
 data MessageTreeNode = MessageTreeNode
     { mtnMessageId :: MessageId
diff --git a/src/Vervis/FedURI.hs b/src/Vervis/FedURI.hs
new file mode 100644
index 0000000..b3a8530
--- /dev/null
+++ b/src/Vervis/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/>.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Vervis.FedURI
+    ( URIMode
+    , Host
+    , FedURI
+    , FedSubURI
+    , FedPageURI
+    )
+where
+
+import Network.FedURI
+
+#if DEVELOPMENT
+type URIMode = Dev
+#else
+type URIMode = Fed
+#endif
+
+type Host       = Authority URIMode
+type FedURI     = ObjURI URIMode
+type FedSubURI  = SubURI URIMode
+type FedPageURI = PageURI URIMode
diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs
index 16b35d8..5bb2bc7 100644
--- a/src/Vervis/Federation.hs
+++ b/src/Vervis/Federation.hs
@@ -368,17 +368,17 @@ retryOutboxDelivery = do
 
     logDebug $
         "Periodic delivery forking linked " <>
-        T.pack (show $ map (snd . fst) dls)
+        T.pack (show $ map (renderAuthority . snd . fst) dls)
     waitsDL <- traverse (fork . deliverLinked deliver now) dls
 
     logDebug $
         "Periodic delivery forking forwarding " <>
-        T.pack (show $ map (snd . fst) fws)
+        T.pack (show $ map (renderAuthority . snd . fst) fws)
     waitsFW <- traverse (fork . deliverForwarding now) fws
 
     logDebug $
         "Periodic delivery forking unlinked " <>
-        T.pack (show $ map (snd . fst) udls)
+        T.pack (show $ map (renderAuthority . snd . fst) udls)
     waitsUDL <- traverse (fork . deliverUnlinked deliver now) udls
 
     logDebug $
@@ -474,11 +474,11 @@ retryOutboxDelivery = do
                     return False
                 Right success -> return success
     deliverLinked deliver now ((_, h), recips) = do
-        logDebug $ "Periodic deliver starting linked for host " <> h
+        logDebug $ "Periodic deliver starting linked for host " <> renderAuthority h
         waitsR <- for recips $ \ ((raid, (ident, inbox)), delivs) -> fork $ do
             logDebug $
                 "Periodic deliver starting linked for actor " <>
-                renderFedURI (l2f h ident)
+                renderObjURI (ObjURI h ident)
             waitsD <- for delivs $ \ (dlid, fwd, doc) -> fork $ do
                 let fwd' = if fwd then Just ident else Nothing
                 e <- deliver doc fwd' h inbox
@@ -486,7 +486,7 @@ retryOutboxDelivery = do
                     Left err -> do
                         logError $ T.concat
                             [ "Periodic DL delivery #", T.pack $ show dlid
-                            , " error for <", renderFedURI $ l2f h ident, ">: "
+                            , " error for <", renderObjURI $ ObjURI h ident, ">: "
                             ,  T.pack $ displayException err
                             ]
                         return False
@@ -503,14 +503,14 @@ retryOutboxDelivery = do
             return True
         results <- sequence waitsR
         unless (and results) $
-            logError $ "Periodic DL delivery error for host " <> h
+            logError $ "Periodic DL delivery error for host " <> renderAuthority h
         return True
     deliverUnlinked deliver now ((iid, h), recips) = do
-        logDebug $ "Periodic deliver starting unlinked for host " <> h
+        logDebug $ "Periodic deliver starting unlinked for host " <> renderAuthority h
         waitsR <- for recips $ \ ((uraid, luRecip), delivs) -> fork $ do
             logDebug $
                 "Periodic deliver starting unlinked for actor " <>
-                renderFedURI (l2f h luRecip)
+                renderObjURI (ObjURI h luRecip)
             e <- fetchRemoteActor iid h luRecip
             case e of
                 Right (Right mera) ->
@@ -540,16 +540,16 @@ retryOutboxDelivery = do
             return True
         results <- sequence waitsR
         unless (and results) $
-            logError $ "Periodic UDL delivery error for host " <> h
+            logError $ "Periodic UDL delivery error for host " <> renderAuthority h
         return True
     deliverForwarding now ((_, h), recips) = do
-        logDebug $ "Periodic deliver starting forwarding for host " <> h
+        logDebug $ "Periodic deliver starting forwarding for host " <> renderAuthority h
         waitsR <- for recips $ \ ((raid, inbox), delivs) -> fork $ do
             logDebug $
                 "Periodic deliver starting forwarding for inbox " <>
-                renderFedURI (l2f h inbox)
+                renderObjURI (ObjURI h inbox)
             waitsD <- for delivs $ \ (fwid, body, sender, sig) -> fork $ do
-                e <- forwardActivity (l2f h inbox) sig sender body
+                e <- forwardActivity (ObjURI h inbox) sig sender body
                 case e of
                     Left _err -> return False
                     Right _resp -> do
@@ -565,5 +565,5 @@ retryOutboxDelivery = do
             return True
         results <- sequence waitsR
         unless (and results) $
-            logError $ "Periodic FW delivery error for host " <> h
+            logError $ "Periodic FW delivery error for host " <> renderAuthority h
         return True
diff --git a/src/Vervis/Federation/Auth.hs b/src/Vervis/Federation/Auth.hs
index 01ca2b8..ffe0558 100644
--- a/src/Vervis/Federation/Auth.hs
+++ b/src/Vervis/Federation/Auth.hs
@@ -94,6 +94,7 @@ import Yesod.Persist.Local
 
 import Vervis.ActivityPub
 import Vervis.ActorKey
+import Vervis.FedURI
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
@@ -114,14 +115,22 @@ data ActivityAuthentication
 data ActivityBody = ActivityBody
     { actbBL         :: BL.ByteString
     , actbObject     :: Object
-    , actbActivity   :: Activity
+    , actbActivity   :: Activity URIMode
     }
 
 parseKeyId (KeyId k) =
-    case fmap f2l . parseFedURI =<< (first displayException . decodeUtf8') k of
+    case parseRefURI =<< (first displayException . decodeUtf8') k of
         Left e -> throwE $ "keyId isn't a valid FedURI: " ++ e
         Right u -> return u
 
+verifyActorSig'
+    :: Maybe Algorithm
+    -> ByteString
+    -> Signature
+    -> Host
+    -> LocalRefURI
+    -> Maybe LocalURI
+    -> ExceptT String Handler RemoteAuthor
 verifyActorSig' malgo input (Signature signature) host luKey mluActorHeader = do
     manager <- getsYesod appHttpManager
     (inboxOrVkid, vkd) <- do
@@ -201,7 +210,7 @@ verifyActorSig' malgo input (Signature signature) host luKey mluActorHeader = do
                         else errSig2
 
     return RemoteAuthor
-        { remoteAuthorURI      = l2f host $ vkdActorId vkd
+        { remoteAuthorURI      = ObjURI host $ vkdActorId vkd
         , remoteAuthorInstance = iid
         , remoteAuthorId       = rsid
         -- , actdRawBody   = body
@@ -225,7 +234,7 @@ verifyActorSig' malgo input (Signature signature) host luKey mluActorHeader = do
 
 verifyActorSig :: Verification -> ExceptT String Handler RemoteAuthor
 verifyActorSig (Verification malgo keyid input signature) = do
-    (host, luKey) <- parseKeyId keyid
+    RefURI host luKey <- parseKeyId keyid
     checkHost host
     mluActorHeader <- getActorHeader host
     verifyActorSig' malgo input signature host luKey mluActorHeader
@@ -240,15 +249,19 @@ verifyActorSig (Verification malgo keyid input signature) = do
             [] -> return Nothing
             [b] -> fmap Just . ExceptT . pure $ do
                 t <- first displayException $ decodeUtf8' b
-                (h, lu) <- f2l <$> parseFedURI t
-                if h == host
-                    then Right ()
-                    else Left "Key and actor have different hosts"
+                ObjURI h lu <- parseObjURI t
+                unless (h == host) $
+                    Left "Key and actor have different hosts"
                 Right lu
             _ -> throwE "Multiple ActivityPub-Actor headers"
 
-verifySelfSig :: LocalURI -> LocalURI -> ByteString -> Signature -> ExceptT String Handler (Either PersonId ProjectId)
-verifySelfSig luAuthor luKey input (Signature sig) = do
+verifySelfSig
+    :: LocalURI
+    -> LocalRefURI
+    -> ByteString
+    -> Signature
+    -> ExceptT String Handler (Either PersonId ProjectId)
+verifySelfSig luAuthor (LocalRefURI lruKey) input (Signature sig) = do
     author <- do
         route <-
             case decodeRouteLocal luAuthor of
@@ -259,7 +272,11 @@ verifySelfSig luAuthor luKey input (Signature sig) = do
             ProjectR shr prj -> return $ Right (shr, prj)
             _ -> throwE "Local author ID isn't an actor route"
     akey <- do
-        route <-
+        route <- do
+            luKey <-
+                case lruKey of
+                    Left l -> return l
+                    Right _ -> throwE "Local key ID has a fragment"
             case decodeRouteLocal luKey of
                 Nothing -> throwE "Local key ID isn't a valid route"
                 Just r -> return r
@@ -286,9 +303,13 @@ verifySelfSig luAuthor luKey input (Signature sig) = do
         sid <- MaybeT $ getKeyBy $ UniqueSharer shr
         MaybeT $ getKeyBy $ UniqueProject prj sid
 
-verifyForwardedSig :: Text -> LocalURI -> Verification -> ExceptT String Handler ActivityAuthentication
+verifyForwardedSig
+    :: Host
+    -> LocalURI
+    -> Verification
+    -> ExceptT String Handler ActivityAuthentication
 verifyForwardedSig hAuthor luAuthor (Verification malgo keyid input signature) = do
-    (hKey, luKey) <- parseKeyId keyid
+    RefURI hKey luKey <- parseKeyId keyid
     unless (hAuthor == hKey) $
         throwE "Author and forwarded sig key on different hosts"
     local <- hostIsLocal hKey
@@ -326,25 +347,26 @@ authenticateActivity now = do
         return (remoteAuthor, wvdoc, body)
     let WithValue raw (Doc hActivity activity) = wv
         uSender = remoteAuthorURI ra
-        (hSender, luSender) = f2l uSender
+        ObjURI hSender luSender = uSender
     auth <-
         if hSender == hActivity
             then do
                 unless (activityActor activity == luSender) $
                     throwE $ T.concat
                         [ "Activity's actor <"
-                        , renderFedURI $ l2f hActivity $ activityActor activity
-                        , "> != Signature key's actor <", renderFedURI uSender
+                        , renderObjURI $
+                            ObjURI hActivity $ activityActor activity
+                        , "> != Signature key's actor <", renderObjURI uSender
                         , ">"
                         ]
                 return $ ActivityAuthRemote ra
             else do
-                -- TODO CONTINUE
                 ma <- checkForward uSender hActivity (activityActor activity)
                 case ma of
                     Nothing -> throwE $ T.concat
-                        [ "Activity host <", hActivity
-                        , "> doesn't match signature key host <", hSender, ">"
+                        [ "Activity host <", renderAuthority hActivity
+                        , "> doesn't match signature key host <"
+                        , renderAuthority hSender, ">"
                         ]
                     Just a -> return a
     return (auth, ActivityBody body raw activity)
@@ -395,6 +417,6 @@ authenticateActivity now = do
                         [] -> throwE "ActivityPub-Forwarder header missing"
                         [x] -> return x
                         _ -> throwE "Multiple ActivityPub-Forwarder"
-                case parseFedURI =<< (first displayException . decodeUtf8') fwd of
+                case parseObjURI =<< (first displayException . decodeUtf8') fwd of
                     Left e -> throwE $ "ActivityPub-Forwarder isn't a valid FedURI: " <> T.pack e
                     Right u -> return u
diff --git a/src/Vervis/Federation/Discussion.hs b/src/Vervis/Federation/Discussion.hs
index 72e1d93..e2cb5b8 100644
--- a/src/Vervis/Federation/Discussion.hs
+++ b/src/Vervis/Federation/Discussion.hs
@@ -92,6 +92,7 @@ import Yesod.Persist.Local
 
 import Vervis.ActivityPub
 --import Vervis.ActorKey
+import Vervis.FedURI
 import Vervis.Federation.Auth
 import Vervis.Foundation
 import Vervis.Model
@@ -104,7 +105,7 @@ sharerCreateNoteF
     -> ShrIdent
     -> RemoteAuthor
     -> ActivityBody
-    -> Note
+    -> Note URIMode
     -> ExceptT Text Handler Text
 sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext mpublished _ _) = do
     luCreate <-
@@ -143,7 +144,7 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
                     case parent of
                         Left (shrP, lmidP) ->
                             void $ getLocalParentMessageId did shrP lmidP
-                        Right (hParent, luParent) -> do
+                        Right (ObjURI hParent luParent) -> do
                             mrm <- lift $ runMaybeT $ do
                                 iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
                                 MaybeT $ getValBy $ UniqueRemoteMessageIdent iid luParent
@@ -152,7 +153,7 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
                                 m <- lift $ getJust mid
                                 unless (messageRoot m == did) $
                                     throwE "Remote parent belongs to a different discussion"
-            Right (hContext, luContext) -> do
+            Right (ObjURI hContext luContext) -> do
                 mdid <- lift $ runMaybeT $ do
                     iid <- MaybeT $ getKeyBy $ UniqueInstance hContext
                     rd <- MaybeT $ getValBy $ UniqueRemoteDiscussionIdent iid luContext
@@ -162,7 +163,7 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
                         Left (shrP, lmidP) -> do
                             did <- fromMaybeE mdid "Local parent inexistent, no RemoteDiscussion"
                             void $ getLocalParentMessageId did shrP lmidP
-                        Right (hParent, luParent) -> do
+                        Right (ObjURI hParent luParent) -> do
                             mrm <- lift $ runMaybeT $ do
                                 iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
                                 MaybeT $ getValBy $ UniqueRemoteMessageIdent iid luParent
@@ -198,7 +199,7 @@ projectCreateNoteF
     -> PrjIdent
     -> RemoteAuthor
     -> ActivityBody
-    -> Note
+    -> Note URIMode
     -> ExceptT Text Handler Text
 projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent muCtx mpub src content) = do
     luCreate <-
@@ -243,7 +244,7 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
     findRelevantCollections hLocal numCtx = nub . mapMaybe decide . concatRecipients
         where
         decide u = do
-            let (h, lu) = f2l u
+            let ObjURI h lu = u
             guard $ h == hLocal
             route <- decodeRouteLocal lu
             case route of
@@ -269,7 +270,7 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
         meparent <- for mparent $ \ parent ->
             case parent of
                 Left (shrParent, lmidParent) -> Left <$> getLocalParentMessageId did shrParent lmidParent
-                Right p@(hParent, luParent) -> do
+                Right p@(ObjURI hParent luParent) -> do
                     mrm <- lift $ runMaybeT $ do
                         iid <- MaybeT $ getKeyBy $ UniqueInstance hParent
                         MaybeT $ getValBy $ UniqueRemoteMessageIdent iid luParent
@@ -280,7 +281,7 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
                             unless (messageRoot m == did) $
                                 throwE "Remote parent belongs to a different discussion"
                             return mid
-                        Nothing -> return $ Right $ l2f hParent luParent
+                        Nothing -> return $ Right p
         return (sid, fsidProject, ticketFollowers t, jid, ibid, did, meparent)
     insertToDiscussion luCreate luNote published ibid did meparent fsid = do
         let iidAuthor = remoteAuthorInstance author
@@ -322,8 +323,8 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
                 insert_ $ InboxItemRemote ibid ractid ibiid
                 return $ Just (ractid, mid)
     updateOrphans luNote did mid = do
-        let hAuthor = furiHost $ remoteAuthorURI author
-            uNote = l2f hAuthor luNote
+        let hAuthor = objUriAuthority $ remoteAuthorURI author
+            uNote = ObjURI hAuthor luNote
         related <- selectOrphans uNote (E.==.)
         for_ related $ \ (E.Value rmidOrphan, E.Value midOrphan) -> do
             logWarn $ T.concat
@@ -357,7 +358,7 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
         -> SharerId
         -> FollowerSetId
         -> FollowerSetId
-        -> AppDB [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
+        -> AppDB [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
     deliverLocal ractid recips sid fsidProject fsidTicket = do
         (teamPids, teamRemotes) <-
             if CreateNoteRecipTicketTeam `elem` recips
diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs
index ab62885..8a1b2aa 100644
--- a/src/Vervis/Federation/Ticket.hs
+++ b/src/Vervis/Federation/Ticket.hs
@@ -65,6 +65,7 @@ import Database.Persist.Local
 import Yesod.Persist.Local
 
 import Vervis.ActivityPub
+import Vervis.FedURI
 import Vervis.Federation.Auth
 import Vervis.Foundation
 import Vervis.Model
@@ -72,7 +73,11 @@ import Vervis.Model.Ident
 import Vervis.Model.Ticket
 
 checkOffer
-    :: AP.Ticket -> Text -> ShrIdent -> PrjIdent -> ExceptT Text Handler ()
+    :: AP.Ticket URIMode
+    -> Host
+    -> ShrIdent
+    -> PrjIdent
+    -> ExceptT Text Handler ()
 checkOffer ticket hProject shrProject prjProject = do
     verifyNothingE (AP.ticketLocal ticket) "Ticket with 'id'"
     verifyNothingE (AP.ticketPublished ticket) "Ticket with 'published'"
@@ -86,7 +91,7 @@ sharerOfferTicketF
     -> ShrIdent
     -> RemoteAuthor
     -> ActivityBody
-    -> Offer
+    -> Offer URIMode
     -> ExceptT Text Handler Text
 sharerOfferTicketF now shrRecip author body (Offer ticket uTarget) = do
     (hProject, shrProject, prjProject) <- parseTarget uTarget
@@ -133,7 +138,7 @@ sharerAcceptOfferTicketF
     -> ShrIdent
     -> RemoteAuthor
     -> ActivityBody
-    -> Accept
+    -> Accept URIMode
     -> ExceptT Text Handler Text
 sharerAcceptOfferTicketF now shrRecip author body (Accept _uOffer _luTicket) = do
     luAccept <-
@@ -164,7 +169,7 @@ sharerRejectOfferTicketF
     -> ShrIdent
     -> RemoteAuthor
     -> ActivityBody
-    -> Reject
+    -> Reject URIMode
     -> ExceptT Text Handler Text
 sharerRejectOfferTicketF now shrRecip author body (Reject _uOffer) = do
     luReject <-
@@ -201,7 +206,7 @@ projectOfferTicketF
     -> PrjIdent
     -> RemoteAuthor
     -> ActivityBody
-    -> Offer
+    -> Offer URIMode
     -> ExceptT Text Handler Text
 projectOfferTicketF
     now shrRecip prjRecip author body (Offer ticket uTarget) = do
@@ -210,7 +215,7 @@ projectOfferTicketF
             Left t -> do
                 logWarn $ T.concat
                     [ recip, " got Offer Ticket with target "
-                    , renderFedURI uTarget
+                    , renderObjURI uTarget
                     ]
                 return t
             Right () -> do
@@ -245,7 +250,7 @@ projectOfferTicketF
     where
     recip = T.concat ["/s/", shr2text shrRecip, "/p/", prj2text prjRecip]
     checkTarget = do
-        let (h, lu) = f2l uTarget
+        let ObjURI h lu = uTarget
         local <- hostIsLocal h
         unless local $
             throwE $ recip <> " not using; target has different host"
@@ -266,7 +271,7 @@ projectOfferTicketF
     findRelevantCollections hLocal = nub . mapMaybe decide . concatRecipients
         where
         decide u = do
-            let (h, lu) = f2l u
+            let ObjURI h lu = u
             guard $ h == hLocal
             route <- decodeRouteLocal lu
             case route of
@@ -329,7 +334,7 @@ projectOfferTicketF
         -> [OfferTicketRecipColl]
         -> SharerId
         -> FollowerSetId
-        -> AppDB [((InstanceId, Text), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
+        -> AppDB [((InstanceId, Host), NonEmpty (RemoteActorId, LocalURI, LocalURI, Maybe UTCTime))]
     deliverLocal ractid recips sid fsid = do
         (teamPids, teamRemotes) <-
             if OfferTicketRecipProjectTeam `elem` recips
@@ -363,7 +368,7 @@ projectOfferTicketF
                     withUrlRenderer
                         [hamlet|
                             <p>
-                              <a href="#{renderFedURI $ remoteAuthorURI author}">
+                              <a href="#{renderObjURI $ remoteAuthorURI author}">
                                 (?)
                               's ticket accepted by project #
                               <a href=@{ProjectR shrRecip prjRecip}>
@@ -389,7 +394,9 @@ projectOfferTicketF
                     , activityAudience = Audience recips [] [] [] [] []
                     , activitySpecific = AcceptActivity Accept
                         { acceptObject =
-                            l2f (furiHost $ remoteAuthorURI author) luOffer
+                            ObjURI
+                                (objUriAuthority $ remoteAuthorURI author)
+                                luOffer
                         , acceptResult =
                             encodeRouteLocal $ TicketR shrRecip prjRecip num
                         }
@@ -408,6 +415,7 @@ projectOfferTicketF
 
     publishAccept luOffer num obiid doc = do
         now <- liftIO getCurrentTime
+        let dont = Authority "dont-do.any-forwarding" Nothing
         remotesHttp <- runDB $ do
             (sid, project) <- do
                 sid <- fromJust <$> getKeyBy (UniqueSharer shrRecip)
@@ -418,12 +426,12 @@ projectOfferTicketF
             ra <- getJust raidAuthor
             let raInfo = (raidAuthor, remoteActorIdent ra, remoteActorInbox ra, remoteActorErrorSince ra)
                 iidAuthor = remoteAuthorInstance author
-                hAuthor = furiHost $ remoteAuthorURI author
+                hAuthor = objUriAuthority $ remoteAuthorURI author
                 hostSection = ((iidAuthor, hAuthor), raInfo :| [])
                 remotes = unionRemotes [hostSection] moreRemotes
-            deliverRemoteDB' "dont-do.any-forwarding" obiid [] remotes
+            deliverRemoteDB' dont obiid [] remotes
         site <- askSite
-        liftIO $ runWorker (deliverRemoteHttp "dont-do.any-forwarding" obiid doc remotesHttp) site
+        liftIO $ runWorker (deliverRemoteHttp dont obiid doc remotesHttp) site
         where
         deliverLocal now sid fsid obiid = do
             (pidsTeam, remotesTeam) <- getProjectTeam sid
diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs
index a9e6985..42b22c2 100644
--- a/src/Vervis/Foundation.hs
+++ b/src/Vervis/Foundation.hs
@@ -82,6 +82,7 @@ import Network.FedURI
 import Web.ActivityAccess
 import Web.ActivityPub hiding (TicketDependency)
 import Yesod.ActivityPub
+import Yesod.FedURI
 import Yesod.Hashids
 import Yesod.MonadSite
 
@@ -91,6 +92,7 @@ import Yesod.Paginate.Local
 
 import Vervis.Access
 import Vervis.ActorKey
+import Vervis.FedURI
 import Vervis.Model
 import Vervis.Model.Group
 import Vervis.Model.Ident
@@ -160,11 +162,15 @@ type WorkerDB = PersistConfigBackend (SitePersistConfig App) Worker
 
 instance Site App where
     type SitePersistConfig App = PostgresConf
-    siteApproot       = ("https://" <>) . appInstanceHost . appSettings
+    siteApproot       =
+        renderObjURI . flip ObjURI topLocalURI . appInstanceHost . appSettings
     sitePersistConfig = appDatabaseConf . appSettings
     sitePersistPool   = appConnPool
     siteLogger        = appLogger
 
+instance SiteFedURI App where
+    type SiteFedURIMode App = URIMode
+
 -- Please see the documentation for the Yesod typeclass. There are a number
 -- of settings which can be configured by overriding methods here.
 instance Yesod App where
@@ -204,11 +210,15 @@ instance Yesod App where
                 defaultCsrfHeaderName
                 defaultCsrfParamName
           )
-        . ( \ handler ->
+        . ( \ handler -> do
+                {-
                 if developmentMode
                     then handler
                     else do
-                        host <- getsYesod $ appInstanceHost . appSettings
+                -}
+                        host <-
+                            getsYesod $
+                                renderAuthority . appInstanceHost . appSettings
                         bs <- lookupHeaders hHost
                         case bs of
                             [b] | b == encodeUtf8 host -> handler
diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs
index 3760444..3cf4213 100644
--- a/src/Vervis/Handler/Discussion.hs
+++ b/src/Vervis/Handler/Discussion.hs
@@ -55,8 +55,9 @@ import Yesod.Persist.Local
 
 import Vervis.API
 import Vervis.Discussion
-import Vervis.Form.Discussion
 import Vervis.Federation
+import Vervis.FedURI
+import Vervis.Form.Discussion
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident
@@ -134,7 +135,7 @@ getDiscussionMessage shr lmid = do
                     return $ route2fed $ TicketR shr prj $ ticketNumber t
                 (Nothing, Just rd) -> do
                     i <- getJust $ remoteDiscussionInstance rd
-                    return $ l2f (instanceHost i) (remoteDiscussionIdent rd)
+                    return $ ObjURI (instanceHost i) (remoteDiscussionIdent rd)
         muParent <- for (messageParent m) $ \ midParent -> do
             mlocal <- getBy $ UniqueLocalMessage midParent
             mremote <- getValBy $ UniqueRemoteMessage midParent
@@ -149,7 +150,7 @@ getDiscussionMessage shr lmid = do
                 (Nothing, Just rmParent) -> do
                     rs <- getJust $ remoteMessageAuthor rmParent
                     i <- getJust $ remoteActorInstance rs
-                    return $ l2f (instanceHost i) (remoteActorIdent rs)
+                    return $ ObjURI (instanceHost i) (remoteActorIdent rs)
         --ob <- getJust $ localMessageCreate lm
         --let activity = docValue $ persistJSONValue $ outboxItemActivity ob
 
@@ -183,7 +184,7 @@ getTopReply replyP = do
     defaultLayout $(widgetFile "discussion/top-reply")
 
 postTopReply
-    :: Text
+    :: Host
     -> [Route App]
     -> [Route App]
     -> Route App
@@ -199,13 +200,13 @@ postTopReply hDest recipsA recipsC context replyP after = do
             FormSuccess nm -> return $ nmContent nm
         encodeRouteFed <- getEncodeRouteHome
         encodeRouteLocal <- getEncodeRouteLocal
-        let encodeRecipRoute = l2f hDest . encodeRouteLocal
+        let encodeRecipRoute = ObjURI hDest . encodeRouteLocal
         shrAuthor <- do
             Entity _ p <- requireVerifiedAuth
             lift $ runDB $ sharerIdent <$> get404 (personIdent p)
         let msg' = T.filter (/= '\r') msg
         contentHtml <- ExceptT . pure $ renderPandocMarkdown msg'
-        let (hLocal, luAuthor) = f2l $ encodeRouteFed $ SharerR shrAuthor
+        let ObjURI hLocal luAuthor = encodeRouteFed $ SharerR shrAuthor
             uContext = encodeRecipRoute context
             recips = recipsA ++ recipsC
             note = Note
@@ -247,7 +248,7 @@ getReply replyG replyP getdid midParent = do
     defaultLayout $(widgetFile "discussion/reply")
 
 postReply
-    :: Text
+    :: Host
     -> [Route App]
     -> [Route App]
     -> Route App
@@ -266,7 +267,7 @@ postReply hDest recipsA recipsC context replyG replyP after getdid midParent = d
             FormSuccess nm -> return $ nmContent nm
         encodeRouteFed <- getEncodeRouteHome
         encodeRouteLocal <- getEncodeRouteLocal
-        let encodeRecipRoute = l2f hDest . encodeRouteLocal
+        let encodeRecipRoute = ObjURI hDest . encodeRouteLocal
         (shrAuthor, uParent) <- do
             Entity _ p <- requireVerifiedAuth
             lift $ runDB $ do
@@ -284,11 +285,11 @@ postReply hDest recipsA recipsC context replyG replyP after getdid midParent = d
                         return $ encodeRouteFed $ MessageR (sharerIdent s) lmkhid
                     (Nothing, Just rm) -> do
                         i <- getJust $ remoteMessageInstance rm
-                        return $ l2f (instanceHost i) (remoteMessageIdent rm)
+                        return $ ObjURI (instanceHost i) (remoteMessageIdent rm)
                 return (shr, parent)
         let msg' = T.filter (/= '\r') msg
         contentHtml <- ExceptT . pure $ renderPandocMarkdown msg'
-        let (hLocal, luAuthor) = f2l $ encodeRouteFed $ SharerR shrAuthor
+        let ObjURI hLocal luAuthor = encodeRouteFed $ SharerR shrAuthor
             uContext = encodeRecipRoute context
             recips = recipsA ++ recipsC
             note = Note
diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs
index 6703138..55e06ac 100644
--- a/src/Vervis/Handler/Inbox.hs
+++ b/src/Vervis/Handler/Inbox.hs
@@ -118,6 +118,7 @@ import Yesod.Persist.Local
 import Vervis.ActivityPub
 import Vervis.ActorKey
 import Vervis.API
+import Vervis.FedURI
 import Vervis.Federation
 import Vervis.Federation.Auth
 import Vervis.Foundation
@@ -337,20 +338,20 @@ fedUriField
     :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m FedURI
 fedUriField = Field
     { fieldParse = parseHelper $ \ t ->
-        case parseFedURI t of
+        case parseObjURI t of
             Left e  -> Left $ MsgInvalidUrl $ T.pack e <> ": " <> t
             Right u -> Right u
     , fieldView = \theId name attrs val isReq ->
-        [whamlet|<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id renderFedURI val}>|]
+        [whamlet|<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id renderObjURI val}>|]
     , fieldEnctype = UrlEncoded
     }
 
 ticketField
-    :: (Route App -> LocalURI) -> Field Handler (Text, ShrIdent, PrjIdent, Int)
+    :: (Route App -> LocalURI) -> Field Handler (Host, ShrIdent, PrjIdent, Int)
 ticketField encodeRouteLocal = checkMMap toTicket fromTicket fedUriField
     where
     toTicket uTicket = runExceptT $ do
-        let (hTicket, luTicket) = f2l uTicket
+        let ObjURI hTicket luTicket = uTicket
         route <-
             case decodeRouteLocal luTicket of
                 Nothing -> throwE ("Not a valid route" :: Text)
@@ -359,14 +360,14 @@ ticketField encodeRouteLocal = checkMMap toTicket fromTicket fedUriField
             TicketR shr prj num -> return (hTicket, shr, prj, num)
             _ -> throwE "Not a ticket route"
     fromTicket (h, shr, prj, num) =
-        l2f h $ encodeRouteLocal $ TicketR shr prj num
+        ObjURI h $ encodeRouteLocal $ TicketR shr prj num
 
 projectField
-    :: (Route App -> LocalURI) -> Field Handler (Text, ShrIdent, PrjIdent)
+    :: (Route App -> LocalURI) -> Field Handler (Host, ShrIdent, PrjIdent)
 projectField encodeRouteLocal = checkMMap toProject fromProject fedUriField
     where
     toProject u = runExceptT $ do
-        let (h, lu) = f2l u
+        let ObjURI h lu = u
         route <-
             case decodeRouteLocal lu of
                 Nothing -> throwE ("Not a valid route" :: Text)
@@ -374,10 +375,10 @@ projectField encodeRouteLocal = checkMMap toProject fromProject fedUriField
         case route of
             ProjectR shr prj -> return (h, shr, prj)
             _ -> throwE "Not a project route"
-    fromProject (h, shr, prj) = l2f h $ encodeRouteLocal $ ProjectR shr prj
+    fromProject (h, shr, prj) = ObjURI h $ encodeRouteLocal $ ProjectR shr prj
 
 publishCommentForm
-    :: Form ((Text, ShrIdent, PrjIdent, Int), Maybe FedURI, Text)
+    :: Form ((Host, ShrIdent, PrjIdent, Int), Maybe FedURI, Text)
 publishCommentForm html = do
     enc <- getEncodeRouteLocal
     flip renderDivs html $ (,,)
@@ -385,12 +386,12 @@ publishCommentForm html = do
         <*> aopt fedUriField       "Replying to" (Just $ Just defp)
         <*> areq textField         "Message"     (Just defmsg)
     where
-    deft = ("forge.angeley.es", text2shr "fr33", text2prj "sandbox", 1)
-    defp = FedURI "forge.angeley.es" "/s/fr33/m/2f1a7" ""
+    deft = (Authority "forge.angeley.es" Nothing, text2shr "fr33", text2prj "sandbox", 1)
+    defp = ObjURI (Authority "forge.angeley.es" Nothing) $ LocalURI "/s/fr33/m/2f1a7"
     defmsg = "Hi! I'm testing federation. Can you see my message? :)"
 
 openTicketForm
-    :: Form ((Text, ShrIdent, PrjIdent), TextHtml, TextPandocMarkdown)
+    :: Form ((Host, ShrIdent, PrjIdent), TextHtml, TextPandocMarkdown)
 openTicketForm html = do
     enc <- getEncodeRouteLocal
     flip renderDivs html $ (,,)
@@ -402,7 +403,7 @@ openTicketForm html = do
               areq textareaField    "Description" (Just defd)
             )
     where
-    defj = ("forge.angeley.es", text2shr "fr33", text2prj "sandbox")
+    defj = (Authority "forge.angeley.es" Nothing, text2shr "fr33", text2prj "sandbox")
     deft = "Time slows down when tasting coconut ice-cream"
     defd = "Is that slow-motion effect intentional? :)"
 
@@ -553,9 +554,9 @@ postSharerOutboxR shrAuthor = do
         encodeRouteLocal <- getEncodeRouteLocal
         let msg' = T.filter (/= '\r') msg
         contentHtml <- ExceptT . pure $ renderPandocMarkdown msg'
-        let encodeRecipRoute = l2f hTicket . encodeRouteLocal
+        let encodeRecipRoute = ObjURI hTicket . encodeRouteLocal
             uTicket = encodeRecipRoute $ TicketR shrTicket prj num
-            (hLocal, luAuthor) = f2l $ encodeRouteFed $ SharerR shrAuthor
+            ObjURI hLocal luAuthor = encodeRouteFed $ SharerR shrAuthor
             collections =
                 [ ProjectFollowersR shrTicket prj
                 , TicketParticipantsR shrTicket prj num
@@ -597,8 +598,8 @@ postSharerOutboxR shrAuthor = do
                             <a href=@{ProjectR shr prj}>
                               ./s/#{shr2text shr}/p/#{prj2text prj}
                           $else
-                            <a href=#{renderFedURI $ encodeRouteFed h $ ProjectR shr prj}>
-                              #{h}/s/#{shr2text shr}/p/#{prj2text prj}
+                            <a href=#{renderObjURI $ encodeRouteFed h $ ProjectR shr prj}>
+                              #{renderAuthority h}/s/#{shr2text shr}/p/#{prj2text prj}
                           : #{preEscapedToHtml title}.
                     |]
         let recipsA = [ProjectR shr prj]
@@ -656,7 +657,7 @@ getActorKey choose route = do
         getsYesod appActorKeys
     encodeRouteLocal <- getEncodeRouteLocal
     let key = PublicKey
-            { publicKeyId       = encodeRouteLocal route
+            { publicKeyId       = LocalRefURI $ Left $ encodeRouteLocal route
             , publicKeyExpires  = Nothing
             , publicKeyOwner    = OwnerInstance
             , publicKeyMaterial = actorKey
diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs
index 8cc4ad2..2a6159f 100644
--- a/src/Vervis/Migration.hs
+++ b/src/Vervis/Migration.hs
@@ -71,6 +71,7 @@ import Yesod.MonadSite
 import Data.Either.Local
 import Database.Persist.Local
 
+import Vervis.FedURI
 import Vervis.Model.Ident
 import Vervis.Foundation (App, Route (..))
 import Vervis.Migration.Model
@@ -91,7 +92,7 @@ withPrepare (validate, apply) prepare = (validate, prepare >> apply)
 --withPrePost :: Monad m => Apply m -> Mig m -> Apply m -> Mig m
 --withPrePost pre (validate, apply) post = (validate, pre >> apply >> post)
 
-changes :: (MonadSite m, SiteEnv m ~ App) => Text -> HashidsContext -> [Mig m]
+changes :: (MonadSite m, SiteEnv m ~ App) => Host -> HashidsContext -> [Mig m]
 changes hLocal ctx =
     [ -- 1
       addEntities model_2016_08_04
@@ -316,9 +317,10 @@ changes hLocal ctx =
                     Person201905
                         sid user "" "e@ma.il" False "" defaultTime ""
                         defaultTime ""
-            let localUri = LocalURI "/x/y" ""
-                fedUri = l2f "x.y" localUri
-                doc = Doc "x.y" Activity
+            let localUri = LocalURI "/x/y"
+                h = Authority "x.y" Nothing :: Host
+                fedUri = ObjURI h localUri
+                doc = Doc h Activity
                     { activityId       = Nothing
                     , activityActor    = localUri
                     , activitySummary  = Nothing
@@ -339,10 +341,10 @@ changes hLocal ctx =
                                     Nothing -> error "Mig77: Note 'id' not found"
                                     Just (String s) -> s
                                     _ -> error "Mig77: Note 'id' not a string"
-                            fu = case parseFedURI t of
+                            fu = case parseObjURI t of
                                     Left _ -> error "Mig77: Note 'id' invalid FedURI"
                                     Right u -> u
-                            (h, lu) = f2l fu
+                            ObjURI h lu = fu
                         in  if h == hLocal
                                 then lu
                                 else error "Mig77: Note 'id' on foreign host"
@@ -403,8 +405,8 @@ changes hLocal ctx =
                                                 , "/t/", T.pack $ show $ ticket201905Number t
                                                 ]
                                         return
-                                            ( FedURI hLocal tPath ""
-                                            , map (l2f hLocal . flip LocalURI "")
+                                            ( ObjURI hLocal $ LocalURI tPath
+                                            , map (ObjURI hLocal . LocalURI)
                                                 [ jPath
                                                 , tPath <> "/participants"
                                                 , tPath <> "/team"
@@ -414,7 +416,7 @@ changes hLocal ctx =
                                         i <- getJust $
                                             remoteDiscussion201905Instance rd
                                         return
-                                            ( l2f
+                                            ( ObjURI
                                                 (instance201905Host i)
                                                 (remoteDiscussion201905Ident rd)
                                             , []
@@ -435,16 +437,17 @@ changes hLocal ctx =
                                             Left (Entity lmidP lmP) -> do
                                                 p <- getJust $ localMessage201905Author lmP
                                                 s <- getJust $ person201905Ident p
-                                                let path = T.concat
+                                                let path = LocalURI $ T.concat
                                                         [ "/s/", shr2text $ sharer201905Ident s
                                                         , "/m/", toPathPiece $ encodeKeyHashidPure ctx lmidP
                                                         ]
-                                                return $ FedURI hLocal path ""
+                                                return $ ObjURI hLocal path
                                             Right rmP -> do
                                                 i <- getJust $
                                                     remoteMessage201905Instance rmP
                                                 return $
-                                                    l2f (instance201905Host i)
+                                                    ObjURI
+                                                        (instance201905Host i)
                                                         (remoteMessage201905Ident rmP)
 
                             let msg = T.filter (/= '\r') $ message201905Content m
@@ -455,7 +458,7 @@ changes hLocal ctx =
 
                             let aud = Audience recips [] [] [] [] []
 
-                                luAttrib = LocalURI ("/s/" <> shr2text shr) ""
+                                luAttrib = LocalURI $ "/s/" <> shr2text shr
                                 activity luAct luNote = Doc hLocal Activity
                                     { activityId       = Just luAct
                                     , activityActor    = luAttrib
@@ -474,7 +477,7 @@ changes hLocal ctx =
                                             }
                                         }
                                     }
-                                tempUri = LocalURI "" ""
+                                tempUri = topLocalURI
                             newObid <- insert OutboxItem201905
                                 { outboxItem201905Person    = pid
                                 , outboxItem201905Activity  = persistJSONObjectFromDoc $ activity tempUri tempUri
@@ -488,8 +491,8 @@ changes hLocal ctx =
                                     [ "/s/", shr2text shr
                                     , "/outbox/", toPathPiece $ encodeKeyHashidPure ctx newObid
                                     ]
-                                luAct = LocalURI obPath ""
-                                luNote = LocalURI notePath ""
+                                luAct = LocalURI obPath
+                                luNote = LocalURI notePath
                                 doc = activity luAct luNote
                             update newObid [OutboxItem201905Activity =. persistJSONObjectFromDoc doc]
                             return newObid
@@ -706,9 +709,10 @@ changes hLocal ctx =
                     Person20190612
                         sid user "" "e@ma.il" False "" defaultTime ""
                         defaultTime "" ibid
-            let localUri = LocalURI "/x/y" ""
-                fedUri = l2f "x.y" localUri
-                doc = Doc "x.y" Activity
+            let localUri = LocalURI "/x/y"
+                h = Authority "x.y" Nothing :: Host
+                fedUri = ObjURI h localUri
+                doc = Doc h Activity
                     { activityId       = Nothing
                     , activityActor    = localUri
                     , activitySummary  = Nothing
@@ -783,7 +787,7 @@ changes hLocal ctx =
                                 encodeRouteHome $ ProjectR shrProject prj
                             }
                         }
-                    tempUri = LocalURI "" ""
+                    tempUri = topLocalURI
                 obidNew <- insert OutboxItem20190612
                     { outboxItem20190612Person    = pidAuthor
                     , outboxItem20190612Activity  = persistJSONObjectFromDoc $ doc tempUri
@@ -869,9 +873,10 @@ changes hLocal ctx =
     , addFieldRefRequired''
         "Ticket"
         (do obid <- insert Outbox20190624
-            let localUri = LocalURI "/x/y" ""
-                fedUri = l2f "x.y" localUri
-                doc = Doc "x.y" Activity
+            let localUri = LocalURI "/x/y"
+                h = Authority "x.y" Nothing :: Host
+                fedUri = ObjURI h localUri
+                doc = Doc h Activity
                     { activityId       = Nothing
                     , activityActor    = localUri
                     , activitySummary  = Nothing
@@ -1007,7 +1012,7 @@ changes hLocal ctx =
 
 migrateDB
     :: (MonadSite m, SiteEnv m ~ App)
-    => Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
+    => Host -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
 migrateDB hLocal ctx =
     let f cs = fmap (, length cs) <$> runMigrations schemaBackend 1 cs
     in  f $ changes hLocal ctx
diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs
index 3762e71..e946768 100644
--- a/src/Vervis/Migration/Model.hs
+++ b/src/Vervis/Migration/Model.hs
@@ -130,6 +130,7 @@ import Database.Persist.Schema.Types (Entity)
 import Database.Persist.Schema.SQL ()
 import Database.Persist.Sql (SqlBackend)
 
+import Vervis.FedURI
 import Vervis.Migration.TH (schema)
 import Vervis.Model (SharerId)
 import Vervis.Model.Group
@@ -147,7 +148,7 @@ import Database.Persist.JSON
 import Network.FedURI
 import Web.ActivityPub
 
-type PersistActivity = PersistJSON (Doc Activity)
+type PersistActivity = PersistJSON (Doc Activity URIMode)
 
 model_2016_08_04 :: [Entity SqlBackend]
 model_2016_08_04 = $(schema "2016_08_04")
diff --git a/src/Vervis/Model.hs b/src/Vervis/Model.hs
index 19639ca..5cb8ae3 100644
--- a/src/Vervis/Model.hs
+++ b/src/Vervis/Model.hs
@@ -32,9 +32,10 @@ import Crypto.PublicVerifKey
 import Database.Persist.EmailAddress
 import Database.Persist.Graph.Class
 import Database.Persist.JSON
-import Network.FedURI (FedURI, LocalURI)
+import Network.FedURI
 import Web.ActivityPub (Doc, Activity)
 
+import Vervis.FedURI
 import Vervis.Model.Group
 import Vervis.Model.Ident
 import Vervis.Model.Repo
@@ -43,7 +44,7 @@ import Vervis.Model.Ticket
 import Vervis.Model.TH
 import Vervis.Model.Workflow
 
-type PersistActivity = PersistJSON (Doc Activity)
+type PersistActivity = PersistJSON (Doc Activity URIMode)
 
 makeEntities $(modelFile "config/models")
 
diff --git a/src/Vervis/RemoteActorStore.hs b/src/Vervis/RemoteActorStore.hs
index 640634e..816f213 100644
--- a/src/Vervis/RemoteActorStore.hs
+++ b/src/Vervis/RemoteActorStore.hs
@@ -64,9 +64,10 @@ import Network.FedURI
 import Web.ActivityPub
 import Yesod.MonadSite
 
+import Vervis.FedURI
 import Vervis.Model
 
-newtype InstanceMutex = InstanceMutex (TVar (HashMap Text (MVar ())))
+newtype InstanceMutex = InstanceMutex (TVar (HashMap Host (MVar ())))
 
 newInstanceMutex :: IO InstanceMutex
 newInstanceMutex = InstanceMutex <$> newTVarIO M.empty
@@ -95,7 +96,7 @@ withHostLock
        , HandlerSite m ~ site
        , YesodRemoteActorStore site
        )
-    => Text
+    => Host
     -> m a
     -> m a
 withHostLock host action = do
@@ -130,7 +131,7 @@ instanceAndActor
     :: ( PersistUniqueWrite (YesodPersistBackend site)
        , BaseBackend (YesodPersistBackend site) ~ SqlBackend
        )
-    => Text
+    => Host
     -> LocalURI
     -> Maybe Text
     -> LocalURI
@@ -324,8 +325,8 @@ keyListedByActorShared
        )
     => InstanceId
     -> VerifKeyId
-    -> Text
-    -> LocalURI
+    -> Host
+    -> LocalRefURI
     -> LocalURI
     -> ExceptT String (HandlerFor site) RemoteActorId
 keyListedByActorShared iid vkid host luKey luActor = do
@@ -376,7 +377,7 @@ keyListedByActorShared iid vkid host luKey luActor = do
                                 return rsid
 
 data VerifKeyDetail = VerifKeyDetail
-    { vkdKeyId     :: LocalURI
+    { vkdKeyId     :: LocalRefURI
     , vkdKey       :: PublicVerifKey
     , vkdExpires   :: Maybe UTCTime
     , vkdActorId   :: LocalURI
@@ -389,7 +390,7 @@ addVerifKey
        , PersistQueryRead (YesodPersistBackend site)
        , PersistUniqueWrite (YesodPersistBackend site)
        )
-    => Text
+    => Host
     -> Maybe Text
     -> LocalURI
     -> VerifKeyDetail
@@ -467,7 +468,7 @@ actorFetchShareAction
     -> (site, InstanceId)
     -> IO (Either (Maybe APGetError) (Maybe (Entity RemoteActor)))
 actorFetchShareAction u (site, iid) = flip runWorkerT site $ do
-    let (h, lu) = f2l u
+    let ObjURI h lu = u
     mrecip <- runSiteDB $ runMaybeT
         $   Left <$> MaybeT (getBy $ UniqueRemoteActor iid lu)
         <|> Right <$> MaybeT (getBy $ UniqueRemoteCollection iid lu)
@@ -508,7 +509,13 @@ fetchRemoteActor
        , PersistConfigPool (SitePersistConfig site) ~ ConnectionPool
        , PersistConfigBackend (SitePersistConfig site) ~ SqlPersistT
        )
-    => InstanceId -> Text -> LocalURI -> m (Either SomeException (Either (Maybe APGetError) (Maybe (Entity RemoteActor))))
+    => InstanceId
+    -> Host
+    -> LocalURI
+    -> m (Either
+            SomeException
+            (Either (Maybe APGetError) (Maybe (Entity RemoteActor)))
+         )
 fetchRemoteActor iid host luActor = do
     mrecip <- runSiteDB $ runMaybeT
         $   Left <$> MaybeT (getBy $ UniqueRemoteActor iid luActor)
@@ -521,7 +528,7 @@ fetchRemoteActor iid host luActor = do
                     Right _ -> Nothing
         Nothing -> do
             site <- askSite
-            liftIO $ runShared (siteActorFetchShare site) (l2f host luActor) (site, iid)
+            liftIO $ runShared (siteActorFetchShare site) (ObjURI host luActor) (site, iid)
 
 deleteUnusedURAs = do
     uraids <- E.select $ E.from $ \ ura -> do
diff --git a/src/Vervis/Settings.hs b/src/Vervis/Settings.hs
index d4eafb1..d1fcfad 100644
--- a/src/Vervis/Settings.hs
+++ b/src/Vervis/Settings.hs
@@ -50,6 +50,10 @@ import qualified Data.Text as T
 
 import Yesod.Mail.Send (MailSettings)
 
+import Network.FedURI
+
+import Vervis.FedURI
+
 developmentMode :: Bool
 developmentMode =
 #if DEVELOPMENT
@@ -88,7 +92,7 @@ data AppSettings = AppSettings
       -- which requests are remote and which are for this instance, and for
       -- generating URLs. The database relies on this value, and you shouldn't
       -- change it once you deploy an instance.
-    , appInstanceHost           :: Text
+    , appInstanceHost           :: Host
       -- | Host/interface the server should bind to.
     , appHost                   :: HostPreference
       -- | Port to listen on
@@ -193,9 +197,15 @@ instance FromJSON AppSettings where
         appDatabaseConf           <- o .: "database"
         appMaxInstanceKeys        <- o .:? "max-instance-keys"
         appMaxActorKeys           <- o .:? "max-actor-keys"
-        appInstanceHost           <- o .: "instance-host"
+        port                      <- o .: "http-port"
+        appInstanceHost           <- do
+            h <- o .: "instance-host"
+            return $
+                if developmentMode
+                    then Authority h $ Just port
+                    else Authority h Nothing
         appHost                   <- fromString <$> o .: "host"
-        appPort                   <- o .: "http-port"
+        let appPort = fromIntegral port
         appIpFromHeader           <- o .: "ip-from-header"
 
         appClientSessionKeyFile   <- o .: "client-session-key"
diff --git a/src/Vervis/Widget/Discussion.hs b/src/Vervis/Widget/Discussion.hs
index 0bd4f3b..7f4be1e 100644
--- a/src/Vervis/Widget/Discussion.hs
+++ b/src/Vervis/Widget/Discussion.hs
@@ -48,7 +48,7 @@ import Vervis.Widget.Sharer
 actorLinkW :: MessageTreeNodeAuthor -> Widget
 actorLinkW actor = $(widgetFile "widget/actor-link")
     where
-    shortURI h (LocalURI p f) = h <> p <> f
+    shortURI h (LocalURI p) = renderAuthority h <> p
 
 messageW
     :: UTCTime -> MessageTreeNode -> (MessageId -> Route App) -> Widget
diff --git a/src/Vervis/Widget/Sharer.hs b/src/Vervis/Widget/Sharer.hs
index 1e6932e..287ca47 100644
--- a/src/Vervis/Widget/Sharer.hs
+++ b/src/Vervis/Widget/Sharer.hs
@@ -42,11 +42,11 @@ sharerLinkFedW :: Either Sharer (Instance, RemoteActor) -> Widget
 sharerLinkFedW (Left sharer)             = sharerLinkW sharer
 sharerLinkFedW (Right (inztance, actor)) =
     [whamlet|
-        <a href="#{renderFedURI uActor}">
+        <a href="#{renderObjURI uActor}">
           $maybe name <- remoteActorName actor
             #{name}
           $nothing
             (?)
     |]
     where
-    uActor = l2f (instanceHost inztance) (remoteActorIdent actor)
+    uActor = ObjURI (instanceHost inztance) (remoteActorIdent actor)
diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs
index 74aa8fb..9755b18 100644
--- a/src/Web/ActivityPub.hs
+++ b/src/Web/ActivityPub.hs
@@ -57,7 +57,6 @@ module Web.ActivityPub
     , Activity (..)
 
       -- * Utilities
-    , publicURI
     , hActivityPubActor
     , provideAP
     , provideAP'
@@ -82,7 +81,7 @@ where
 
 import Control.Applicative ((<|>), optional)
 import Control.Exception (Exception, displayException, try)
-import Control.Monad (when, unless, (<=<), join)
+import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
 import Control.Monad.Trans.Writer (Writer)
@@ -91,36 +90,30 @@ import Data.Aeson
 import Data.Aeson.Encoding (pair)
 import Data.Aeson.Types (Parser, typeMismatch, listEncoding)
 import Data.Bifunctor
-import Data.Bitraversable (bitraverse)
 import Data.ByteString (ByteString)
 import Data.Foldable (for_)
 import Data.List
-import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
+import Data.List.NonEmpty (NonEmpty (..))
 import Data.Proxy
-import Data.PEM
 import Data.Semigroup (Endo, First (..))
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8, decodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Traversable
-import Data.Vector (Vector)
 import Network.HTTP.Client hiding (Proxy, proxy)
 import Network.HTTP.Client.Conduit.ActivityPub (httpAPEither)
 import Network.HTTP.Simple (JSONException)
 import Network.HTTP.Types.Header (HeaderName, hContentType)
-import Network.URI
 import Text.HTML.SanitizeXSS
 import Yesod.Core.Content (ContentType)
 import Yesod.Core.Handler (ProvidedRep, provideRepType)
 
 import Network.HTTP.Client.Signature
 
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.HashMap.Strict as M
-import qualified Data.Text as T (pack, unpack)
+import qualified Data.Text as T
 import qualified Data.Vector as V
 import qualified Network.HTTP.Signature as S
 
@@ -130,41 +123,38 @@ import Network.HTTP.Digest
 
 import Data.Aeson.Local
 
-proxy :: a -> Proxy a
+proxy :: a u -> Proxy a
 proxy _ = Proxy
 
-as2Context :: FedURI
-as2Context = FedURI "www.w3.org" "/ns/activitystreams" ""
+as2Context :: Text
+as2Context = "https://www.w3.org/ns/activitystreams"
 
-secContext :: FedURI
-secContext = FedURI "w3id.org" "/security/v1" ""
+secContext :: Text
+secContext = "https://w3id.org/security/v1"
 
-forgeContext :: FedURI
-forgeContext = FedURI "forgefed.peers.community" "/ns" ""
+forgeContext :: Text
+forgeContext = "https://forgefed.peers.community/ns"
 
-extContext :: FedURI
-extContext = FedURI "angeley.es" "/as2-ext" ""
+extContext :: Text
+extContext = "https://angeley.es/as2-ext"
 
-publicURI :: FedURI
-publicURI = FedURI "www.w3.org" "/ns/activitystreams" "#Public"
-
-publicT :: Text
-publicT = renderFedURI publicURI
+publicURI :: Text
+publicURI = "https://www.w3.org/ns/activitystreams#Public"
 
 class ActivityPub a where
-    jsonldContext :: Proxy a -> [FedURI]
-    parseObject   :: Object -> Parser (Text, a)
-    toSeries      :: Text -> a -> Series
+    jsonldContext :: Proxy a -> [Text]
+    parseObject   :: UriMode u => Object -> Parser (Authority u, a u)
+    toSeries      :: UriMode u => Authority u -> a u -> Series
 
-data Doc a = Doc
-    { docHost  :: Text
-    , docValue :: a
+data Doc a u = Doc
+    { docAuthority :: Authority u
+    , docValue     :: a u
     }
 
-instance ActivityPub a => FromJSON (Doc a) where
+instance (ActivityPub a, UriMode u) => FromJSON (Doc a u) where
     parseJSON = withObject "Doc" $ \ o -> uncurry Doc <$> parseObject o
 
-instance ActivityPub a => ToJSON (Doc a) where
+instance (ActivityPub a, UriMode u) => ToJSON (Doc a u) where
     toJSON = error "toJSON Doc"
     toEncoding (Doc h v) =
         pairs
@@ -200,8 +190,8 @@ ownerShared :: Owner -> Bool
 ownerShared OwnerInstance  = True
 ownerShared (OwnerActor _) = False
 
-data PublicKey = PublicKey
-    { publicKeyId       :: LocalURI
+data PublicKey u = PublicKey
+    { publicKeyId       :: LocalRefURI
     , publicKeyExpires  :: Maybe UTCTime
     , publicKeyOwner    :: Owner
     , publicKeyMaterial :: PublicVerifKey
@@ -214,60 +204,62 @@ instance ActivityPub PublicKey where
         for_ mtyp $ \ t ->
             when (t /= ("Key" :: Text)) $
                 fail "PublicKey @type isn't Key"
-        (host, id_) <- f2l <$> (o .: "@id" <|> o .: "id")
+        RefURI authority id_ <- o .: "@id" <|> o .: "id"
         shared <- o .:|? "isShared" .!= False
-        fmap (host,) $
+        fmap (authority,) $
             PublicKey id_
                 <$> o .:? "expires"
-                <*> (mkOwner shared =<< withHost host o "owner")
+                <*> (mkOwner shared =<< withAuthorityO authority (o .: "owner"))
                 <*> (either fail return . decodePublicVerifKeyPEM =<<
                         o .: "publicKeyPem"
                     )
         where
-        withHost h o t = do
-            (h', lu) <- f2l <$> o .: t
-            if h == h'
-                then return lu
-                else fail "URI host mismatch"
-        mkOwner True  (LocalURI "" "") = return OwnerInstance
-        mkOwner True  _                = fail "Shared key but owner isn't instance URI"
-        mkOwner False lu               = return $ OwnerActor lu
-    toSeries host (PublicKey id_ mexpires owner mat)
-        =  "@id"          .=  l2f host id_
+        mkOwner True  lu
+            | lu == topLocalURI = return OwnerInstance
+        mkOwner True  _         = fail "Shared key but owner isn't instance URI"
+        mkOwner False lu        = return $ OwnerActor lu
+    toSeries authority (PublicKey id_ mexpires owner mat)
+        =  "@id"          .=  RefURI authority id_
         <> "expires"      .=? mexpires
-        <> "owner"        .=  mkOwner host owner
+        <> "owner"        .=  mkOwner authority owner
         <> "publicKeyPem" .=  encodePublicVerifKeyPEM mat
         <> "isShared"     .=  ownerShared owner
         where
-        mkOwner h OwnerInstance   = FedURI h "" ""
-        mkOwner h (OwnerActor lu) = l2f h lu
+        mkOwner a OwnerInstance   = ObjURI a topLocalURI
+        mkOwner a (OwnerActor lu) = ObjURI a lu
 
-parsePublicKeySet :: Value -> Parser (Text, [Either LocalURI PublicKey])
+parsePublicKeySet
+    :: UriMode u
+    => Value
+    -> Parser (Authority u, [Either LocalURI (PublicKey u)])
 parsePublicKeySet v =
     case v of
         Array a ->
             case V.toList a of
                 [] -> fail "No public keys"
                 k : ks -> do
-                    (h, e) <- parseKey k
-                    es <- traverse (withHost h . parseKey) ks
-                    return (h, e : es)
+                    (a, e) <- parseKey k
+                    es <- traverse (withAuthorityT a . parseKey) ks
+                    return (a, e : es)
         _ -> second (: []) <$> parseKey v
     where
-    parseKey (String t) = second Left . f2l <$> either fail return (parseFedURI t)
-    parseKey (Object o) = second Right <$> parseObject o
-    parseKey v          = typeMismatch "PublicKeySet Item" v
+    parseKey v@(String _) = second Left . f2l <$> parseJSON v
+        where
+        f2l (ObjURI a l)  = (a, l)
+    parseKey (Object o)   = second Right <$> parseObject o
+    parseKey v            = typeMismatch "PublicKeySet Item" v
 
-encodePublicKeySet :: Text -> [Either LocalURI PublicKey] -> Encoding
-encodePublicKeySet host es =
+encodePublicKeySet
+    :: UriMode u => Authority u -> [Either LocalURI (PublicKey u)] -> Encoding
+encodePublicKeySet authority es =
     case es of
         [e] -> renderKey e
         _   -> listEncoding renderKey es
     where
-    renderKey (Left lu)  = toEncoding $ l2f host lu
-    renderKey (Right pk) = pairs $ toSeries host pk
+    renderKey (Left lu)  = toEncoding $ ObjURI authority lu
+    renderKey (Right pk) = pairs $ toSeries authority pk
 
-data Actor = Actor
+data Actor u = Actor
     { actorId         :: LocalURI
     , actorType       :: ActorType
     , actorUsername   :: Maybe Text
@@ -276,37 +268,37 @@ data Actor = Actor
     , actorInbox      :: LocalURI
     , actorOutbox     :: Maybe LocalURI
     , actorFollowers  :: Maybe LocalURI
-    , actorPublicKeys :: [Either LocalURI PublicKey]
+    , actorPublicKeys :: [Either LocalURI (PublicKey u)]
     }
 
 instance ActivityPub Actor where
     jsonldContext _ = [as2Context, secContext, extContext]
     parseObject o = do
-        (host, id_) <- f2l <$> o .: "id"
-        fmap (host,) $
+        ObjURI authority id_ <- o .: "id"
+        fmap (authority,) $
             Actor id_
                 <$> o .: "type"
                 <*> o .:? "preferredUsername"
                 <*> o .:? "name"
                 <*> o .:? "summary"
-                <*> withHost host (f2l <$> o .: "inbox")
-                <*> withHostMaybe host (fmap f2l <$> o .:? "outbox")
-                <*> withHostMaybe host (fmap f2l <$> o .:? "followers")
-                <*> withHost host (parsePublicKeySet =<< o .: "publicKey")
-    toSeries host
+                <*> withAuthorityO authority (o .: "inbox")
+                <*> withAuthorityMaybeO authority (o .:? "outbox")
+                <*> withAuthorityMaybeO authority (o .:? "followers")
+                <*> withAuthorityT authority (parsePublicKeySet =<< o .: "publicKey")
+    toSeries authority
         (Actor id_ typ musername mname msummary inbox outbox followers pkeys)
-            =  "id"                .=     l2f host id_
+            =  "id"                .=     ObjURI authority id_
             <> "type"              .=     typ
             <> "preferredUsername" .=?    musername
             <> "name"              .=?    mname
             <> "summary"           .=?    msummary
-            <> "inbox"             .=     l2f host inbox
-            <> "outbox"            .=?    (l2f host <$> outbox)
-            <> "followers"         .=?    (l2f host <$> followers)
-            <> "publicKey"         `pair` encodePublicKeySet host pkeys
+            <> "inbox"             .=     ObjURI authority inbox
+            <> "outbox"            .=?    (ObjURI authority <$> outbox)
+            <> "followers"         .=?    (ObjURI authority <$> followers)
+            <> "publicKey"         `pair` encodePublicKeySet authority pkeys
 
-data Project = Project
-    { projectActor :: Actor
+data Project u = Project
+    { projectActor :: Actor u
     , projectTeam  :: LocalURI
     }
 
@@ -318,10 +310,10 @@ instance ActivityPub Project where
             fail "Actor type isn't Project"
         fmap (h,) $
             Project a
-                <$> withHost h (f2l <$> o .:| "team")
-    toSeries host (Project actor team)
-        =  toSeries host actor
-        <> "team" .= l2f host team
+                <$> withAuthorityO h (o .:| "team")
+    toSeries authority (Project actor team)
+        =  toSeries authority actor
+        <> "team" .= ObjURI authority team
 
 data CollectionType = CollectionTypeUnordered | CollectionTypeOrdered
 
@@ -339,7 +331,7 @@ instance ToJSON CollectionType where
             CollectionTypeUnordered -> "Collection" :: Text
             CollectionTypeOrdered   -> "OrderedCollection"
 
-data Collection a = Collection
+data Collection a u = Collection
     { collectionId         :: LocalURI
     , collectionType       :: CollectionType
     , collectionTotalItems :: Maybe Int
@@ -352,22 +344,22 @@ data Collection a = Collection
 instance (FromJSON a, ToJSON a) => ActivityPub (Collection a) where
     jsonldContext _ = [as2Context, forgeContext, extContext]
     parseObject o = do
-        (host, id_) <- f2l <$> o .: "id"
-        fmap (host,) $
+        ObjURI authority id_ <- o .: "id"
+        fmap (authority,) $
             Collection id_
                 <$> o .: "type"
                 <*> o .:? "totalItems"
-                <*> withHostMaybe host (fmap f2l <$> o .:? "current")
-                <*> withHostMaybe host (fmap fp2lp <$> o .:? "first")
-                <*> withHostMaybe host (fmap fp2lp <$> o .:? "last")
+                <*> withAuthorityMaybeO authority (o .:? "current")
+                <*> withAuthorityMaybeP authority (o .:? "first")
+                <*> withAuthorityMaybeP authority (o .:? "last")
                 <*> optional (o .: "items" <|> o .: "orderedItems") .!= []
-    toSeries host (Collection id_ typ total curr firzt last items)
-        =  "id"         .=  l2f host id_
+    toSeries authority (Collection id_ typ total curr firzt last items)
+        =  "id"         .=  ObjURI authority id_
         <> "type"       .=  typ
         <> "totalItems" .=? total
-        <> "current"    .=? (l2f host <$> curr)
-        <> "first"      .=? (lp2fp host <$> firzt)
-        <> "last"       .=? (lp2fp host <$> last)
+        <> "current"    .=? (ObjURI authority <$> curr)
+        <> "first"      .=? (PageURI authority <$> firzt)
+        <> "last"       .=? (PageURI authority <$> last)
         <> "items"      .=% items
 
 data CollectionPageType
@@ -388,7 +380,7 @@ instance ToJSON CollectionPageType where
             CollectionPageTypeUnordered -> "CollectionPage" :: Text
             CollectionPageTypeOrdered   -> "OrderedCollectionPage"
 
-data CollectionPage a = CollectionPage
+data CollectionPage a u = CollectionPage
     { collectionPageId         :: LocalPageURI
     , collectionPageType       :: CollectionPageType
     , collectionPageTotalItems :: Maybe Int
@@ -405,33 +397,33 @@ data CollectionPage a = CollectionPage
 instance (FromJSON a, ToJSON a) => ActivityPub (CollectionPage a) where
     jsonldContext _ = [as2Context, forgeContext, extContext]
     parseObject o = do
-        (host, id_) <- fp2lp <$> o .: "id"
-        fmap (host,) $
+        PageURI authority id_ <- o .: "id"
+        fmap (authority,) $
             CollectionPage id_
                 <$> o .: "type"
                 <*> o .:? "totalItems"
-                <*> withHostMaybe host (fmap fp2lp <$> o .:? "current")
-                <*> withHostMaybe host (fmap fp2lp <$> o .:? "first")
-                <*> withHostMaybe host (fmap fp2lp <$> o .:? "last")
-                <*> withHost host (f2l <$> o .: "partOf")
-                <*> withHostMaybe host (fmap fp2lp <$> o .:? "prev")
-                <*> withHostMaybe host (fmap fp2lp <$> o .:? "next")
+                <*> withAuthorityMaybeP authority (o .:? "current")
+                <*> withAuthorityMaybeP authority (o .:? "first")
+                <*> withAuthorityMaybeP authority (o .:? "last")
+                <*> withAuthorityO authority (o .: "partOf")
+                <*> withAuthorityMaybeP authority (o .:? "prev")
+                <*> withAuthorityMaybeP authority (o .:? "next")
                 <*> o .:? "startIndex"
                 <*> optional (o .: "items" <|> o .: "orderedItems") .!= []
-    toSeries host (CollectionPage id_ typ total curr firzt last partOf prev next ind items)
-        =  "id"         .=  lp2fp host id_
+    toSeries authority (CollectionPage id_ typ total curr firzt last partOf prev next ind items)
+        =  "id"         .=  PageURI authority id_
         <> "type"       .=  typ
         <> "totalItems" .=? total
-        <> "current"    .=? (lp2fp host <$> curr)
-        <> "first"      .=? (lp2fp host <$> firzt)
-        <> "last"       .=? (lp2fp host <$> last)
-        <> "partOf"     .=  (l2f host partOf)
-        <> "prev"       .=? (lp2fp host <$> prev)
-        <> "next"       .=? (lp2fp host <$> next)
+        <> "current"    .=? (PageURI authority <$> curr)
+        <> "first"      .=? (PageURI authority <$> firzt)
+        <> "last"       .=? (PageURI authority <$> last)
+        <> "partOf"     .=  (ObjURI authority partOf)
+        <> "prev"       .=? (PageURI authority <$> prev)
+        <> "next"       .=? (PageURI authority <$> next)
         <> "startIndex" .=? ind
         <> "items"      .=% items
 
-data Recipient = RecipientActor Actor | RecipientCollection (Collection FedURI)
+data Recipient u = RecipientActor (Actor u) | RecipientCollection (Collection (ObjURI u) u)
 
 instance ActivityPub Recipient where
     jsonldContext _ = [as2Context, secContext, forgeContext, extContext]
@@ -441,30 +433,30 @@ instance ActivityPub Recipient where
     toSeries h (RecipientActor a)      = toSeries h a
     toSeries h (RecipientCollection c) = toSeries h c
 
-data Audience = Audience
-    { audienceTo        :: [FedURI]
-    , audienceBto       :: [FedURI]
-    , audienceCc        :: [FedURI]
-    , audienceBcc       :: [FedURI]
-    , audienceGeneral   :: [FedURI]
-    , audienceNonActors :: [FedURI]
+data Audience u = Audience
+    { audienceTo        :: [ObjURI u]
+    , audienceBto       :: [ObjURI u]
+    , audienceCc        :: [ObjURI u]
+    , audienceBcc       :: [ObjURI u]
+    , audienceGeneral   :: [ObjURI u]
+    , audienceNonActors :: [ObjURI u]
     }
 
-newtype AdaptAudience = AdaptAudience
-    { unAdapt :: FedURI
+newtype AdaptAudience u = AdaptAudience
+    { unAdapt :: ObjURI u
     }
 
-instance FromJSON AdaptAudience where
+instance UriMode u => FromJSON (AdaptAudience u) where
     parseJSON = fmap AdaptAudience . parseJSON . adapt
         where
         adapt v =
             case v of
                 String t
-                    | t == "Public"    -> String publicT
-                    | t == "as:Public" -> String publicT
+                    | t == "as:Public" -> String "Public"
+                    | t == publicURI   -> String "Public"
                 _ -> v
 
-parseAudience :: Object -> Parser Audience
+parseAudience :: UriMode u => Object -> Parser (Audience u)
 parseAudience o =
     Audience
         <$> o .:& "to"
@@ -481,7 +473,7 @@ parseAudience o =
         l <- obj .:|? key .!= []
         return $ map unAdapt l
 
-encodeAudience :: Audience -> Series
+encodeAudience :: UriMode u => Audience u -> Series
 encodeAudience (Audience to bto cc bcc aud nons)
     =  "to"        .=% to
     <> "bto"       .=% bto
@@ -490,29 +482,68 @@ encodeAudience (Audience to bto cc bcc aud nons)
     <> "audience"  .=% aud
     <> "nonActors" .=% nons
 
-data Note = Note
+data Note u = Note
     { noteId        :: Maybe LocalURI
     , noteAttrib    :: LocalURI
-    , noteAudience  :: Audience
-    , noteReplyTo   :: Maybe FedURI
-    , noteContext   :: Maybe FedURI
+    , noteAudience  :: Audience u
+    , noteReplyTo   :: Maybe (ObjURI u)
+    , noteContext   :: Maybe (ObjURI u)
     , notePublished :: Maybe UTCTime
     , noteSource    :: Text
     , noteContent   :: Text
     }
 
-withHost h a = do
-    (h', v) <- a
-    if h == h'
+withAuthorityT a m = do
+    (a', v) <- m
+    if a == a'
         then return v
-        else fail "URI host mismatch"
+        else fail "URI authority mismatch"
 
-withHostMaybe h a = do
-    mp <- a
-    for mp $ \ (h', v) ->
-        if h == h'
+withAuthorityO a m = do
+    ObjURI a' v <- m
+    if a == a'
+        then return v
+        else fail "URI authority mismatch"
+
+withAuthorityS a m = do
+    SubURI a' v <- m
+    if a == a'
+        then return v
+        else fail "URI authority mismatch"
+
+withAuthorityP a m = do
+    PageURI a' v <- m
+    if a == a'
+        then return v
+        else fail "URI authority mismatch"
+
+withAuthorityMaybeT a m = do
+    mu <- m
+    for mu $ \ (a', v) ->
+        if a == a'
             then return v
-            else fail "URI host mismatch"
+            else fail "URI authority mismatch"
+
+withAuthorityMaybeO a m = do
+    mu <- m
+    for mu $ \ (ObjURI a' v) ->
+        if a == a'
+            then return v
+            else fail "URI authority mismatch"
+
+withAuthorityMaybeS a m = do
+    mu <- m
+    for mu $ \ (SubURI a' v) ->
+        if a == a'
+            then return v
+            else fail "URI authority mismatch"
+
+withAuthorityMaybeP a m = do
+    mu <- m
+    for mu $ \ (PageURI a' v) ->
+        if a == a'
+            then return v
+            else fail "URI authority mismatch"
 
 instance ActivityPub Note where
     jsonldContext _ = [as2Context, extContext]
@@ -530,10 +561,10 @@ instance ActivityPub Note where
         unless (sourceType == ("text/markdown; variant=Pandoc" :: Text)) $
             fail "source mediaType isn't Pandoc Markdown"
 
-        (h, attrib) <- f2l <$> o .: "attributedTo"
-        fmap (h,) $
+        ObjURI a attrib <- o .: "attributedTo"
+        fmap (a,) $
             Note
-                <$> withHostMaybe h (fmap f2l <$> o .:? "id")
+                <$> withAuthorityMaybeO a (o .:? "id")
                 <*> pure attrib
                 <*> parseAudience o
                 <*> o .:? "inReplyTo"
@@ -541,10 +572,10 @@ instance ActivityPub Note where
                 <*> o .:? "published"
                 <*> source .: "content"
                 <*> (sanitizeBalance <$> o .: "content")
-    toSeries host (Note mid attrib aud mreply mcontext mpublished src content)
+    toSeries authority (Note mid attrib aud mreply mcontext mpublished src content)
         =  "type"         .=  ("Note" :: Text)
-        <> "id"           .=? (l2f host <$> mid)
-        <> "attributedTo" .=  l2f host attrib
+        <> "id"           .=? (ObjURI authority <$> mid)
+        <> "attributedTo" .=  ObjURI authority attrib
         <> encodeAudience aud
         <> "inReplyTo"    .=? mreply
         <> "context"      .=? mcontext
@@ -571,12 +602,12 @@ instance ToJSON RelationshipProperty where
         toEncoding $ case at of
             RelDependsOn -> "dependsOn" :: Text
 
-data Relationship = Relationship
-    { relationshipId           :: Maybe FedURI
+data Relationship u = Relationship
+    { relationshipId           :: Maybe (ObjURI u)
     , relationshipExtraTypes   :: [Text]
-    , relationshipSubject      :: FedURI
+    , relationshipSubject      :: ObjURI u
     , relationshipProperty     :: Either RelationshipProperty Text
-    , relationshipObject       :: FedURI
+    , relationshipObject       :: ObjURI u
     , relationshipAttributedTo :: LocalURI
     , relationshipPublished    :: Maybe UTCTime
     , relationshipUpdated      :: Maybe UTCTime
@@ -590,9 +621,9 @@ instance ActivityPub Relationship where
         unless (("Relationship" :: Text) `elem` typs) $
             fail "type isn't Relationship"
 
-        (h, attributedTo) <- f2l <$> o .: "attributedTo"
+        ObjURI a attributedTo <- o .: "attributedTo"
 
-        fmap (h,) $
+        fmap (a,) $
             Relationship
                 <$> o .:? "id"
                 <*> pure (delete "Relationship" typs)
@@ -604,7 +635,7 @@ instance ActivityPub Relationship where
                 <*> o .:? "updated"
                 <*> (TextHtml . sanitizeBalance <$> o .: "summary")
 
-    toSeries host
+    toSeries authority
         (Relationship id_ typs subject property object attributedTo published
                       updated summary)
             =  "id"           .=? id_
@@ -612,15 +643,15 @@ instance ActivityPub Relationship where
             <> "subject"      .=  subject
             <> "relationship" .=+ property
             <> "object"       .=  object
-            <> "attributedTo" .=  l2f host attributedTo
+            <> "attributedTo" .=  ObjURI authority attributedTo
             <> "published"    .=? published
             <> "updated"      .=? updated
             <> "summary"      .=  summary
 
-data TicketDependency = TicketDependency
-    { ticketDepId           :: Maybe FedURI
-    , ticketDepParent       :: FedURI
-    , ticketDepChild        :: FedURI
+data TicketDependency u = TicketDependency
+    { ticketDepId           :: Maybe (ObjURI u)
+    , ticketDepParent       :: ObjURI u
+    , ticketDepChild        :: ObjURI u
     , ticketDepAttributedTo :: LocalURI
     , ticketDepPublished    :: Maybe UTCTime
     , ticketDepUpdated      :: Maybe UTCTime
@@ -630,14 +661,14 @@ data TicketDependency = TicketDependency
 instance ActivityPub TicketDependency where
     jsonldContext _ = [as2Context, forgeContext]
     parseObject o = do
-        (h, rel) <- parseObject o
+        (a, rel) <- parseObject o
         unless ("TicketDependency" `elem` relationshipExtraTypes rel) $
             fail "type isn't TicketDependency"
 
         unless (relationshipProperty rel == Left RelDependsOn) $
             fail "relationship isn't dependsOn"
 
-        return (h, rel2td rel)
+        return (a, rel2td rel)
         where
         rel2td rel = TicketDependency
             { ticketDepId           = relationshipId rel
@@ -649,7 +680,7 @@ instance ActivityPub TicketDependency where
             , ticketDepSummary      = relationshipSummary rel
             }
 
-    toSeries h = toSeries h . td2rel
+    toSeries a = toSeries a . td2rel
         where
         td2rel td = Relationship
             { relationshipId           = ticketDepId td
@@ -684,9 +715,9 @@ data TicketLocal = TicketLocal
     , ticketReverseDeps  :: LocalURI
     }
 
-parseTicketLocal :: Object -> Parser (Maybe (Text, TicketLocal))
+parseTicketLocal :: UriMode u => Object -> Parser (Maybe (Authority u, TicketLocal))
 parseTicketLocal o = do
-    mid <- fmap f2l <$> o .:? "id"
+    mid <- o .:? "id"
     case mid of
         Nothing -> do
             verifyNothing "context"
@@ -697,37 +728,37 @@ parseTicketLocal o = do
             verifyNothing "dependencies"
             verifyNothing "dependants"
             return Nothing
-        Just (h, id_) ->
-            fmap (Just . (h,)) $
+        Just (ObjURI a id_) ->
+            fmap (Just . (a,)) $
                 TicketLocal
                     <$> pure id_
-                    <*> withHost h (f2l <$> o .: "context")
-                    <*> withHost h (f2l <$> o .: "replies")
-                    <*> withHost h (f2l <$> o .: "participants")
-                    <*> withHost h (f2l <$> o .: "team")
-                    <*> withHost h (f2l <$> o .: "history")
-                    <*> withHost h (f2l <$> o .: "dependencies")
-                    <*> withHost h (f2l <$> o .: "dependants")
+                    <*> withAuthorityO a (o .: "context")
+                    <*> withAuthorityO a (o .: "replies")
+                    <*> withAuthorityO a (o .: "participants")
+                    <*> withAuthorityO a (o .: "team")
+                    <*> withAuthorityO a (o .: "history")
+                    <*> withAuthorityO a (o .: "dependencies")
+                    <*> withAuthorityO a (o .: "dependants")
     where
     verifyNothing t =
         if t `M.member` o
             then fail $ T.unpack t ++ " field found, expected none"
             else return ()
 
-encodeTicketLocal :: Text -> TicketLocal -> Series
+encodeTicketLocal :: UriMode u => Authority u -> TicketLocal -> Series
 encodeTicketLocal
-    h (TicketLocal id_ context replies participants team events deps rdeps)
-        =  "id"           .= l2f h id_
-        <> "context"      .= l2f h context
-        <> "replies"      .= l2f h replies
-        <> "participants" .= l2f h participants
-        <> "team"         .= l2f h team
-        <> "history"      .= l2f h events
-        <> "dependencies" .= l2f h deps
-        <> "dependants"   .= l2f h rdeps
+    a (TicketLocal id_ context replies participants team events deps rdeps)
+        =  "id"           .= ObjURI a id_
+        <> "context"      .= ObjURI a context
+        <> "replies"      .= ObjURI a replies
+        <> "participants" .= ObjURI a participants
+        <> "team"         .= ObjURI a team
+        <> "history"      .= ObjURI a events
+        <> "dependencies" .= ObjURI a deps
+        <> "dependants"   .= ObjURI a rdeps
 
-data Ticket = Ticket
-    { ticketLocal        :: Maybe (Text, TicketLocal)
+data Ticket u = Ticket
+    { ticketLocal        :: Maybe (Authority u, TicketLocal)
     , ticketAttributedTo :: LocalURI
     , ticketPublished    :: Maybe UTCTime
     , ticketUpdated      :: Maybe UTCTime
@@ -735,7 +766,7 @@ data Ticket = Ticket
     , ticketSummary      :: TextHtml
     , ticketContent      :: TextHtml
     , ticketSource       :: TextPandocMarkdown
-    , ticketAssignedTo   :: Maybe FedURI
+    , ticketAssignedTo   :: Maybe (ObjURI u)
     , ticketIsResolved   :: Bool
     }
 
@@ -755,9 +786,9 @@ instance ActivityPub Ticket where
         unless (sourceType == ("text/markdown; variant=Pandoc" :: Text)) $
             fail "source mediaType isn't Pandoc Markdown"
 
-        (h, attributedTo) <- f2l <$> o .: "attributedTo"
+        ObjURI a attributedTo <- o .: "attributedTo"
 
-        fmap (h,) $
+        fmap (a,) $
             Ticket
                 <$> parseTicketLocal o
                 <*> pure attributedTo
@@ -770,13 +801,13 @@ instance ActivityPub Ticket where
                 <*> o .:? "assignedTo"
                 <*> o .: "isResolved"
 
-    toSeries host
+    toSeries authority
         (Ticket local attributedTo published updated name summary content
                 source assignedTo isResolved)
 
             =   maybe mempty (uncurry encodeTicketLocal) local
             <> "type"         .=  ("Ticket" :: Text)
-            <> "attributedTo" .=  l2f host attributedTo
+            <> "attributedTo" .=  ObjURI authority attributedTo
             <> "published"    .=? published
             <> "updated"      .=? updated
             <> "name"         .=? name
@@ -790,131 +821,130 @@ instance ActivityPub Ticket where
             <> "assignedTo"   .=? assignedTo
             <> "isResolved"   .=  isResolved
 
-data Accept = Accept
-    { acceptObject :: FedURI
+data Accept u = Accept
+    { acceptObject :: ObjURI u
     , acceptResult :: LocalURI
     }
 
-parseAccept :: Text -> Object -> Parser Accept
-parseAccept h o =
+parseAccept :: UriMode u => Authority u -> Object -> Parser (Accept u)
+parseAccept a o =
     Accept
         <$> o .: "object"
-        <*> (withHost h $ f2l <$> o .: "result")
+        <*> withAuthorityO a (o .: "result")
 
-encodeAccept :: Text -> Accept -> Series
-encodeAccept host (Accept obj result)
+encodeAccept :: UriMode u => Authority u -> Accept u -> Series
+encodeAccept authority (Accept obj result)
     =  "object" .= obj
-    <> "result" .= l2f host result
+    <> "result" .= ObjURI authority result
 
-data Create = Create
-    { createObject :: Note
+data Create u = Create
+    { createObject :: Note u
     }
 
-parseCreate :: Object -> Text -> LocalURI -> Parser Create
-parseCreate o h luActor = do
-    note <- withHost h $ parseObject =<< o .: "object"
+parseCreate :: UriMode u => Object -> Authority u -> LocalURI -> Parser (Create u)
+parseCreate o a luActor = do
+    note <- withAuthorityT a $ parseObject =<< o .: "object"
     unless (luActor == noteAttrib note) $ fail "Create actor != Note attrib"
     return $ Create note
 
-encodeCreate :: Text -> LocalURI -> Create -> Series
-encodeCreate host actor (Create obj) =
-    "object" `pair` pairs (toSeries host obj)
+encodeCreate :: UriMode u => Authority u -> LocalURI -> Create u -> Series
+encodeCreate authority actor (Create obj) =
+    "object" `pair` pairs (toSeries authority obj)
 
-data Follow = Follow
-    { followObject :: FedURI
+data Follow u = Follow
+    { followObject :: ObjURI u
     , followHide   :: Bool
     }
 
-parseFollow :: Object -> Parser Follow
+parseFollow :: UriMode u => Object -> Parser (Follow u)
 parseFollow o =
     Follow
         <$> o .: "object"
         <*> o .: "hide"
 
-encodeFollow :: Follow -> Series
+encodeFollow :: UriMode u => Follow u -> Series
 encodeFollow (Follow obj hide)
     =  "object" .= obj
     <> "hide"   .= hide
 
-data Offer = Offer
-    { offerObject :: Ticket
-    , offerTarget :: FedURI
+data Offer u = Offer
+    { offerObject :: Ticket u
+    , offerTarget :: ObjURI u
     }
 
-parseOffer :: Object -> Text -> LocalURI -> Parser Offer
-parseOffer o h luActor = do
-    ticket <- withHost h $ parseObject =<< o .: "object"
+parseOffer :: UriMode u => Object -> Authority u -> LocalURI -> Parser (Offer u)
+parseOffer o a luActor = do
+    ticket <- withAuthorityT a $ parseObject =<< o .: "object"
     unless (luActor == ticketAttributedTo ticket) $
         fail "Offer actor != Ticket attrib"
-    target <- o .: "target"
-    for_ (ticketLocal ticket) $ \ (host, local) -> do
-        let (hTarget, luTarget) = f2l target
-        unless (hTarget == host) $
+    target@(ObjURI hTarget luTarget) <- o .: "target"
+    for_ (ticketLocal ticket) $ \ (authority, local) -> do
+        unless (hTarget == authority) $
             fail "Offer target host != Ticket local host"
         unless (luTarget == ticketContext local) $
             fail "Offer target != Ticket context"
     return $ Offer ticket target
 
-encodeOffer :: Text -> LocalURI -> Offer -> Series
-encodeOffer host actor (Offer obj target)
-    =  "object" `pair` pairs (toSeries host obj)
+encodeOffer :: UriMode u => Authority u -> LocalURI -> Offer u -> Series
+encodeOffer authority actor (Offer obj target)
+    =  "object" `pair` pairs (toSeries authority obj)
     <> "target" .= target
 
-data Reject = Reject
-    { rejectObject :: FedURI
+data Reject u = Reject
+    { rejectObject :: ObjURI u
     }
 
-parseReject :: Object -> Parser Reject
+parseReject :: UriMode u => Object -> Parser (Reject u)
 parseReject o = Reject <$> o .: "object"
 
-encodeReject :: Reject -> Series
+encodeReject :: UriMode u => Reject u -> Series
 encodeReject (Reject obj) = "object" .= obj
 
-data SpecificActivity
-    = AcceptActivity Accept
-    | CreateActivity Create
-    | FollowActivity Follow
-    | OfferActivity  Offer
-    | RejectActivity Reject
+data SpecificActivity u
+    = AcceptActivity (Accept u)
+    | CreateActivity (Create u)
+    | FollowActivity (Follow u)
+    | OfferActivity  (Offer u)
+    | RejectActivity (Reject u)
 
-data Activity = Activity
+data Activity u = Activity
     { activityId       :: Maybe LocalURI
     , activityActor    :: LocalURI
     , activitySummary  :: Maybe TextHtml
-    , activityAudience :: Audience
-    , activitySpecific :: SpecificActivity
+    , activityAudience :: Audience u
+    , activitySpecific :: SpecificActivity u
     }
 
 instance ActivityPub Activity where
     jsonldContext _ = [as2Context, forgeContext, extContext]
     parseObject o = do
-        (h, actor) <- f2l <$> o .: "actor"
-        fmap (h,) $
+        ObjURI a actor <- o .: "actor"
+        fmap (a,) $
             Activity
-                <$> withHostMaybe h (fmap f2l <$> o .:? "id")
+                <$> withAuthorityMaybeO a (o .:? "id")
                 <*> pure actor
                 <*> (fmap (TextHtml . sanitizeBalance) <$> o .:? "summary")
                 <*> parseAudience o
                 <*> do
                     typ <- o .: "type"
                     case typ of
-                        "Accept" -> AcceptActivity <$> parseAccept h o
-                        "Create" -> CreateActivity <$> parseCreate o h actor
+                        "Accept" -> AcceptActivity <$> parseAccept a o
+                        "Create" -> CreateActivity <$> parseCreate o a actor
                         "Follow" -> FollowActivity <$> parseFollow o
-                        "Offer"  -> OfferActivity  <$> parseOffer o h actor
+                        "Offer"  -> OfferActivity  <$> parseOffer o a actor
                         "Reject" -> RejectActivity <$> parseReject o
                         _ ->
                             fail $
                                 "Unrecognized activity type: " ++ T.unpack typ
-    toSeries host (Activity id_ actor summary audience specific)
+    toSeries authority (Activity id_ actor summary audience specific)
         =  "type"    .=  activityType specific
-        <> "id"      .=? (l2f host <$> id_)
-        <> "actor"   .=  l2f host actor
+        <> "id"      .=? (ObjURI authority <$> id_)
+        <> "actor"   .=  ObjURI authority actor
         <> "summary" .=? summary
         <> encodeAudience audience
-        <> encodeSpecific host actor specific
+        <> encodeSpecific authority actor specific
         where
-        activityType :: SpecificActivity -> Text
+        activityType :: SpecificActivity u -> Text
         activityType (AcceptActivity _) = "Accept"
         activityType (CreateActivity _) = "Create"
         activityType (FollowActivity _) = "Follow"
@@ -961,14 +991,15 @@ instance Exception APGetError
 -- * Verify the _Content-Type_ response header
 -- * Parse the JSON response body
 httpGetAP
-    :: (MonadIO m, FromJSON a)
+    :: (MonadIO m, UriMode u, FromJSON a)
     => Manager
-    -> FedURI
+    -> Either (ObjURI u) (SubURI u)
     -> m (Either APGetError (Response a))
 httpGetAP manager uri =
     liftIO $
         mkResult <$> try (httpAPEither manager =<< requestFromURI (toURI uri))
     where
+    toURI = either uriFromObjURI uriFromSubURI
     lookup' x = map snd . filter ((== x) . fst)
     mkResult (Left e)  = Left $ APGetErrorHTTP e
     mkResult (Right r) =
@@ -1011,14 +1042,14 @@ hForwardedSignature = "Forwarded-Signature"
 -- * Perform the POST request
 -- * Verify the response status is 2xx
 httpPostAP
-    :: (MonadIO m, ToJSON a)
+    :: (MonadIO m, UriMode u, ToJSON a)
     => Manager
-    -> FedURI
+    -> ObjURI u
     -> NonEmpty HeaderName
     -> S.KeyId
     -> (ByteString -> S.Signature)
     -> Text
-    -> Maybe (Either FedURI ByteString)
+    -> Maybe (Either (ObjURI u) ByteString)
     -> a
     -> m (Either APPostError (Response ()))
 httpPostAP manager uri headers keyid sign uSender mfwd value =
@@ -1027,19 +1058,19 @@ httpPostAP manager uri headers keyid sign uSender mfwd value =
 -- | Like 'httpPostAP', except it takes the object as a raw lazy
 -- 'BL.ByteString'. It's your responsibility to make sure it's valid JSON.
 httpPostAPBytes
-    :: MonadIO m
+    :: (MonadIO m, UriMode u)
     => Manager
-    -> FedURI
+    -> ObjURI u
     -> NonEmpty HeaderName
     -> S.KeyId
     -> (ByteString -> S.Signature)
     -> Text
-    -> Maybe (Either FedURI ByteString)
+    -> Maybe (Either (ObjURI u) ByteString)
     -> BL.ByteString
     -> m (Either APPostError (Response ()))
 httpPostAPBytes manager uri headers keyid sign uSender mfwd body =
     liftIO $ runExceptT $ do
-        req <- requestFromURI $ toURI uri
+        req <- requestFromURI $ uriFromObjURI uri
         let digest = formatHttpBodyDigest SHA256 "SHA-256" $ hashlazy body
             req' =
                 setRequestCheckStatus $
@@ -1055,7 +1086,7 @@ httpPostAPBytes manager uri headers keyid sign uSender mfwd body =
                 Nothing -> return req''
                 Just (Left uRecip) ->
                     tryExceptT APPostErrorSig $
-                        signRequestInto hForwardingSignature (hDigest :| [hActivityPubForwarder]) Nothing keyid sign Nothing $ consHeader hActivityPubForwarder (encodeUtf8 $ renderFedURI uRecip) req''
+                        signRequestInto hForwardingSignature (hDigest :| [hActivityPubForwarder]) Nothing keyid sign Nothing $ consHeader hActivityPubForwarder (encodeUtf8 $ renderObjURI uRecip) req''
                 Just (Right sig) ->
                     return $
                         consHeader hForwardedSignature sig $
@@ -1087,10 +1118,10 @@ data Fetched = Fetched
       --   we received.
     }
 
-fetchAP' :: (MonadIO m, FromJSON a) => Manager -> FedURI -> ExceptT APGetError m a
+fetchAP' :: (MonadIO m, UriMode u, FromJSON a) => Manager -> Either (ObjURI u) (SubURI u) -> ExceptT APGetError m a
 fetchAP' m u = ExceptT $ second responseBody <$> httpGetAP m u
 
-fetchAP :: (MonadIO m, FromJSON a) => Manager -> FedURI -> ExceptT String m a
+fetchAP :: (MonadIO m, UriMode u, FromJSON a) => Manager -> Either (ObjURI u) (SubURI u) -> ExceptT String m a
 fetchAP m u = withExceptT displayException $ fetchAP' m u
 
 {-
@@ -1102,20 +1133,20 @@ fetchAPH m h lu = do
         else throwE "Object @id URI's host doesn't match the URI we fetched"
 -}
 
-fetchAPID' :: (MonadIO m, ActivityPub a) => Manager -> (a -> LocalURI) -> Text -> LocalURI -> m (Either (Maybe APGetError) a)
+fetchAPID' :: (MonadIO m, UriMode u, ActivityPub a) => Manager -> (a u -> LocalURI) -> Authority u -> LocalURI -> m (Either (Maybe APGetError) (a u))
 fetchAPID' m getId h lu = runExceptT $ do
-    Doc h' v <- withExceptT Just $ fetchAP' m $ l2f h lu
+    Doc h' v <- withExceptT Just $ fetchAP' m $ Left $ ObjURI h lu
     if h == h' && getId v == lu
         then return v
         else throwE Nothing
 
-fetchRecipient :: MonadIO m => Manager -> Text -> LocalURI -> m (Either (Maybe APGetError) Recipient)
+fetchRecipient :: (MonadIO m, UriMode u) => Manager -> Authority u -> LocalURI -> m (Either (Maybe APGetError) (Recipient u))
 fetchRecipient m = fetchAPID' m getId
     where
     getId (RecipientActor a)      = actorId a
     getId (RecipientCollection c) = collectionId c
 
-fetchAPID :: (MonadIO m, ActivityPub a) => Manager -> (a -> LocalURI) -> Text -> LocalURI -> m (Either String a)
+fetchAPID :: (MonadIO m, UriMode u, ActivityPub a) => Manager -> (a u -> LocalURI) -> Authority u -> LocalURI -> m (Either String (a u))
 fetchAPID m getId h lu = first showError <$> fetchAPID' m getId h lu
     where
     showError Nothing  = "Object @id doesn't match the URI we fetched"
@@ -1130,17 +1161,17 @@ data FetchAPError
     deriving Show
 
 fetchAPIDOrH'
-    :: (MonadIO m, ActivityPub a, ActivityPub b)
+    :: (MonadIO m, UriMode u, ActivityPub a, ActivityPub b)
     => Manager
-    -> (a -> LocalURI)
-    -> Text
-    -> LocalURI
-    -> ExceptT FetchAPError m (Either a b)
-fetchAPIDOrH' m getId h lu = do
-    e <- withExceptT FetchAPErrorGet $ fetchAP' m $ l2f h lu
+    -> (a u -> LocalRefURI)
+    -> Authority u
+    -> LocalRefURI
+    -> ExceptT FetchAPError m (Either (a u) (b u))
+fetchAPIDOrH' m getId h (LocalRefURI lu) = do
+    e <- withExceptT FetchAPErrorGet $ fetchAP' m $ bimap (ObjURI h) (SubURI h) lu
     case e of
         Left' (Doc h' x) ->
-            if h == h' && getId x == lu
+            if h == h' && getId x == LocalRefURI lu
                 then return $ Left x
                 else throwE FetchAPErrorIdMismatch
         Right' (Doc h' y) ->
@@ -1149,31 +1180,41 @@ fetchAPIDOrH' m getId h lu = do
                 else throwE FetchAPErrorHostMismatch
 
 fetchAPIDOrH
-    :: (MonadIO m, ActivityPub a, ActivityPub b)
+    :: (MonadIO m, UriMode u, ActivityPub a, ActivityPub b)
     => Manager
-    -> (a -> LocalURI)
-    -> Text
-    -> LocalURI
-    -> ExceptT String m (Either a b)
+    -> (a u -> LocalRefURI)
+    -> Authority u
+    -> LocalRefURI
+    -> ExceptT String m (Either (a u) (b u))
 fetchAPIDOrH m getId h lu = withExceptT show $ fetchAPIDOrH' m getId h lu
 
 -- | Fetches the given actor and checks whether it lists the given key (as a
 -- URI, not as an embedded object). If it does, returns 'Right' the fetched
 -- actor. Otherwise, or if an error occurs during fetching, returns 'Left' an
 -- error message.
-keyListedByActor :: MonadIO m => Manager -> Text -> LocalURI -> LocalURI -> m (Either String Actor)
+keyListedByActor
+    :: (MonadIO m, UriMode u)
+    => Manager
+    -> Authority u
+    -> LocalRefURI
+    -> LocalURI
+    -> m (Either String (Actor u))
 keyListedByActor manager host luKey luActor = runExceptT $ do
     actor <- ExceptT $ fetchAPID manager actorId host luActor
     if keyUriListed luKey actor
         then return actor
         else throwE "Actor publicKey has no URI matching pkey @id"
     where
-    keyUriListed uk a =
-        let match (Left uri) = uri == uk
+    keyUriListed (LocalRefURI uk) a =
+        let match (Left uri) = Left uri == uk
             match (Right _)  = False
         in  any match $ actorPublicKeys a
 
-matchKeyObj :: (Foldable f, Monad m) => LocalURI -> f (Either LocalURI PublicKey) -> ExceptT String m PublicKey
+matchKeyObj
+    :: (Foldable f, Monad m, UriMode u)
+    => LocalRefURI
+    -> f (Either LocalURI (PublicKey u))
+    -> ExceptT String m (PublicKey u)
 matchKeyObj luKey es =
     case find' (match luKey) es of
         Nothing -> throwE "keyId resolved to actor which doesn't have a key object with that ID"
@@ -1214,16 +1255,16 @@ verifyAlgo (Just a) k =
 
 -- | Fetch a key we don't have cached locally.
 fetchUnknownKey
-    :: MonadIO m
+    :: (MonadIO m, UriMode u)
     => Manager
     -- ^ Manager for making HTTP requests
     -> Maybe S.Algorithm
     -- ^ Signature algorithm possibly specified in the HTTP signature header
-    -> Text
+    -> Authority u
     -- ^ Instance host
     -> Maybe LocalURI
     -- ^ Actor URI possibly provided in the HTTP request's actor header
-    -> LocalURI
+    -> LocalRefURI
     -- ^ Key URI provided in HTTP signature header
     -> ExceptT String m Fetched
 fetchUnknownKey manager malgo host mluActor luKey = do
@@ -1253,9 +1294,10 @@ fetchUnknownKey manager malgo host mluActor luKey = do
                     , fetchedKeyShared  = oi
                     }
             Right actor -> do
-                if actorId actor == luKey { luriFragment = "" }
-                    then return ()
-                    else throwE "Actor ID doesn't match the keyid URI we fetched"
+                case luKey of
+                    LocalRefURI (Right lsu) |
+                        actorId actor == localSubUriResource lsu -> return ()
+                    _ -> throwE "Actor ID doesn't match the keyid URI we fetched"
                 for_ mluActor $ \ lu ->
                     if actorId actor == lu
                         then return ()
@@ -1283,19 +1325,19 @@ keyDetail pk = (publicKeyMaterial pk, publicKeyExpires pk)
 -- | Fetch a personal key we already have cached locally, but we'd like to
 -- refresh the local copy by fetching the key again from the server.
 fetchKnownPersonalKey
-    :: MonadIO m
+    :: (MonadIO m, UriMode u)
     => Manager
     -- ^ Manager for making HTTP requests
     -> Maybe S.Algorithm
     -- ^ Signature algorithm possibly specified in the HTTP signature header
-    -> Text
+    -> Authority u
     -- ^ Instance host
     -> LocalURI
     -- ^ Key owner actor ID URI
-    -> LocalURI
+    -> LocalRefURI
     -- ^ Key URI
     -> ExceptT String m (PublicVerifKey, Maybe UTCTime)
-fetchKnownPersonalKey manager malgo host luOwner luKey = do
+fetchKnownPersonalKey manager malgo host luOwner luKey@(LocalRefURI ek) = do
     obj <- fetchAPIDOrH manager publicKeyId host luKey
     (material, mexpires) <-
         case obj of
@@ -1306,9 +1348,9 @@ fetchKnownPersonalKey manager malgo host luOwner luKey = do
                         when (luOwner /= owner) $ throwE "Key owner changed"
                 return $ keyDetail pkey
             Right actor -> do
-                when (actorId actor /= luKey { luriFragment = "" }) $
+                unless (Right (actorId actor) == second localSubUriResource ek) $
                     throwE "Actor ID doesn't match the keyid URI we fetched"
-                when (actorId actor /= luOwner) $
+                unless (actorId actor == luOwner) $
                     throwE "Key owner changed"
                 pk <- matchKeyObj luKey $ actorPublicKeys actor
                 case publicKeyOwner pk of
@@ -1323,22 +1365,22 @@ fetchKnownPersonalKey manager malgo host luOwner luKey = do
 -- | Fetch a shared key we already have cached locally, but we'd like to
 -- refresh the local copy by fetching the key again from the server.
 fetchKnownSharedKey
-    :: MonadIO m
+    :: (MonadIO m, UriMode u)
     => Manager
     -- ^ Manager for making HTTP requests
     -> Maybe S.Algorithm
     -- ^ Signature algorithm possibly specified in the HTTP signature header
-    -> Text
+    -> Authority u
     -- ^ Instance host
     -> LocalURI
     -- ^ Actor ID from HTTP actor header
-    -> LocalURI
+    -> LocalRefURI
     -- ^ Key URI
     -> ExceptT String m (PublicVerifKey, Maybe UTCTime)
 fetchKnownSharedKey manager malgo host luActor luKey = do
     obj <- fetchAPIDOrH manager publicKeyId host luKey
     pkey <-
-        case obj :: Either PublicKey Actor of
+        case asKeyOrActor host obj of
             Left pk -> return pk
             Right _actor -> throwE "Expected stand-alone key, got embedded key"
     case publicKeyOwner pkey of
@@ -1347,3 +1389,9 @@ fetchKnownSharedKey manager malgo host luActor luKey = do
     let (material, mexpires) = keyDetail pkey
     ExceptT . pure $ verifyAlgo malgo material
     return (material, mexpires)
+    where
+    asKeyOrActor
+        :: Authority u
+        -> Either (PublicKey u) (Actor u)
+        -> Either (PublicKey u) (Actor u)
+    asKeyOrActor _ = id
diff --git a/src/Yesod/ActivityPub.hs b/src/Yesod/ActivityPub.hs
index 13d2262..9cb12a6 100644
--- a/src/Yesod/ActivityPub.hs
+++ b/src/Yesod/ActivityPub.hs
@@ -47,11 +47,12 @@ import Network.HTTP.Signature
 import Database.Persist.JSON
 import Network.FedURI
 import Web.ActivityPub
+import Yesod.FedURI
 import Yesod.MonadSite
 import Yesod.RenderSource
 
-class Yesod site => YesodActivityPub site where
-    siteInstanceHost          :: site -> Text
+class (Yesod site, SiteFedURI site) => YesodActivityPub site where
+    siteInstanceHost          :: site -> Authority (SiteFedURIMode site)
     sitePostSignedHeaders     :: site -> NonEmpty HeaderName
     siteGetHttpSign           :: (MonadSite m, SiteEnv m ~ site)
                               => m (KeyId, ByteString -> Signature)
@@ -64,11 +65,12 @@ class Yesod site => YesodActivityPub site where
 deliverActivity'
     :: ( MonadSite m
        , SiteEnv m ~ site
+       , SiteFedURIMode site ~ u
        , HasHttpManager site
        , YesodActivityPub site
        )
-    => FedURI
-    -> Maybe FedURI
+    => ObjURI u
+    -> Maybe (ObjURI u)
     -> Text
     -> BL.ByteString
     -> m (Either APPostError (Response ()))
@@ -82,12 +84,12 @@ deliverActivity' inbox mfwd sender body = do
     case result of
         Left err ->
             logError $ T.concat
-                [ "deliverActivity to inbox <", renderFedURI inbox
+                [ "deliverActivity to inbox <", renderObjURI inbox
                 , "> error: ", T.pack $ displayException err
                 ]
         Right resp ->
             logDebug $ T.concat
-                [ "deliverActivity to inbox <", renderFedURI inbox
+                [ "deliverActivity to inbox <", renderObjURI inbox
                 , "> success: ", T.pack $ show $ responseStatus resp
                 ]
     return result
@@ -95,26 +97,28 @@ deliverActivity' inbox mfwd sender body = do
 deliverActivity
     :: ( MonadSite m
        , SiteEnv m ~ site
+       , SiteFedURIMode site ~ u
        , HasHttpManager site
        , YesodActivityPub site
        )
-    => FedURI
-    -> Maybe FedURI
-    -> Doc Activity
+    => ObjURI u
+    -> Maybe (ObjURI u)
+    -> Doc Activity u
     -> m (Either APPostError (Response ()))
 deliverActivity inbox mfwd doc@(Doc hAct activity) =
-    let sender = renderFedURI $ l2f hAct (activityActor activity)
+    let sender = renderObjURI $ ObjURI hAct (activityActor activity)
         body = encode doc
     in  deliverActivity' inbox mfwd sender body
 
 deliverActivityBL
     :: ( MonadSite m
        , SiteEnv m ~ site
+       , SiteFedURIMode site ~ u
        , HasHttpManager site
        , YesodActivityPub site
        )
-    => FedURI
-    -> Maybe FedURI
+    => ObjURI u
+    -> Maybe (ObjURI u)
     -> Route site
     -> BL.ByteString
     -> m (Either APPostError (Response ()))
@@ -126,11 +130,12 @@ deliverActivityBL inbox mfwd senderR body = do
 deliverActivityBL'
     :: ( MonadSite m
        , SiteEnv m ~ site
+       , SiteFedURIMode site ~ u
        , HasHttpManager site
        , YesodActivityPub site
        )
-    => FedURI
-    -> Maybe FedURI
+    => ObjURI u
+    -> Maybe (ObjURI u)
     -> BL.ByteString
     -> m (Either APPostError (Response ()))
 deliverActivityBL' inbox mfwd body = do
@@ -144,10 +149,11 @@ deliverActivityBL' inbox mfwd body = do
 forwardActivity
     :: ( MonadSite m
        , SiteEnv m ~ site
+       , SiteFedURIMode site ~ u
        , HasHttpManager site
        , YesodActivityPub site
        )
-    => FedURI
+    => ObjURI u
     -> ByteString
     -> Route site
     -> BL.ByteString
@@ -163,12 +169,12 @@ forwardActivity inbox sig rSender body = do
     case result of
         Left err ->
             logError $ T.concat
-                [ "forwardActivity to inbox <", renderFedURI inbox
+                [ "forwardActivity to inbox <", renderObjURI inbox
                 , "> error: ", T.pack $ displayException err
                 ]
         Right resp ->
             logDebug $ T.concat
-                [ "forwardActivity to inbox <", renderFedURI inbox
+                [ "forwardActivity to inbox <", renderObjURI inbox
                 , "> success: ", T.pack $ show $ responseStatus resp
                 ]
     return result
@@ -178,15 +184,15 @@ redirectToPrettyJSON
 redirectToPrettyJSON route = redirect (route, [("prettyjson", "true")])
 
 provideHtmlAndAP
-    :: (YesodActivityPub site, ActivityPub a)
-    => a -> WidgetFor site () -> HandlerFor site TypedContent
+    :: (YesodActivityPub site, SiteFedURIMode site ~ u, ActivityPub a)
+    => a u -> WidgetFor site () -> HandlerFor site TypedContent
 provideHtmlAndAP object widget = do
     host <- getsYesod siteInstanceHost
     provideHtmlAndAP' host object widget
 
 provideHtmlAndAP'
-    :: (YesodActivityPub site, ActivityPub a)
-    => Text -> a -> WidgetFor site () -> HandlerFor site TypedContent
+    :: (YesodActivityPub site, SiteFedURIMode site ~ u, ActivityPub a)
+    => Authority u -> a u -> WidgetFor site () -> HandlerFor site TypedContent
 provideHtmlAndAP' host object widget = selectRep $ do
     let doc = Doc host object
     provideAP $ pure doc
diff --git a/src/Yesod/FedURI.hs b/src/Yesod/FedURI.hs
index 54ea8e6..50a8cd8 100644
--- a/src/Yesod/FedURI.hs
+++ b/src/Yesod/FedURI.hs
@@ -14,7 +14,8 @@
  -}
 
 module Yesod.FedURI
-    ( getEncodeRouteLocal
+    ( SiteFedURI (..)
+    , getEncodeRouteLocal
     , getEncodeRouteHome
     , getEncodeRouteFed
     , decodeRouteLocal
@@ -24,12 +25,9 @@ module Yesod.FedURI
     )
 where
 
-import Control.Monad
-import Data.Text (Text)
 import Data.Text.Encoding
 import Network.HTTP.Types.URI
 import Yesod.Core
-import Yesod.Core.Handler
 
 import qualified Data.Text as T
 
@@ -38,55 +36,60 @@ import Yesod.MonadSite
 
 import Yesod.Paginate.Local
 
-getEncodeRouteLocal :: MonadSite m => m (Route (SiteEnv m) -> LocalURI)
-getEncodeRouteLocal = (\ f -> snd . f2l . f) <$> getEncodeRouteHome
+class UriMode (SiteFedURIMode site) => SiteFedURI site where
+    type SiteFedURIMode site
 
-getEncodeRouteHome :: MonadSite m => m (Route (SiteEnv m) -> FedURI)
+getEncodeRouteHome
+    :: (MonadSite m, SiteEnv m ~ site, SiteFedURI site)
+    => m (Route site -> ObjURI (SiteFedURIMode site))
 getEncodeRouteHome = toFed <$> askUrlRender
     where
     toFed renderUrl route =
-        case parseFedURI $ renderUrl route of
-            Left e -> error $ "getUrlRender produced invalid FedURI: " ++ e
+        case parseObjURI $ renderUrl route of
+            Left e -> error $ "askUrlRender produced invalid ObjURI: " ++ e
             Right u -> u
 
-getEncodeRouteFed :: MonadSite m => m (Text -> Route (SiteEnv m) -> FedURI)
-getEncodeRouteFed = toFed <$> askUrlRender
-    where
-    toFed renderUrl host route =
-        case parseFedURI $ renderUrl route of
-            Left e -> error $ "getUrlRender produced invalid FedURI: " ++ e
-            Right u -> u { furiHost = host }
+getEncodeRouteLocal
+    :: (MonadSite m, SiteEnv m ~ site, SiteFedURI site)
+    => m (Route site -> LocalURI)
+getEncodeRouteLocal = (objUriLocal .) <$> getEncodeRouteHome
+
+getEncodeRouteFed
+    :: ( MonadSite m
+       , SiteEnv m ~ site
+       , SiteFedURI site
+       , SiteFedURIMode site ~ u
+       )
+    => m (Authority u -> Route site -> ObjURI u)
+getEncodeRouteFed = (\ f a -> ObjURI a . f) <$> getEncodeRouteLocal
 
 decodeRouteLocal :: ParseRoute site => LocalURI -> Maybe (Route site)
 decodeRouteLocal =
-    parseRoute . (,[]) . decodePathSegments . encodeUtf8 . luriPath <=< noFrag
-    where
-    noFrag lu =
-        if T.null $ luriFragment lu
-            then Just lu
-            else Nothing
+    parseRoute . (,[]) . decodePathSegments . encodeUtf8 . localUriPath
 
 getEncodeRoutePageLocal
-    :: (MonadSite m, YesodPaginate (SiteEnv m))
-    => m (Route (SiteEnv m) -> Int -> LocalPageURI)
-getEncodeRoutePageLocal = do
-    encodeRouteLocal <- getEncodeRouteLocal
-    param <- asksSite sitePageParamName
-    return $ \ route page -> LocalPageURI (encodeRouteLocal route) param page
+    :: (MonadSite m, SiteEnv m ~ site, SiteFedURI site, YesodPaginate site)
+    => m (Route site -> Int -> LocalPageURI)
+getEncodeRoutePageLocal =
+    (\ f r n -> pageUriLocal $ f r n) <$> getEncodeRoutePageHome
 
 getEncodeRoutePageHome
-    :: (MonadSite m, YesodPaginate (SiteEnv m))
-    => m (Route (SiteEnv m) -> Int -> FedPageURI)
+    :: (MonadSite m, SiteEnv m ~ site, SiteFedURI site, YesodPaginate site)
+    => m (Route site -> Int -> PageURI (SiteFedURIMode site))
 getEncodeRoutePageHome = do
     encodeRouteHome <- getEncodeRouteHome
     param <- asksSite sitePageParamName
-    return $ \ route page -> FedPageURI (encodeRouteHome route) param page
+    return $ \ route page ->
+        let ObjURI a l = encodeRouteHome route
+        in  PageURI a $ LocalPageURI l param page
 
 getEncodeRoutePageFed
-    :: (MonadSite m, YesodPaginate (SiteEnv m))
-    => m (Text -> Route (SiteEnv m) -> Int -> FedPageURI)
-getEncodeRoutePageFed = do
-    encodeRouteFed <- getEncodeRouteFed
-    param <- asksSite sitePageParamName
-    return $
-        \ host route page -> FedPageURI (encodeRouteFed host route) param page
+    :: ( MonadSite m
+       , SiteEnv m ~ site
+       , SiteFedURI site
+       , YesodPaginate site
+       , SiteFedURIMode site ~ u
+       )
+    => m (Authority u -> Route site -> Int -> PageURI u)
+getEncodeRoutePageFed =
+    (\ f a r n -> PageURI a $ f r n) <$> getEncodeRoutePageLocal
diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet
index 4ae0091..09804b4 100644
--- a/templates/default-layout.hamlet
+++ b/templates/default-layout.hamlet
@@ -52,7 +52,7 @@ $if federationDisabled
             #{h}
 
 <.instance>
-  Vervis @ #{instanceHost}
+  Vervis @ #{renderAuthority instanceHost}
 
 ^{breadcrumbsW}
 
diff --git a/templates/discussion/widget/message.hamlet b/templates/discussion/widget/message.hamlet
index e9824fb..be5b8e3 100644
--- a/templates/discussion/widget/message.hamlet
+++ b/templates/discussion/widget/message.hamlet
@@ -19,7 +19,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
       <a href=@{MessageR (sharerIdent s) (encodeHid lmid)}>
         #{showTime $ messageCreated msg}
     $of MessageTreeNodeRemote h luMsg _luAuthor _mname
-      <a href="#{renderFedURI $ l2f h luMsg}"}>
+      <a href="#{renderObjURI $ ObjURI h luMsg}"}>
         #{showTime $ messageCreated msg}
 <div>
   ^{showContent $ messageContent msg}
diff --git a/templates/widget/actor-link.hamlet b/templates/widget/actor-link.hamlet
index c22ca27..1beb92a 100644
--- a/templates/widget/actor-link.hamlet
+++ b/templates/widget/actor-link.hamlet
@@ -22,7 +22,7 @@ $case actor
     <span>
       ./s/#{shr2text $ sharerIdent s}
   $of MessageTreeNodeRemote h _luMsg luAuthor mname
-    <a href="#{renderFedURI $ l2f h luAuthor}">
+    <a href="#{renderObjURI $ ObjURI h luAuthor}">
       $maybe name <- mname
         #{name}
       $nothing
diff --git a/vervis.cabal b/vervis.cabal
index e18fcfc..5369593 100644
--- a/vervis.cabal
+++ b/vervis.cabal
@@ -130,6 +130,7 @@ library
                        Vervis.Federation.Auth
                        Vervis.Federation.Discussion
                        Vervis.Federation.Ticket
+                       Vervis.FedURI
                        Vervis.Field.Key
                        Vervis.Field.Person
                        Vervis.Field.Project