git.iko.soy/lynxjs-elm/compiler
on master help sign in
add CORS to Quotes.endpoint
commit1455e11bd6af54d6538bcf878e9ebcac8464c744 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 5 Apr 2022, 04:25 (5 years ago) parentd36422f
2 files changed+15−5
worker/src/Cors.hs+13−5 worker/src/Endpoint/Quotes.hs+2
worker/src/Cors.hs+13−5
@@ -1,6 +1,7 @@
11{-# OPTIONS_GHC -Wall #-}
22module Cors
33 ( allow
4+ , open
45 )
56 where
67
@@ -8,7 +9,7 @@ module Cors
89import qualified Data.HashSet as HashSet
910import Network.URI (parseURI)
1011import 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)
1213
1314
1415
@@ -17,7 +18,15 @@ import Snap.Util.CORS (CORSOptions(..), HashableMethod(..), OriginList(Origins),
1718
1819allow :: Method -> [String] -> Snap () -> Snap ()
1920allow 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_ $
2130 snap
2231
2332
@@ -25,10 +34,9 @@ allow method_ origins snap =
2534-- TO OPTIONS
2635
2736
28−toOptions :: (Monad m) => Method -> [String] -> CORSOptions m
29−toOptions method_ origins =
37+toOptions :: (Monad m) => Method -> OriginList -> CORSOptions m
38+toOptions method_ allowedOrigins =
3039 let
31− allowedOrigins = toOriginList origins
3240 allowedMethods = HashSet.singleton (HashableMethod method_)
3341 in
3442 CORSOptions
worker/src/Endpoint/Quotes.hs+2
@@ -12,6 +12,7 @@ import GHC.Prim
1212import GHC.ST (ST(ST), runST)
1313import qualified System.Random as Random
1414
15+import qualified Cors
1516import Snap.Core
1617
1718
@@ -21,6 +22,7 @@ import Snap.Core
2122
2223endpoint :: Snap ()
2324endpoint =
25+ Cors.open GET $
2426 do modifyResponse $ setContentType "application/json"
2527 writeBS =<< liftIO getQuote
2628