/
Form.purs
126 lines (106 loc) · 3.35 KB
/
Form.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
module Hyper.Form
( Form(..)
, optional
, required
, parseForm
, fromForm
, toForm
, class FromForm
, class ToForm
, parseFromForm
) where
import Prelude
import Data.Tuple as Tuple
import Control.IxMonad (ibind, ipure, (:>>=))
import Control.Monad.Error.Class (throwError)
import Data.Array (head)
import Data.Either (Either(..))
import Data.Generic (class Generic)
import Data.Maybe (Maybe(Just, Nothing), maybe)
import Data.MediaType (MediaType(MediaType))
import Data.MediaType.Common (applicationFormURLEncoded)
import Data.Monoid (class Monoid)
import Data.Newtype (class Newtype, unwrap)
import Data.StrMap (lookup)
import Data.String (split, joinWith, Pattern(Pattern))
import Data.Traversable (sequence)
import Data.Tuple (Tuple(Tuple))
import Global (decodeURIComponent)
import Hyper.Conn (Conn)
import Hyper.Middleware (Middleware)
import Hyper.Middleware.Class (getConn)
import Hyper.Request (class Request, class ReadableBody, getRequestData, readBody)
newtype Form = Form (Array (Tuple String (Maybe String)))
derive instance newtypeForm :: Newtype Form _
derive instance genericForm :: Generic Form
derive newtype instance eqForm :: Eq Form
derive newtype instance ordForm :: Ord Form
derive newtype instance showForm :: Show Form
derive newtype instance monoidForm :: Monoid Form
optional :: String -> Form -> Maybe String
optional key = do
unwrap
>>> Tuple.lookup key
>>> flip bind id
required :: String -> Form -> Either String String
required key =
optional key
>>> maybe (throwError ("Missing field: " <> key)) pure
parseContentMediaType :: String -> Maybe MediaType
parseContentMediaType = split (Pattern ";")
>>> head
>>> map MediaType
toTuple :: Array String -> Either String (Tuple String (Maybe String))
toTuple kv =
case kv of
[key] ->
pure (Tuple (decodeURIComponent key) Nothing)
[key, value] ->
pure (Tuple (decodeURIComponent key) (Just (decodeURIComponent value)))
parts ->
throwError ("Invalid form key-value pair: " <> joinWith " " parts)
splitPairs :: String → Either String (Array (Tuple String (Maybe String)))
splitPairs = split (Pattern "&")
>>> map (split (Pattern "="))
>>> map toTuple
>>> sequence
parseForm ∷ forall m req res c
. Monad m
=> Request req m
=> ReadableBody req m String
=> Middleware
m
(Conn req res c)
(Conn req res c)
(Either String Form)
parseForm = do
conn <- getConn
{ headers } <- getRequestData
body <- readBody
case lookup "content-type" headers >>= parseContentMediaType of
Nothing ->
ipure (Left "Missing or invalid content-type header.")
Just mediaType | mediaType == applicationFormURLEncoded ->
ipure (Form <$> splitPairs body)
Just mediaType ->
ipure (Left ("Cannot parse media of type: " <> show mediaType))
where bind = ibind
class ToForm a where
toForm ∷ a → Form
class FromForm a where
fromForm ∷ Form → Either String a
parseFromForm ∷ forall m req res c a
. Monad m
=> Request req m
=> ReadableBody req m String
=> FromForm a
=> Middleware
m
(Conn req res c)
(Conn req res c)
(Either String a)
parseFromForm =
parseForm :>>=
case _ of
Left err -> ipure (Left err)
Right form -> ipure (fromForm form)