Stack safety

.gitignore

@@ -6,3 +6,4 @@
 output
 generated-docs
 bower_components
+node_modules

CHANGELOG.md

@@ -9,6 +9,7 @@ Breaking changes:
 New features:
 
 Bugfixes:
+- Made all parsers stack safe on long input (#63 by @garyb)
 
 Other improvements:
 

spago.dhall

@@ -13,6 +13,7 @@
   , "gen"
   , "integers"
   , "js-uri"
+  , "lists"
   , "maybe"
   , "newtype"
   , "parsing"

src/URI/Common.purs

@@ -17,17 +17,16 @@ import Prelude
 import Control.Alt ((<|>))
 import Control.Monad.Except (throwError)
 import Control.Monad.State (get)
-import Data.Array as Array
 import Data.Either (Either(..), either)
 import Data.Generic.Rep (class Generic)
+import Data.List as List
 import Data.Maybe (fromJust)
 import Data.Newtype (class Newtype, un)
 import Data.Show.Generic (genericShow)
-import Data.String (joinWith) as String
 import Data.String.CodeUnits (singleton) as String
 import Data.String.NonEmpty (NonEmptyString)
+import Data.String.NonEmpty (joinWith, toString, unsafeFromString) as NES
 import Data.String.NonEmpty.CodeUnits (singleton) as NES
-import Data.String.NonEmpty (unsafeFromString, toString) as NES
 import JSURI (decodeURIComponent, encodeURIComponent)
 import Partial.Unsafe (unsafePartial)
 import Text.Parsing.Parser (ParseError(..), ParseState(..), Parser, ParserT(..), runParser)
@@ -93,11 +92,11 @@ printEncoded ∷ Parser String Char → String → String
 printEncoded p s = either (const s) identity (runParser s parse)
   where
     parse ∷ Parser String String
-    parse = (String.joinWith "" <$> Array.many (simpleChar <|> encodedChar)) <* eof
-    simpleChar ∷ Parser String String
-    simpleChar = String.singleton <$> p
-    encodedChar ∷ Parser String String
-    encodedChar = unsafePartial fromJust <<< encodeURIComponent <<< String.singleton <$> anyChar
+    parse = (NES.joinWith "" <$> List.manyRec (simpleChar <|> encodedChar)) <* eof
+    simpleChar ∷ Parser String NonEmptyString
+    simpleChar = NES.singleton <$> p
+    encodedChar ∷ Parser String NonEmptyString
+    encodedChar = unsafePartial (NES.unsafeFromString <<< fromJust) <<< encodeURIComponent <<< String.singleton <$> anyChar
 
 -- | A version of [`printEncoded`](#v:printEncoded) that operates on non-empty
 -- | strings.

src/URI/Extra/QueryPairs.purs

@@ -23,6 +23,7 @@ import Data.Array as Array
 import Data.Bifunctor (bimap)
 import Data.Either (Either)
 import Data.Generic.Rep (class Generic)
+import Data.List as List
 import Data.Maybe (Maybe(..), fromJust)
 import Data.Show.Generic (genericShow)
 import Data.String as String
@@ -78,10 +79,10 @@ parsePart
   → Parser String (Tuple k (Maybe v))
 parsePart parseK parseV = do
   key ← wrapParser (parseK <<< Key) $
-    NES.joinWith "" <$> Array.some (NES.singleton <$> keyPartChar <|> pctEncoded)
+    NES.joinWith "" <$> List.someRec (NES.singleton <$> keyPartChar <|> pctEncoded)
   value ← wrapParser (traverse (parseV <<< Value)) $ optionMaybe do
     _ ← char '='
-    NES.joinWith "" <$> Array.many (NES.singleton <$> valuePartChar <|> pctEncoded)
+    NES.joinWith "" <$> List.manyRec (NES.singleton <$> valuePartChar <|> pctEncoded)
   pure $ Tuple key value
 
 -- | A printer for key/value pairs style query string.

src/URI/Fragment.purs

@@ -12,10 +12,10 @@ module URI.Fragment
 import Prelude
 
 import Control.Alt ((<|>))
-import Data.Array as Array
+import Data.List as List
 import Data.Maybe (fromJust)
-import Data.String.NonEmpty.CodeUnits (singleton) as NES
 import Data.String.NonEmpty (joinWith) as NES
+import Data.String.NonEmpty.CodeUnits (singleton) as NES
 import JSURI (decodeURIComponent)
 import Partial.Unsafe (unsafePartial)
 import Text.Parsing.Parser (Parser)
@@ -75,7 +75,7 @@ parser ∷ Parser String Fragment
 parser =
   char '#' *>
     (Fragment <<< NES.joinWith ""
-      <$> Array.many (pctEncoded <|> NES.singleton <$> fragmentChar))
+      <$> List.manyRec (pctEncoded <|> NES.singleton <$> fragmentChar))
 
 -- | A printer for the fragment component of a URI. Will print the value with
 -- | a `'#'` prefix.

src/URI/Host/IPv6Address.purs

@@ -8,8 +8,9 @@ module URI.Host.IPv6Address
 import Prelude
 
 import Control.Alt ((<|>))
-import Data.Array as Array
-import Data.String.CodeUnits as String
+import Data.List as List
+import Data.String.NonEmpty as NES
+import Data.String.NonEmpty.CodeUnits as NESCU
 import Text.Parsing.Parser (Parser)
 import Text.Parsing.Parser.Combinators ((<?>))
 import Text.Parsing.Parser.String (char)
@@ -34,7 +35,7 @@ unsafeToString (IPv6Address s) = "[" <> s <> "]"
 parser ∷ Parser String IPv6Address
 parser =
   IPv6Address
-    <$> (char '[' *> (String.fromCharArray <$> Array.some ipv6Char) <* char ']')
+    <$> (char '[' *> (NES.joinWith "" <$> List.someRec (NESCU.singleton <$> ipv6Char)) <* char ']')
     <?> "IPv6 address"
   where
     ipv6Char ∷ Parser String Char

src/URI/Path.purs

@@ -4,6 +4,7 @@ import Prelude
 
 import Data.Array as Array
 import Data.Generic.Rep (class Generic)
+import Data.List as List
 import Data.Show.Generic (genericShow)
 import Data.String as String
 import Text.Parsing.Parser (Parser)
@@ -26,7 +27,7 @@ instance showPath ∷ Show Path where show = genericShow
 
 -- | A parser for a _path-abempty_ URI component.
 parser ∷ Parser String Path
-parser = Path <$> Array.many (char '/' *> parseSegment)
+parser = Path <<< Array.fromFoldable <$> List.manyRec (char '/' *> parseSegment)
 
 -- | A printer for a _path-abempty_ URI component.
 print ∷ Path → String

src/URI/Path/Absolute.purs

@@ -4,6 +4,7 @@ import Prelude
 
 import Data.Array as Array
 import Data.Generic.Rep (class Generic)
+import Data.List as List
 import Data.Maybe (Maybe(..))
 import Data.Show.Generic (genericShow)
 import Data.String as String
@@ -36,7 +37,11 @@ parse = do
   _ ← char '/'
   optionMaybe parseSegmentNZ >>= case _ of
     Just head →
-      PathAbsolute <<< Just <<< Tuple head <$> Array.many (char '/' *> parseSegment)
+      PathAbsolute
+        <<< Just
+        <<< Tuple head
+        <<< Array.fromFoldable
+        <$> List.manyRec (char '/' *> parseSegment)
     Nothing →
       pure (PathAbsolute Nothing)
 

src/URI/Path/NoScheme.purs

@@ -4,6 +4,7 @@ import Prelude
 
 import Data.Array as Array
 import Data.Generic.Rep (class Generic)
+import Data.List as List
 import Data.Show.Generic (genericShow)
 import Data.String as String
 import Data.Tuple (Tuple(..))
@@ -27,8 +28,8 @@ instance showPathNoScheme ∷ Show PathNoScheme where show = genericShow
 parse ∷ Parser String PathNoScheme
 parse = do
   head ← parseSegmentNZNC
-  tail ← Array.many (char '/' *> parseSegment)
-  pure (PathNoScheme (Tuple head tail))
+  tail ← List.manyRec (char '/' *> parseSegment)
+  pure (PathNoScheme (Tuple head (Array.fromFoldable tail)))
 
 -- | A printer for a _path-noscheme_ URI component.
 print ∷ PathNoScheme → String

src/URI/Path/Rootless.purs

@@ -4,6 +4,7 @@ import Prelude
 
 import Data.Array as Array
 import Data.Generic.Rep (class Generic)
+import Data.List as List
 import Data.Show.Generic (genericShow)
 import Data.String as String
 import Data.Tuple (Tuple(..))
@@ -25,8 +26,8 @@ instance showPathRootless ∷ Show PathRootless where show = genericShow
 parse ∷ Parser String PathRootless
 parse = do
   head ← parseSegmentNZ
-  tail ← Array.many (char '/' *> parseSegment)
-  pure (PathRootless (Tuple head tail))
+  tail ← List.manyRec (char '/' *> parseSegment)
+  pure (PathRootless (Tuple head (Array.fromFoldable tail)))
 
 -- | A printer for a _path-rootless_ URI component.
 print ∷ PathRootless → String

src/URI/Path/Segment.purs

@@ -27,12 +27,12 @@ module URI.Path.Segment
 import Prelude
 
 import Control.Alt ((<|>))
-import Data.Array as Array
 import Data.Array.NonEmpty as NEA
+import Data.List as List
 import Data.Maybe (fromJust)
 import Data.String.NonEmpty (NonEmptyString)
-import Data.String.NonEmpty.CodeUnits (singleton) as NES
 import Data.String.NonEmpty (join1With, joinWith, toString) as NES
+import Data.String.NonEmpty.CodeUnits (singleton) as NES
 import JSURI (decodeURIComponent)
 import Partial.Unsafe (unsafePartial)
 import Text.Parsing.Parser (Parser)
@@ -81,7 +81,7 @@ parseSegment ∷ Parser String PathSegment
 parseSegment =
   PathSegment
     <<< NES.joinWith ""
-    <$> Array.many (pctEncoded <|> NES.singleton <$> segmentChar)
+    <$> List.manyRec (pctEncoded <|> NES.singleton <$> segmentChar)
 
 -- | A printer for a _segment_ component of a URI.
 printSegment ∷ PathSegment → String

src/URI/Port.purs

@@ -9,10 +9,11 @@ module URI.Port
 
 import Prelude
 
-import Data.Array as Array
 import Data.Int (decimal, fromStringAs)
+import Data.List as List
 import Data.Maybe (Maybe(..))
-import Data.String.CodeUnits as String
+import Data.String.NonEmpty (joinWith) as NES
+import Data.String.NonEmpty.CodeUnits (singleton) as NES
 import Partial.Unsafe (unsafeCrashWith)
 import Text.Parsing.Parser (Parser, fail)
 import Text.Parsing.Parser.String (char)
@@ -53,7 +54,7 @@ unsafeFromInt i =
 -- | `':'` prefix.
 parser ∷ Parser String Port
 parser = do
-  s ← String.fromCharArray <$> (char ':' *> Array.some digit)
+  s ← NES.joinWith "" <$> (char ':' *> List.someRec (NES.singleton <$> digit))
   case fromStringAs decimal s of
     Just x → pure (Port x)
     _ → fail "Expected a valid port number"

src/URI/Query.purs

@@ -12,10 +12,10 @@ module URI.Query
 import Prelude
 
 import Control.Alt ((<|>))
-import Data.Array as Array
+import Data.List as List
 import Data.Maybe (fromJust)
-import Data.String.NonEmpty.CodeUnits (singleton) as NES
 import Data.String.NonEmpty (joinWith) as NES
+import Data.String.NonEmpty.CodeUnits (singleton) as NES
 import JSURI (decodeURIComponent)
 import Partial.Unsafe (unsafePartial)
 import Text.Parsing.Parser (Parser)
@@ -79,7 +79,7 @@ parser ∷ Parser String Query
 parser =
   char '?' *>
     (Query <<< NES.joinWith ""
-      <$> Array.many (NES.singleton <$> queryChar <|> pctEncoded))
+      <$> List.manyRec (NES.singleton <$> queryChar <|> pctEncoded))
 
 -- | A printer for the query component of a URI. Will print the value with
 -- | a `'?'` prefix.

