/
UrlEncoded.purs
132 lines (115 loc) · 4.47 KB
/
UrlEncoded.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
module Polyform.Validators.UrlEncoded
( UrlValidation
, UrlError
, array
, boolean
, int
, number
, single
, urlEncoded
) where
import Prelude
import Control.Monad.Except (throwError)
import Data.Array (filter) as Array
import Data.Either (Either(..))
import Data.Int as Int
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, toMaybe)
import Data.Number as Number
import Data.String (Pattern(..), Replacement(..), joinWith, replaceAll, split, toLower)
import Data.Symbol (SProxy(..))
import Data.Traversable (sequence)
import Data.Tuple (Tuple(..))
import Data.Variant (inj)
import Foreign.Object (Object, fromFoldable, lookup)
import Polyform.Validation (V(..), hoistFnV)
import Polyform.Validators (Errors, Validator, fail)
type UrlValidation m e a b = Validator m (UrlError e) a b
type UrlError e = (urlError :: String | e)
type UrlEncoded = Object (Array String)
_urlErr :: SProxy "urlError"
_urlErr = SProxy
failure :: forall e a. String -> V (Errors (UrlError e)) a
failure s = fail $ inj _urlErr $ s
fromEither :: forall e a. Either String a -> V (Errors (UrlError e)) a
fromEither (Left e) = fail $ inj _urlErr e
fromEither (Right v) = Valid [] v
foreign import decodeURIComponentImpl :: String -> Nullable String
decodeURIComponent :: String -> Maybe String
decodeURIComponent = toMaybe <<< decodeURIComponentImpl
-- | I've written about this issue extensively:
-- | https://github.com/owickstrom/hyper/pull/62
-- |
-- | Shortly: browsers serialize space as `+` character
-- | which is incorrect according to the RFC 3986
-- | but it is spread behavior accross tested engines.
-- |
-- | If we want to be able to optionally distinct this `+`
-- | on the server side we have to convert it to `%2b` before
-- | decoding phase (as it is done in all investigated
-- | libraries - please check first post in the above thread).
type Options = { replacePlus :: Boolean }
defaultOptions :: Options
defaultOptions = { replacePlus: true }
parse :: Options -> String -> Either String UrlEncoded
parse opts
= split (Pattern "&")
>>> Array.filter (_ /= "")
>>> map (split (Pattern "="))
>>> map toTuple
>>> sequence
>>> map fromFoldable
where
toTuple :: Array String -> Either String (Tuple String (Array String))
toTuple kv =
case kv of
[key] -> case decodeURIComponent key of
Nothing → throwError (keyDecodingError key)
Just key' → pure (Tuple key' [])
[key, value] ->
let
value' =
if opts.replacePlus
then
replaceAll (Pattern "+") (Replacement " ") value
else
value
in
-- XXX we should probably change UrlError so it aggregates list of errors
case (decodeURIComponent key), (decodeURIComponent value') of
Just key', Just value'' → pure (Tuple key [value''])
Nothing, Just _ → throwError (keyDecodingError key)
Just key', Nothing → throwError (valueDecodingError key' value)
Nothing, Nothing → throwError (keyDecodingError key <> ", " <> valueDecodingError key value)
parts ->
throwError ("Invalid form key-value pair: " <> joinWith " " parts)
where
keyDecodingError key = "Unable to decode key: " <> key
valueDecodingError key value
= "Unable to decode key value: key = "
<> show key
<> ", value = "
<> show value
urlEncoded :: forall m e. Monad m => Options → UrlValidation m e String UrlEncoded
urlEncoded opts = hoistFnV $ \s -> fromEither (parse opts s)
number :: forall m e. Monad m => UrlValidation m e String Number
number = hoistFnV $ \s -> case Number.fromString s of
Just n -> pure n
Nothing -> failure $ "Could not parse " <> s <> " as number"
int :: forall m e. Monad m => UrlValidation m e String Int
int = hoistFnV $ \s -> case Int.fromString s of
Just n -> pure n
Nothing -> failure $ "Could not parse " <> s <> " as int"
boolean :: forall m e. Monad m => UrlValidation m e String Boolean
boolean = hoistFnV $ \s -> case toLower s of
"false" -> pure false
"true" -> pure true
_ -> failure $ "Could not parse " <> s <> " as boolean"
single :: forall m e. Monad m => String -> UrlValidation m e UrlEncoded String
single f = hoistFnV $ \q -> case lookup f q of
Just [s] -> pure s
_ -> failure $ "Could not find field " <> f
array :: forall m e. Monad m => String -> UrlValidation m e UrlEncoded (Array String)
array f = hoistFnV $ \q -> case lookup f q of
Just s -> pure s
Nothing -> failure $ "Could not find field " <> f