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