src/URI/Scheme.purs

@@ -10,13 +10,12 @@ module URI.Scheme
 import Prelude
 
 import Control.Alt ((<|>))
-import Data.Array as Array
 import Data.Either (hush)
+import Data.List as List
 import Data.Maybe (Maybe(..))
-import Data.String.CodeUnits as String
 import Data.String.NonEmpty (NonEmptyString)
+import Data.String.NonEmpty (appendString, joinWith, toString) as NES
 import Data.String.NonEmpty.CodeUnits (singleton) as NES
-import Data.String.NonEmpty (appendString, toString) as NES
 import Partial.Unsafe (unsafeCrashWith)
 import Text.Parsing.Parser (Parser, runParser)
 import Text.Parsing.Parser.String (char, eof)
@@ -71,8 +70,8 @@ parser = Scheme <$> parseScheme <* char ':'
 parseScheme ∷ Parser String NonEmptyString
 parseScheme = do
   init ← alpha
-  rest ← Array.many (alphaNum <|> char '+' <|> char '-' <|> char '.')
-  pure $ NES.singleton init `NES.appendString` String.fromCharArray rest
+  rest ← NES.joinWith "" <$> List.manyRec (NES.singleton <$> (alphaNum <|> char '+' <|> char '-' <|> char '.'))
+  pure $ NES.singleton init `NES.appendString` rest
 
 -- | A printer for the scheme component of a URI. Prints a scheme value
 -- | followed by a `':'`.

