diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,9 @@
+## 0.3.6.1
+
+* Host now can contain unreserved characters rather than simply alpha
+  numeric ones, which was against RFC 3986. [Issue
+  73](https://github.com/mrkkrp/modern-uri/issues/73).
+
 ## 0.3.6.0
 
 * Now colons are not escaped in paths, unless the `URI` in question is a
diff --git a/Text/URI/Lens.hs b/Text/URI/Lens.hs
--- a/Text/URI/Lens.hs
+++ b/Text/URI/Lens.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
@@ -34,7 +35,6 @@
   )
 where
 
-import Control.Applicative (liftA2)
 import Data.Foldable (find)
 import Data.Functor.Contravariant
 import qualified Data.List.NonEmpty as NE
@@ -51,6 +51,10 @@
   )
 import qualified Text.URI.Types as URI
 
+#if !MIN_VERSION_base(4,18,0)
+import Control.Applicative (liftA2)
+#endif
+
 -- | 'URI' scheme lens.
 uriScheme :: Lens' URI (Maybe (RText 'Scheme))
 uriScheme f s = (\x -> s {URI.uriScheme = x}) <$> f (URI.uriScheme s)
@@ -158,10 +162,10 @@
 -- Helpers
 
 type Lens' s a =
-  forall f. Functor f => (a -> f a) -> s -> f s
+  forall f. (Functor f) => (a -> f a) -> s -> f s
 
 type Traversal' s a =
-  forall f. Applicative f => (a -> f a) -> s -> f s
+  forall f. (Applicative f) => (a -> f a) -> s -> f s
 
 type Getter s a =
   forall f. (Contravariant f, Functor f) => (a -> f a) -> s -> f s
diff --git a/Text/URI/Parser/ByteString.hs b/Text/URI/Parser/ByteString.hs
--- a/Text/URI/Parser/ByteString.hs
+++ b/Text/URI/Parser/ByteString.hs
@@ -51,7 +51,7 @@
 -- use directly in a Megaparsec parser.
 --
 -- @since 0.3.3.0
-mkURIBs :: MonadThrow m => ByteString -> m URI
+mkURIBs :: (MonadThrow m) => ByteString -> m URI
 mkURIBs input =
   case runParser (parserBs <* eof :: Parsec Void ByteString URI) "" input of
     Left b -> throwM (ParseExceptionBs b)
@@ -61,7 +61,7 @@
 -- Remember to use a concrete non-polymorphic parser type for efficiency.
 --
 -- @since 0.0.2.0
-parserBs :: MonadParsec e ByteString m => m URI
+parserBs :: (MonadParsec e ByteString m) => m URI
 parserBs = do
   uriScheme <- optional (try pScheme)
   mauth <- optional pAuthority
