git.iko.soy/lynxjs-elm/compiler
on master help sign in
add CORS to Quotes.endpoint
1455e11Evan Czaplicki
worker/src/Cors.hs+13−5
compare with master
unifiedsplit
@@ -1,6 +1,7 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Cors
2module Cors
3 ( allow
3 ( allow
4+ , open
4 )
5 )
5 where
6 where
6
7
@@ -8,7 +9,7 @@ module Cors
8import qualified Data.HashSet as HashSet
9import qualified Data.HashSet as HashSet
9import Network.URI (parseURI)
10import Network.URI (parseURI)
10import Snap.Core (Snap, Method, method)
11import Snap.Core (Snap, Method, method)
11−import Snap.Util.CORS (CORSOptions(..), HashableMethod(..), OriginList(Origins), applyCORS, mkOriginSet)
12+import Snap.Util.CORS (CORSOptions(..), HashableMethod(..), OriginList(..), applyCORS, mkOriginSet)
12
13
13
14
14
15
@@ -17,7 +18,15 @@ import Snap.Util.CORS (CORSOptions(..), HashableMethod(..), OriginList(Origins),
17
18
18allow :: Method -> [String] -> Snap () -> Snap ()
19allow :: Method -> [String] -> Snap () -> Snap ()
19allow method_ origins snap =
20allow method_ origins snap =
20− applyCORS (toOptions method_ origins) $ method method_ $
21+ applyCORS (toOptions method_ (toOriginList origins)) $
22+ method method_ $
23+ snap
24+
25+
26+open :: Method -> Snap () -> Snap ()
27+open method_ snap =
28+ applyCORS (toOptions method_ Everywhere) $
29+ method method_ $
21 snap
30 snap
22
31
23
32
@@ -25,10 +34,9 @@ allow method_ origins snap =
25-- TO OPTIONS
34-- TO OPTIONS
26
35
27
36
28−toOptions :: (Monad m) => Method -> [String] -> CORSOptions m
37+toOptions :: (Monad m) => Method -> OriginList -> CORSOptions m
29−toOptions method_ origins =
38+toOptions method_ allowedOrigins =
30 let
39 let
31− allowedOrigins = toOriginList origins
32 allowedMethods = HashSet.singleton (HashableMethod method_)
40 allowedMethods = HashSet.singleton (HashableMethod method_)
33 in
41 in
34 CORSOptions
42 CORSOptions
worker/src/Endpoint/Quotes.hs+2
@@ -12,6 +12,7 @@ import GHC.Prim
12import GHC.ST (ST(ST), runST)
12import GHC.ST (ST(ST), runST)
13import qualified System.Random as Random
13import qualified System.Random as Random
14
14
15+import qualified Cors
15import Snap.Core
16import Snap.Core
16
17
17
18
@@ -21,6 +22,7 @@ import Snap.Core
21
22
22endpoint :: Snap ()
23endpoint :: Snap ()
23endpoint =
24endpoint =
25+ Cors.open GET $
24 do modifyResponse $ setContentType "application/json"
26 do modifyResponse $ setContentType "application/json"
25 writeBS =<< liftIO getQuote
27 writeBS =<< liftIO getQuote
26
28