test/URI/Extra/QueryPairs.purs

@@ -78,3 +78,10 @@ spec =
         , Tuple (NQP.unsafeKeyFromString "docTypeKey") (Just (NQP.unsafeValueFromString "type"))
         , Tuple (NQP.unsafeKeyFromString "queryTimeoutSeconds") (Just (NQP.unsafeValueFromString "20"))
         ])
+    testIso parser printer
+      ("?code=" <> longCode)
+      (NQP.QueryPairs
+        [ Tuple (NQP.unsafeKeyFromString "code") (Just (NQP.unsafeValueFromString longCode))
+        ])
+    where
+      longCode = "eyJraWRiOiJjcGlTY29yZV8wOTI1MjAxNSNsInZlciI6IjEuMCIsInppcCI6IkRlZmxhdGUiLCJzZXIiOiIxLjAifQ..POoi6BeVmzh85nqw.2DBovxH_VhgEn0KQ67VlAOgPmJYxqJN-R4mrN45jGRL6Z4MiQQxn1xHmrgnvkWZ4zbTaUE8BtPoJw7nke6pLtiQqwo9y7Sf4MkkSuVbEg2b1lfmZ1gOCfRLFzAW5mWQrPEs5Vie4cjnhOZi-EkgQUQVP73apF8yjhKIZlrLdrbJV9ta8yf394rXKHeLUBU19F4tpf7zSKSJBBRfQDyouL4FbReRmnR9UHR6sixkOteNChJDoV0mnrPHPgaxaNpGLx4a1tR9DRdQnaqYUTMR0cbTEoJ1IfObKfPGdftJ2G_rsqfs9xGbmsow5BhAmF4CC9vzHtNvgPt_-N7Tz3mkTxhmX67tNT3YAgsRamduk9j_5h6aiTckh7XwcBhDbgp0PoyEXZ9mXatghLtJRZ-7B72WPKYTZs2jkF1Ir1E950I6sc2m3uw09zaGYFmxjSba-BipPD_lMzyVfIYThF_kHDHNspYb77ilhMuOhVsBkJ_-sQxPf5KdjzSGkLkgPBaZ8cCdgnantGc_DJWfl-NJWKZLNZ6w3j6nCWW4c19wjXrG-h2C8rseudSoLy_IGQSsV-4uQLKwBSRMvfmk7ysLlfBFfHD4z3XGbuyJ2vsEzVOJngl-Ynyiac8nHt8yr7pi3Bvsi9CfsYKzMbxXBreQ3EM0pzOIdnPp5IgdfOMYU0wShE4OVspmP2ppiBcWZdrD55gYNgaHjD0jJWSJR80uPEx7nt2KW3JToXBcb0MxUcDa_2A0EbsOU578NZct4MEJsVDBdfGRC6XB55g7ZNwrYCmlzMeWt2nI_QIZArNM-5dfqjlvL7uvsKQg37gJDpCdNPWV1DVC3FAU1AVwZLeyYLk2CwN4OlGxXWLfxdo6-hgAg6_mS9HXZj05Krb4geV5MiSNCHIx3IPWe_LcXlRaZCjBO8YVipIZkpyh-JQywFl2lexb-t1M1450JozXry6Afd5ek4OrZpAlFI-KDP7y1RbgBoqYloySGGvTYItclFw7gsST42B1D1OWDDWacS9p6C-xl6wDONzRXU3xOBhifLJL6JGboZIadcupYl5AKh18MivIrt5oSd2BaLuMzax9YqSYJ2U8WpYp3QRkLbokhLq_D_whV-0R6zjDHk8t3zGXiRj9JXazTcirf8emYuigMaVOW9m6KcUeHhUM_gn4oATmZ3WfvnVqSSz72j8p_GwRM3P9C_nn1jOAuxA5j66KTpQTgLj7HIkTP-sm30qIe5PwWaWQrbPenI_Zfu03JMqTXiQOCVxSwmkjYbQkWYq7p1-0Ct4Wqwt7cyfMYnDhD8JZauIO2XA5eLuTRJm3ZEYclq0IStGx_HwJSERJtuHHOGQlnEYGxKAyYb8X9jwlHe4WYwQN9Sg7uIYVDUZ5R5k_Ol5KP2jyQLO0m9aRu2-pF05w8GDU52FJnjh2LvvQXkPH2pgY2rx65sss4hqj7B0h--WdFCGpT3cLSKJndJ6XfrF8uKGf_6WvQdcxggBkckeO1pkU9etll-Aq_Dxh6St0PCgegH9Do2QXfY6X0iEnZ5-r4BGmV3HjlFwtcAR5PDv8F71wmuz2GQbZnnQBrgtBIIkILHAAnBiVy-8Tl2QmKlkieEhISrju1fMSNnc5ZQ_vggqpeN47wTzsklY0z6liAfVMsvpoCAJm-g4FroYbVSha33Lc6lUv6jxIhdveidFzKDi8Sh_i8H3XwXI68FzgmSQDzOrZkAcPkoJItq_EROxy4KC-i7KZviZMVefQ0Fktd41fM0ik5LwWl5PgGKoFy_Cy8VsMMMsOurYGBj8YdjDxzz6wqOVbNPcPuLqJHJY9StEtqqhwVCwdfGqVSD_VPn6B_3RTXKQSGt5fCXIJNvY8170HTfyioE-ixPfBErTIny5FLiSokqmrTvCH3l1XfCd2Ee8zoLaUqnzOOOE4467vFVuxZ4CfIQLt6jIxJ0Tb0BOTIBkOELFjEZ0owEiX63eaxRF7f2sst78HN1V1NzEf1WNdbikJmE1TPX1KXNIaF2nEVpfVxVN3aWUu_nNzOUVLEF55dnrTJdgy8wsF7wRtflW1GfFOfA_D2im2dDCg688R3LcVjddpg-VYwuZ7FH00xXWkoy85h9aCX8OnmfahNpuwyBcXkYDx8X4pATt-ZW6XOK7eajZnKJedMrlVFv2Ll7dwnyv74p8fYXF85ilTgRJeE5j7Tkss1gt5zHjihLJq_256DhMKMTFyTa6D_Hp0MH5HqP6SoTE8qzFSvHz_skRtVgmOrtAJ4-ZGfhXuDFhqMTehmmIF9oCirWs7qZHq2stgYoNgmIAyqgCXkvt39YEkaUhnBdt71URQ9XjCPToLSnUmcaFhV2kzoj7PkunTa4saS0ARvDXP_z3mEZ-e9II-ASwfScJV6OqyDABeuKGkxOB_ddUxnXyL1F2K0X1qzi1kJ-TVmLDseN805hl3gqPOvbdh65mAPrDw4713a3LRsOiRfDjDmR3GE3QxyTYrXFGMiGShhuCjZBZKkqw4OJqX9alY9HrwvIk7wcBlXYUcjU5G1qUK0jP8ozRRAiyO8QRVkkI830NAF52RuhxKshkx7gGQaNLU-pQGv8aPCXi2rosYJfhqlqEQ16yhezRAh2591jCLNCcDP-XXIUyrrpWZO3nHvTUfsovFJlGYrwugPulF7PSoNBBuX7rYbLaORdGB8Hi3iFnRo_tJ-kBcH03aNOLWaRO0bLFmJveJjtPsTmIbSr6wKiYxfmROMjrHDI-_ATj7x6pDJUU2IAqauZgAUYZ_ddK1z7N76CkRtXnAj1LmsEULoyVqYjTo6ggKWBnamUEltVWPHuY3IuLsmpda2kdd7--KektSvGct0aJLc84gqQdJeQCeoIQ0pSeYHMwEU61AdZk6a2xQtKZwUOvLbp5DGXgHCqx9H3H0Qj_u-iVcEEgozY3NerPkTr_AsAUGVE1vT4HrUje0sxdE_X4d5CKXafuKd4POHTVs9Y4T7icdMn4rShSnyc4NiFzUyw89-rcf014jm1ll7bQSuRMsvs9x96hvXhC1syoBR3wSt9cRnHQuEPBr48eNwtd7vgmXVPFFRa5vF_Hl8pU0e8tvuCwB2HFO6dMoHAKKlp199goNTv7Y2xF0c1jx0QbuZ0MlcVatwZsBpqbgd6_WJZn4768uKAALHJOIDkNvquq3h8nOzlpmtjNn5cGcfzHuaqwj3qiuVboA14WoJ-FT4vr_enTHO_zoeLZVUmVLR9t36Yc5dg7teuAAn9lfUukHJ1mTbMZaFBtQj6kUHWJKc_T5vHdoVFTTdTex--RQUxc97NnknlPqKOuKOO2ECyYuW8ygt4IcP4iSMWQmdXS74TEdg8I9Qtc42rzYgwb16phKPv1GpXYdCHDl-SXe9EnY2FQJiWBFYTFIOwl4PKmygbaHO2qgYtx4MUsLFiEvfgabxGqP_UBUUlPvp3iWWYvbsNqHD0sS-M9gdwGtS7ejPs9ika2NHKiOjJrJKEPjpkHuY1pdmAu5WhzH2GvXECTKrJRJhxIQoBhLxrBUVDr9iXBdDUoT3NIVuqg56HDjVinD4KG8aba5klnPibYcDtUXgssoE1rEKcfCEN8gR7-Xf20y1hQ8vhC34ayVAUVTVW3V5LoOcdSqcRJR71PiVKjTVRDrP9KdQCUWzsb0toQ950x14yGzk6cI0ZRgiKx-sRjTWlb5c2QzuD22vLGF9mWjGH-4NPhlrasr5PcdXeNmpBEZU_xKEujeuveE7GIzbMfZ-_E45Rlqflcn5ZdIK0-0HMjrZ_sjnuQ.ZjIHxProSKoNwD6Py-8FOQ"