@@ -73,7 +73,7 @@
 {-# INLINEABLE parserBs #-}
 {-# SPECIALIZE parserBs :: Parsec Void ByteString URI #-}
 
-pScheme :: MonadParsec e ByteString m => m (RText 'Scheme)
+pScheme :: (MonadParsec e ByteString m) => m (RText 'Scheme)
 pScheme = do
   r <- liftR "scheme" mkScheme $ do
     x <- asciiAlphaChar
@@ -83,7 +83,7 @@
   return r
 {-# INLINE pScheme #-}
 
-pAuthority :: MonadParsec e ByteString m => m Authority
+pAuthority :: (MonadParsec e ByteString m) => m Authority
 pAuthority = do
   void (string "//")
   authUserInfo <- optional pUserInfo
@@ -93,7 +93,7 @@
 {-# INLINE pAuthority #-}
 
 -- | Parser that can parse host names.
-pHost :: MonadParsec e ByteString m => m [Word8]
+pHost :: (MonadParsec e ByteString m) => m [Word8]
 pHost =
   choice
     [ try (asConsumed ipLiteral),
@@ -101,7 +101,7 @@
       regName
     ]
   where
-    asConsumed :: MonadParsec e ByteString m => m a -> m [Word8]
+    asConsumed :: (MonadParsec e ByteString m) => m a -> m [Word8]
     asConsumed p = B.unpack . fst <$> match p
     ipLiteral =
       between (char 91) (char 93) $
@@ -143,7 +143,7 @@
       void (char 46)
       skipSome (unreservedChar <|> subDelimChar <|> char 58)
     regName = fmap (intercalate [46]) . flip sepBy1 (char 46) $ do
-      let ch = percentEncChar <|> asciiAlphaNumChar
+      let ch = percentEncChar <|> unreservedChar
       mx <- optional ch
       case mx of
         Nothing -> return []
@@ -155,7 +155,7 @@
           xs <- many r
           return (x : xs)
 
-pUserInfo :: MonadParsec e ByteString m => m UserInfo
+pUserInfo :: (MonadParsec e ByteString m) => m UserInfo
 pUserInfo = try $ do
   uiUsername <-
     liftR
@@ -175,7 +175,7 @@
 {-# INLINE pUserInfo #-}
 
 pPath ::
-  MonadParsec e ByteString m =>
+  (MonadParsec e ByteString m) =>
   Bool ->
   m (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
 pPath hasAuth = do
@@ -203,7 +203,7 @@
     )
 {-# INLINE pPath #-}
 
-pQuery :: MonadParsec e ByteString m => m [QueryParam]
+pQuery :: (MonadParsec e ByteString m) => m [QueryParam]
 pQuery = do
   void (char 63)
   void (optional (char 38))
@@ -222,7 +222,7 @@
             )
 {-# INLINE pQuery #-}
 
-pFragment :: MonadParsec e ByteString m => m (RText 'Fragment)
+pFragment :: (MonadParsec e ByteString m) => m (RText 'Fragment)
 pFragment = do
   void (char 35)
   liftR
@@ -238,7 +238,7 @@
 
 -- | Lift a smart constructor that consumes 'Text' into a parser.
 liftR ::
-  MonadParsec e ByteString m =>
+  (MonadParsec e ByteString m) =>
   -- | What is being parsed
   String ->
   -- | The smart constructor that produces the result
@@ -263,20 +263,20 @@
     Right text -> maybe empty return (f text)
 {-# INLINE liftR #-}
 
-asciiAlphaChar :: MonadParsec e ByteString m => m Word8
+asciiAlphaChar :: (MonadParsec e ByteString m) => m Word8
 asciiAlphaChar = satisfy isAsciiAlpha <?> "ASCII alpha character"
 {-# INLINE asciiAlphaChar #-}
 
-asciiAlphaNumChar :: MonadParsec e ByteString m => m Word8
+asciiAlphaNumChar :: (MonadParsec e ByteString m) => m Word8
 asciiAlphaNumChar = satisfy isAsciiAlphaNum <?> "ASCII alpha-numeric character"
 {-# INLINE asciiAlphaNumChar #-}
 
-unreservedChar :: MonadParsec e ByteString m => m Word8
+unreservedChar :: (MonadParsec e ByteString m) => m Word8
 unreservedChar = label "unreserved character" . satisfy $ \x ->
   isAsciiAlphaNum x || x == 45 || x == 46 || x == 95 || x == 126
 {-# INLINE unreservedChar #-}
 
-percentEncChar :: MonadParsec e ByteString m => m Word8
+percentEncChar :: (MonadParsec e ByteString m) => m Word8
 percentEncChar = do
   void (char 37)
   h <- restoreDigit <$> hexDigitChar
@@ -284,13 +284,13 @@
   return (h * 16 + l)
 {-# INLINE percentEncChar #-}
 
-subDelimChar :: MonadParsec e ByteString m => m Word8
+subDelimChar :: (MonadParsec e ByteString m) => m Word8
 subDelimChar = oneOf s <?> "sub-delimiter"
   where
     s = E.fromList (fromIntegral . ord <$> "!$&'()*+,;=")
 {-# INLINE subDelimChar #-}
 
-pchar :: MonadParsec e ByteString m => m Word8
+pchar :: (MonadParsec e ByteString m) => m Word8
 pchar =
   choice
     [ unreservedChar,
@@ -301,7 +301,7 @@
     ]
 {-# INLINE pchar #-}
 
-pchar' :: MonadParsec e ByteString m => m Word8
+pchar' :: (MonadParsec e ByteString m) => m Word8
 pchar' =
   choice
     [ unreservedChar,
diff --git a/Text/URI/Parser/Text.hs b/Text/URI/Parser/Text.hs
--- a/Text/URI/Parser/Text.hs
+++ b/Text/URI/Parser/Text.hs
@@ -45,7 +45,7 @@
 --
 -- This function uses the 'parser' parser under the hood, which you can also
 -- use directly in a Megaparsec parser.
-mkURI :: MonadThrow m => Text -> m URI
+mkURI :: (MonadThrow m) => Text -> m URI
 mkURI input =
   case runParser (parser <* eof :: Parsec Void Text URI) "" input of
     Left b -> throwM (ParseException b)
@@ -53,7 +53,7 @@
 
 -- | This parser can be used to parse 'URI' from strict 'Text'. Remember to
 -- use a concrete non-polymorphic parser type for efficiency.
-parser :: MonadParsec e Text m => m URI
+parser :: (MonadParsec e Text m) => m URI
 parser = do
   uriScheme <- optional (try pScheme)
   mauth <- optional pAuthority
@@ -65,7 +65,7 @@
 {-# INLINEABLE parser #-}
 {-# SPECIALIZE parser :: Parsec Void Text URI #-}
 
-pScheme :: MonadParsec e Text m => m (RText 'Scheme)
+pScheme :: (MonadParsec e Text m) => m (RText 'Scheme)
 pScheme = do
   r <- liftR "scheme" mkScheme $ do
     x <- asciiAlphaChar
@@ -75,7 +75,7 @@
   return r
 {-# INLINE pScheme #-}
 
-pAuthority :: MonadParsec e Text m => m Authority
+pAuthority :: (MonadParsec e Text m) => m Authority
 pAuthority = do
   void (string "//")
   authUserInfo <- optional pUserInfo
@@ -84,7 +84,7 @@
   return Authority {..}
 {-# INLINE pAuthority #-}
 
-pUserInfo :: MonadParsec e Text m => m UserInfo
+pUserInfo :: (MonadParsec e Text m) => m UserInfo
 pUserInfo = try $ do
   uiUsername <-
     liftR
@@ -104,7 +104,7 @@
 {-# INLINE pUserInfo #-}
 
 pPath ::
-  MonadParsec e Text m =>
+  (MonadParsec e Text m) =>
   Bool ->
   m (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
 pPath hasAuth = do
@@ -132,7 +132,7 @@
     )
 {-# INLINE pPath #-}
 
-pQuery :: MonadParsec e Text m => m [QueryParam]
+pQuery :: (MonadParsec e Text m) => m [QueryParam]
 pQuery = do
   void (char '?')
   void (optional (char '&'))
@@ -151,7 +151,7 @@
             )
 {-# INLINE pQuery #-}
 
-pFragment :: MonadParsec e Text m => m (RText 'Fragment)
+pFragment :: (MonadParsec e Text m) => m (RText 'Fragment)
 pFragment = do
   void (char '#')
   liftR
@@ -167,7 +167,7 @@
 
 -- | Lift a smart constructor that consumes 'Text' into a parser.
 liftR ::
-  MonadParsec e Text m =>
+  (MonadParsec e Text m) =>
   -- | What is being parsed
   String ->
   -- | The smart constructor that produces the result
diff --git a/Text/URI/Parser/Text/Utils.hs b/Text/URI/Parser/Text/Utils.hs
--- a/Text/URI/Parser/Text/Utils.hs
+++ b/Text/URI/Parser/Text/Utils.hs
@@ -36,7 +36,7 @@
 
 -- | Parser that can parse host names.
 pHost ::
-  MonadParsec e Text m =>
+  (MonadParsec e Text m) =>
   -- | Demand percent-encoding in reg names
   Bool ->
   m String
@@ -46,7 +46,7 @@
       regName
     ]
   where
-    asConsumed :: MonadParsec e Text m => m a -> m String
+    asConsumed :: (MonadParsec e Text m) => m a -> m String
     asConsumed p = T.unpack . fst <$> match p
     ipLiteral =
       between (char '[') (char ']') $
@@ -78,40 +78,36 @@
       void (char '.')
       skipSome (unreservedChar <|> subDelimChar <|> char ':')
     regName = fmap (intercalate ".") . flip sepBy1 (char '.') $ do
-      let ch =
-            if pe
-              then percentEncChar <|> asciiAlphaNumChar
-              else alphaNumChar
-      mx <- optional ch
-      case mx of
-        Nothing -> return ""
-        Just x -> do
-          let r =
-                ch
-                  <|> try
-                    (char '-' <* (lookAhead . try) (ch <|> char '-'))
-          xs <- many r
-          return (x : xs)
+      many $
+        if pe
+          then percentEncChar <|> unreservedChar
+          else unreservedCharUnicode
 {-# INLINEABLE pHost #-}
 
 -- | Parse an ASCII alpha character.
-asciiAlphaChar :: MonadParsec e Text m => m Char
+asciiAlphaChar :: (MonadParsec e Text m) => m Char
 asciiAlphaChar = satisfy isAsciiAlpha <?> "ASCII alpha character"
 {-# INLINE asciiAlphaChar #-}
 
 -- | Parse an ASCII alpha-numeric character.
-asciiAlphaNumChar :: MonadParsec e Text m => m Char
+asciiAlphaNumChar :: (MonadParsec e Text m) => m Char
 asciiAlphaNumChar = satisfy isAsciiAlphaNum <?> "ASCII alpha-numeric character"
 {-# INLINE asciiAlphaNumChar #-}
 
 -- | Parse an unreserved character.
-unreservedChar :: MonadParsec e Text m => m Char
+unreservedChar :: (MonadParsec e Text m) => m Char
 unreservedChar = label "unreserved character" . satisfy $ \x ->
   isAsciiAlphaNum x || x == '-' || x == '.' || x == '_' || x == '~'
 {-# INLINE unreservedChar #-}
 
+-- | Parse an unreserved character allowing Unicode.
+unreservedCharUnicode :: (MonadParsec e Text m) => m Char
+unreservedCharUnicode = label "unreserved character" . satisfy $ \x ->
+  isAlphaNum x || x == '-' || x == '.' || x == '_' || x == '~'
+{-# INLINE unreservedCharUnicode #-}
+
 -- | Parse a percent-encoded character.
-percentEncChar :: MonadParsec e Text m => m Char
+percentEncChar :: (MonadParsec e Text m) => m Char
 percentEncChar = do
   void (char '%')
   h <- digitToInt <$> hexDigitChar
@@ -120,14 +116,14 @@
 {-# INLINE percentEncChar #-}
 
 -- | Parse a sub-delimiter character.
-subDelimChar :: MonadParsec e Text m => m Char
+subDelimChar :: (MonadParsec e Text m) => m Char
 subDelimChar = oneOf s <?> "sub-delimiter"
   where
     s = E.fromList "!$&'()*+,;="
 {-# INLINE subDelimChar #-}
 
 -- | PCHAR thing from the spec.
-pchar :: MonadParsec e Text m => m Char
+pchar :: (MonadParsec e Text m) => m Char
 pchar =
   choice
     [ unreservedChar,
@@ -139,7 +135,7 @@
 {-# INLINE pchar #-}
 
 -- | 'pchar' adjusted for query parsing.
-pchar' :: MonadParsec e Text m => m Char
+pchar' :: (MonadParsec e Text m) => m Char
 pchar' =
   choice
     [ unreservedChar,
diff --git a/Text/URI/Render.hs b/Text/URI/Render.hs
--- a/Text/URI/Render.hs
+++ b/Text/URI/Render.hs
@@ -134,21 +134,21 @@
 
 data Renders b = Renders
   { rWord :: Word -> b,
-    rText :: forall l. RLabel l => Maybe Word8 -> RText l -> b
+    rText :: forall l. (RLabel l) => Maybe Word8 -> RText l -> b
   }
 
 equip ::
   forall b.
   (Word -> b) ->
-  (forall l. RLabel l => Maybe Word8 -> RText l -> b) ->
-  (forall (s :: Type). Reifies s (Renders b) => Tagged s b) ->
+  (forall l. (RLabel l) => Maybe Word8 -> RText l -> b) ->
+  (forall (s :: Type). (Reifies s (Renders b)) => Tagged s b) ->
   b
 equip rWord rText f = reify Renders {..} $ \(Proxy :: Proxy s') ->
   unTagged (f :: Tagged s' b)
 
 renderWord ::
   forall s b.
-  Reifies s (Renders b) =>
+  (Reifies s (Renders b)) =>
   Word ->
   Tagged s b
 renderWord = Tagged . rWord (reflect (Proxy :: Proxy s))
@@ -189,7 +189,7 @@
     ]
 {-# INLINE genericRender #-}
 
-rJust :: Monoid m => (a -> m) -> Maybe a -> m
+rJust :: (Monoid m) => (a -> m) -> Maybe a -> m
 rJust = maybe mempty
 
 rScheme :: Render (RText 'Scheme) b
@@ -271,7 +271,7 @@
 -- | Percent-encode a 'Text' value.
 percentEncode ::
   forall l.
-  RLabel l =>
+  (RLabel l) =>
   -- | Scheme of the URI
   Maybe (RText 'Scheme) ->
   -- | A byte to additionally escape
@@ -291,11 +291,11 @@
         Just (w, bs'') ->
           Just $
             if
-                | sap && w == 32 -> ('+', (bs'', []))
-                | nne w -> (chr (fromIntegral w), (bs'', []))
-                | otherwise ->
-                    let c :| cs = encodeByte w
-                     in (c, (bs'', cs))
+              | sap && w == 32 -> ('+', (bs'', []))
+              | nne w -> (chr (fromIntegral w), (bs'', []))
+              | otherwise ->
+                  let c :| cs = encodeByte w
+                   in (c, (bs'', cs))
     f (bs', x : xs) = Just (x, (bs', xs))
     encodeByte x = '%' :| [intToDigit h, intToDigit l]
       where
diff --git a/Text/URI/Types.hs b/Text/URI/Types.hs
--- a/Text/URI/Types.hs
+++ b/Text/URI/Types.hs
@@ -267,7 +267,7 @@
 instance NFData (RText l)
 
 -- | @since 0.3.1.0
-instance Typeable l => TH.Lift (RText l) where
+instance (Typeable l) => TH.Lift (RText l) where
   lift = liftData
   liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
 
@@ -321,7 +321,7 @@
 -- converting them to lower case.
 --
 -- See also: <https://tools.ietf.org/html/rfc3986#section-3.1>
-mkScheme :: MonadThrow m => Text -> m (RText 'Scheme)
+mkScheme :: (MonadThrow m) => Text -> m (RText 'Scheme)
 mkScheme = mkRText
 
 instance RLabel 'Scheme where
@@ -346,7 +346,7 @@
 -- converting them to lower case.
 --
 -- See also: <https://tools.ietf.org/html/rfc3986#section-3.2.2>
-mkHost :: MonadThrow m => Text -> m (RText 'Host)
+mkHost :: (MonadThrow m) => Text -> m (RText 'Host)
 mkHost = mkRText
 
 instance RLabel 'Host where
@@ -362,7 +362,7 @@
 -- This smart constructor does not perform any sort of normalization.
 --
 -- See also: <https://tools.ietf.org/html/rfc3986#section-3.2.1>
-mkUsername :: MonadThrow m => Text -> m (RText 'Username)
+mkUsername :: (MonadThrow m) => Text -> m (RText 'Username)
 mkUsername = mkRText
 
 instance RLabel 'Username where
@@ -378,7 +378,7 @@
 -- This smart constructor does not perform any sort of normalization.
 --
 -- See also: <https://tools.ietf.org/html/rfc3986#section-3.2.1>
-mkPassword :: MonadThrow m => Text -> m (RText 'Password)
+mkPassword :: (MonadThrow m) => Text -> m (RText 'Password)
 mkPassword = mkRText
 
 instance RLabel 'Password where
@@ -394,7 +394,7 @@
 -- This smart constructor does not perform any sort of normalization.
 --
 -- See also: <https://tools.ietf.org/html/rfc3986#section-3.3>
-mkPathPiece :: MonadThrow m => Text -> m (RText 'PathPiece)
+mkPathPiece :: (MonadThrow m) => Text -> m (RText 'PathPiece)
 mkPathPiece = mkRText
 
 instance RLabel 'PathPiece where
@@ -410,7 +410,7 @@
 -- This smart constructor does not perform any sort of normalization.
 --
 -- See also: <https://tools.ietf.org/html/rfc3986#section-3.4>
-mkQueryKey :: MonadThrow m => Text -> m (RText 'QueryKey)
+mkQueryKey :: (MonadThrow m) => Text -> m (RText 'QueryKey)
 mkQueryKey = mkRText
 
 instance RLabel 'QueryKey where
@@ -426,7 +426,7 @@
 -- This smart constructor does not perform any sort of normalization.
 --
 -- See also: <https://tools.ietf.org/html/rfc3986#section-3.4>
-mkQueryValue :: MonadThrow m => Text -> m (RText 'QueryValue)
+mkQueryValue :: (MonadThrow m) => Text -> m (RText 'QueryValue)
 mkQueryValue = mkRText
 
 instance RLabel 'QueryValue where
@@ -442,7 +442,7 @@
 -- This smart constructor does not perform any sort of normalization.
 --
 -- See also: <https://tools.ietf.org/html/rfc3986#section-3.5>
-mkFragment :: MonadThrow m => Text -> m (RText 'Fragment)
+mkFragment :: (MonadThrow m) => Text -> m (RText 'Fragment)
 mkFragment = mkRText
 
 instance RLabel 'Fragment where
@@ -526,7 +526,7 @@
             ]
       return ("v" ++ [v] ++ "." ++ xs)
     domainLabel = do
-      let g = arbitrary `suchThat` isAlphaNum
+      let g = arbitrary `suchThat` isUnreservedChar
       x <- g
       xs <-
         listOf $
@@ -535,6 +535,11 @@
       return ([x] ++ xs ++ [x'])
     regName = intercalate "." <$> resize 5 (listOf1 domainLabel)
 
+-- | Return 'True' if the given character is unreserved.
+isUnreservedChar :: Char -> Bool
+isUnreservedChar x =
+  isAlphaNum x || x == '-' || x == '.' || x == '_' || x == '~'
+
 -- | Make generator for refined text given how to lift a possibly empty
 -- arbitrary 'Text' value into a refined type.
 arbText :: (Text -> Maybe (RText l)) -> Gen (RText l)
@@ -551,5 +556,5 @@
 liftData :: (Data a, TH.Quote m) => a -> m TH.Exp
 liftData = TH.dataToExpQ (fmap liftText . cast)
 
-liftText :: TH.Quote m => Text -> m TH.Exp
+liftText :: (TH.Quote m) => Text -> m TH.Exp
 liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)
diff --git a/bench/memory/Main.hs b/bench/memory/Main.hs
--- a/bench/memory/Main.hs
+++ b/bench/memory/Main.hs
@@ -9,7 +9,7 @@
 import Data.Void
 import Text.Megaparsec
 import Text.URI (URI)
-import qualified Text.URI as URI
+import Text.URI qualified as URI
 import Weigh
 
 main :: IO ()
@@ -25,7 +25,7 @@
 -- Helpers
 
 -- | Test 'URI' as a polymorphic string.
-turiStr :: IsString a => a
+turiStr :: (IsString a) => a
 turiStr = "https://mark:secret@github.com:443/mrkkrp/modern-uri?foo=bar#fragment"
 
 -- | Test 'URI' in parsed form.
diff --git a/bench/speed/Main.hs b/bench/speed/Main.hs
--- a/bench/speed/Main.hs
+++ b/bench/speed/Main.hs
@@ -10,7 +10,7 @@
 import Data.Void
 import Text.Megaparsec
 import Text.URI (URI)
-import qualified Text.URI as URI
+import Text.URI qualified as URI
 
 main :: IO ()
 main =
@@ -26,7 +26,7 @@
 -- Helpers
 
 -- | Test 'URI' as a polymorphic string.
-turiStr :: IsString a => a
+turiStr :: (IsString a) => a
 turiStr = "https://mark:secret@github.com:443/mrkkrp/modern-uri?foo=bar#fragment"
 
 -- | Test 'URI' in parsed form.
diff --git a/modern-uri.cabal b/modern-uri.cabal
--- a/modern-uri.cabal
+++ b/modern-uri.cabal
@@ -1,11 +1,11 @@
 cabal-version:   2.4
 name:            modern-uri
-version:         0.3.6.0
+version:         0.3.6.1
 license:         BSD-3-Clause
 license-file:    LICENSE.md
 maintainer:      Mark Karpov <markkarpov92@gmail.com>
 author:          Mark Karpov <markkarpov92@gmail.com>
-tested-with:     ghc ==9.0.2 ghc ==9.2.4 ghc ==9.4.1
+tested-with:     ghc ==9.2.8 ghc ==9.4.5 ghc ==9.6.2
 homepage:        https://github.com/mrkkrp/modern-uri
 bug-reports:     https://github.com/mrkkrp/modern-uri/issues
 synopsis:        Modern library for working with URIs
@@ -44,7 +44,6 @@
         base >=4.15 && <5.0,
         bytestring >=0.2 && <0.12,
         containers >=0.5 && <0.7,
-        contravariant >=1.3 && <2.0,
         deepseq >=1.3 && <1.5,
         exceptions >=0.6 && <0.11,
         hashable >=1.3 && <2.0,
@@ -53,20 +52,15 @@
         profunctors >=5.2.1 && <6.0,
         reflection >=2.0 && <3.0,
         tagged >=0.8 && <0.9,
-        template-haskell >=2.10 && <2.20,
+        template-haskell >=2.10 && <2.21,
         text >=0.2 && <2.1
 
     if flag(dev)
-        ghc-options: -Wall -Werror
+        ghc-options: -Wall -Werror -Wpartial-fields -Wunused-packages
 
     else
         ghc-options: -O2 -Wall
 
-    if flag(dev)
-        ghc-options:
-            -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns
-            -Wnoncanonical-monad-instances
-
 test-suite tests
     type:               exitcode-stdio-1.0
     main-is:            Spec.hs
@@ -76,7 +70,7 @@
         Text.QQSpec
         Text.URISpec
 
-    default-language:   Haskell2010
+    default-language:   GHC2021
     build-depends:
         QuickCheck >=2.4 && <3.0,
         base >=4.15 && <5.0,
@@ -88,7 +82,9 @@
         text >=0.2 && <2.1
 
     if flag(dev)
-        ghc-options: -Wall -Werror
+        ghc-options:
+            -Wall -Werror -Wredundant-constraints -Wpartial-fields
+            -Wunused-packages
 
     else
         ghc-options: -O2 -Wall
@@ -97,7 +93,7 @@
     type:             exitcode-stdio-1.0
     main-is:          Main.hs
     hs-source-dirs:   bench/speed
-    default-language: Haskell2010
+    default-language: GHC2021
     build-depends:
         base >=4.15 && <5.0,
         bytestring >=0.2 && <0.12,
@@ -107,7 +103,9 @@
         text >=0.2 && <2.1
 
     if flag(dev)
-        ghc-options: -O2 -Wall -Werror
+        ghc-options:
+            -Wall -Werror -Wredundant-constraints -Wpartial-fields
+            -Wunused-packages
 
     else
         ghc-options: -O2 -Wall
@@ -116,18 +114,19 @@
     type:             exitcode-stdio-1.0
     main-is:          Main.hs
     hs-source-dirs:   bench/memory
-    default-language: Haskell2010
+    default-language: GHC2021
     build-depends:
         base >=4.15 && <5.0,
         bytestring >=0.2 && <0.12,
-        deepseq >=1.3 && <1.5,
         megaparsec >=8.0 && <10.0,
         modern-uri,
         text >=0.2 && <2.1,
         weigh >=0.0.4
 
     if flag(dev)
-        ghc-options: -O2 -Wall -Werror
+        ghc-options:
+            -Wall -Werror -Wredundant-constraints -Wpartial-fields
+            -Wunused-packages
 
     else
         ghc-options: -O2 -Wall
diff --git a/tests/Text/QQSpec.hs b/tests/Text/QQSpec.hs
--- a/tests/Text/QQSpec.hs
+++ b/tests/Text/QQSpec.hs
@@ -1,14 +1,13 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Text.QQSpec (spec) where
 
 import Test.Hspec
 import Text.URI
-import qualified Text.URI.QQ as QQ
+import Text.URI.QQ qualified as QQ
 
 spec :: Spec
 spec = do
diff --git a/tests/Text/URISpec.hs b/tests/Text/URISpec.hs
--- a/tests/Text/URISpec.hs
+++ b/tests/Text/URISpec.hs
@@ -6,18 +6,18 @@
 import Control.Monad
 import Data.ByteString (ByteString)
 import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as NE
+import Data.List.NonEmpty qualified as NE
 import Data.Maybe (isJust, isNothing)
 import Data.String (IsString (..))
 import Data.Text (Text)
-import qualified Data.Text as T
+import Data.Text qualified as T
 import Data.Void
 import Test.Hspec
 import Test.Hspec.Megaparsec
 import Test.QuickCheck
 import Text.Megaparsec
 import Text.URI (RTextException (..), RTextLabel (..), URI (..))
-import qualified Text.URI as URI
+import Text.URI qualified as URI
 
 instance Arbitrary Text where
   arbitrary = T.pack <$> arbitrary
@@ -28,6 +28,24 @@
     it "accepts valid URIs" $ do
       uri <- mkTestURI
       URI.mkURI testURI `shouldReturn` uri
+    it "accepts a URI with an underscore in host name" $ do
+      scheme <- URI.mkScheme "http"
+      host <- URI.mkHost "auth_service"
+      path <- mapM URI.mkPathPiece ["api", "v1", "users", "validate"]
+      URI.mkURI "http://auth_service:3000/api/v1/users/validate"
+        `shouldReturn` URI
+          { uriScheme = Just scheme,
+            uriAuthority =
+              Right
+                URI.Authority
+                  { URI.authUserInfo = Nothing,
+                    URI.authHost = host,
+                    URI.authPort = Just 3000
+                  },
+            uriPath = Just (False, NE.fromList path),
+            uriQuery = [],
+            uriFragment = Nothing
+          }
     it "rejects invalid URIs" $ do
       let e =
             err 0 . mconcat $
@@ -122,9 +140,12 @@
       URI.mkHost "104.155.144.4.sslip.io" `shouldRText` "104.155.144.4.sslip.io"
       URI.mkHost "юникод.рф" `shouldRText` "юникод.рф"
       URI.mkHost "" `shouldRText` ""
+      URI.mkHost "." `shouldRText` "."
+      URI.mkHost "my-host." `shouldRText` "my-host."
+      URI.mkHost "auth_service" `shouldRText` "auth_service"
     it "rejects invalid hosts" $ do
-      URI.mkHost "_something"
-        `shouldThrow` (== RTextException Host "_something")
+      URI.mkHost ")something"
+        `shouldThrow` (== RTextException Host ")something")
       URI.mkHost "some@thing"
         `shouldThrow` (== RTextException Host "some@thing")
   describe "mkUsername" $ do
@@ -204,9 +225,9 @@
                 etok ':',
                 etok '?',
                 etok '[',
-                elabel "ASCII alpha-numeric character",
-                elabel "username",
                 elabel "path piece",
+                elabel "unreserved character",
+                elabel "username",
                 eeof
               ]
           )
@@ -274,9 +295,8 @@
           ( mconcat
               [ utoks "foo%f0bar",
                 etok '%',
-                etok '-',
                 etok '.',
-                elabel "ASCII alpha-numeric character",
+                elabel "unreserved character",
                 elabel "host that can be decoded as UTF-8"
               ]
           )
@@ -381,7 +401,7 @@
       }
 
 -- | Polymorphic textual rendering of the 'URI' generated by 'mkTestURI'.
-testURI :: IsString a => a
+testURI :: (IsString a) => a
 testURI = "https://mark%3a%40:secret:%40@github.com:443/mrkkrp/modern-uri%2b:%40?foo:@=bar+:@#fragment:@"
 
 -- | A utility wrapper around 'URI.parser'.