Fix userinfo encoding

src/Data/URI/UserInfo.purs

@@ -1,13 +1,19 @@
-module Data.URI.UserInfo where
+module Data.URI.UserInfo 
+  ( UserInfo(..)
+  , parser
+  , print
+  )where
 
 import Prelude
 
 import Control.Alt ((<|>))
+import Data.Foldable (foldMap)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Data.Newtype (class Newtype)
-import Data.URI.Common (decodePCT, joinWith, parsePCTEncoded, parseSubDelims, parseUnreserved)
-import Global (encodeURI)
+import Data.String as Str
+import Data.URI.Common (decodePCTComponent, joinWith, parsePCTEncoded, parseSubDelims, parseUnreserved)
+import Global (encodeURIComponent)
 import Text.Parsing.StringParser (Parser)
 import Text.Parsing.StringParser.Combinators (many1)
 import Text.Parsing.StringParser.String (string)
@@ -25,9 +31,46 @@ parser ∷ Parser UserInfo
 parser = UserInfo <<< joinWith "" <$> many1 p
   where
   p = parseUnreserved
-    <|> parsePCTEncoded decodePCT
+    <|> parsePCTEncoded decodePCTComponent
     <|> parseSubDelims
     <|> string ":"
 
 print ∷ UserInfo → String
-print (UserInfo u) = encodeURI u
+print (UserInfo u) = encodeUserPassword u
+
+
+encodeUserPassword :: String -> String
+encodeUserPassword s = foldMap encodeChar $ Str.toCharArray s
+
+shouldNotEscape :: Char -> Boolean
+shouldNotEscape c =
+  {-
+  https://tools.ietf.org/html/rfc3986#section-3.2.1
+  userinfo    = *( unreserved / pct-encoded / sub-delims / ":" )
+
+  https://tools.ietf.org/html/rfc3986#section-2.1
+  pct-encoded = "%" HEXDIG HEXDIG
+
+  https://tools.ietf.org/html/rfc3986#section-2.3
+  unreserved  = ALPHA / DIGIT / "-" / "." / "_" / "~"
+
+  https://tools.ietf.org/html/rfc3986#section-2.1
+  sub-delims    = "!" / "$" / "&" / "'" / "(" / ")"
+                  / "*" / "+" / "," / ";" / "="
+  -}
+    -- unreserved
+    ('A' <= c && c <= 'Z')
+    || ('a' <= c && c <= 'z')
+    || ('0' <= c && c <= '9')
+    || c == '-' || c ==  '_' || c ==  '.' || c ==  '~'
+    -- sub-delims
+    || c == '!' || c == '$' || c == '&' || c == '\'' 
+    || c == '(' || c == ')' || c == '*' || c == '+'
+    || c == ',' || c == ';' || c == '='
+    -- userinfo
+    || c == ':'
+
+encodeChar :: Char -> String
+encodeChar c =
+  let cStr = Str.singleton c
+  in if shouldNotEscape c then cStr else encodeURIComponent cStr

test/Main.purs

@@ -115,6 +115,7 @@ main = runTest $ suite "Data.URI" do
 
   suite "UserInfo parser" do
     testRunParseSuccess UserInfo.parser "user" (UserInfo "user")
+    testRunParseSuccess UserInfo.parser "u%40ser" (UserInfo "u@ser")
     testRunParseSuccess UserInfo.parser "spaced%20user" (UserInfo "spaced user")
     testRunParseSuccess UserInfo.parser "user:password" (UserInfo "user:password")
     testRunParseSuccess UserInfo.parser "spaced%20user:password%25%C2%A3" (UserInfo "spaced user:password%£")