Do some checks on the host in FedURI parsing

Until now, there were some simple host checks when verifying the HTTP sig,
meant to forbid hosts that are IP addresses, local hosts, and maybe other weird
cases. These checks moved to Network.FedURI, so now FedURIs in general aren't
allowed to have such hosts. The host type is still `Text` though, for now.

src/Network/FedURI.hs

@@ -38,6 +38,7 @@ import Prelude
 import Control.Monad ((<=<))
 import Data.Aeson
 import Data.Bifunctor (bimap, first)
+import Data.Char
 import Data.Hashable
 import Data.Maybe (fromJust)
 import Data.Text (Text)
@@ -53,6 +54,7 @@ import qualified Data.Text as T (pack, unpack, stripPrefix)
 -- * 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
@@ -96,6 +98,12 @@ parseFedURI t = do
     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"
@@ -104,6 +112,8 @@ parseFedURI t = do
         , furiPath     = T.pack $ uriPath uri
         , furiFragment = T.pack $ uriFragment uri
         }
+    where
+    isAsciiLetter c = isAsciiLower c || isAsciiUpper c
 
 toURI :: FedURI -> URI
 toURI (FedURI h p f) = URI

src/Vervis/Foundation.hs

@@ -777,10 +777,6 @@ instance YesodHttpSig App where
                 Left e -> throwE $ "keyId in Sig header isn't a valid FedURI: " ++ e
                 Right u -> return u
         checkHost h = do
-            unless (T.any (== '.') h) $
-                throwE "Host doesn't contain periods"
-            unless (T.any isAsciiLetter h) $
-                throwE "Host doesn't contain ASCII letters"
             home <- getsYesod $ appInstanceHost . appSettings
             when (h == home) $
                 throwE "Received HTTP signed request from the instance's host"