blank-canvas 0.2.3 → 0.2.3.1

raw patch · 2 files changed

+27/−8 lines, 2 filesdep +http-typesdep +networkdep +waidep ~containersdep ~scottydep ~stm

Dependencies added: http-types, network, wai

Dependency ranges changed: containers, scotty, stm, transformers

Files

• Graphics/Blank.hs +18/−2
• blank-canvas.cabal +9/−6

@@ -25,6 +25,9 @@ import Control.Concurrent import Control.Monad.IO.Class (liftIO) import Network.Wai.Handler.Warp (run)+import Network.Wai (Middleware,remoteHost, responseLBS)+import qualified Network.HTTP.Types as H+import Network.Socket (SockAddr(..)) import Web.Scotty as S --import Network.Wai.Middleware.RequestLogger -- Used when debugging --import Network.Wai.Middleware.Static@@ -82,6 +85,7 @@     app <- scottyApp $ do --        middleware logStdoutDev+        middleware local_only  --        middleware $ staticRoot $ TS.pack $ (dataDir ++ "/static") @@ -95,7 +99,7 @@             text (T.pack $ "session = " ++ show uq ++ ";redraw();")          post "/event/:num" $ do-            header "Cache-Control" "max-age=0, no-cache, private, no-store, must-revalidate"+            addHeader "Cache-Control" "max-age=0, no-cache, private, no-store, must-revalidate"             num <- param "num" --            liftIO $ print (num :: Int)             NamedEvent nm event <- jsonData@@ -111,7 +115,7 @@                                       json ()          get "/canvas/:num" $ do-            header "Cache-Control" "max-age=0, no-cache, private, no-store, must-revalidate"+            addHeader "Cache-Control" "max-age=0, no-cache, private, no-store, must-revalidate"             -- do something and return a new list of commands to the client             num <- param "num" --            liftIO $ print (num :: Int)@@ -163,3 +167,15 @@               return a       send' other                  cmds = send' (Bind other Return) cmds ++local_only :: Middleware+local_only f r = case remoteHost r of+                   SockAddrInet _  h | h == fromIntegral home+                                    -> f r+                   SockAddrUnix _   -> f r+                   _                ->  return $ responseLBS H.status403+                                                             [("Content-Type", "text/plain")]+                                                             "local access only"+ where+        home :: Integer+        home = 127 + (256 * 256 * 256) * 1

@@ -1,5 +1,5 @@ Name:                blank-canvas-Version:             0.2.3+Version:             0.2.3.1 Synopsis:            HTML5 Canvas Graphics Library Description:         A Haskell port of the HTML5 Canvas API.                      blank-canvas works by providing a web service that@@ -9,7 +9,7 @@ License-file:        LICENSE Author:              Andy Gill Maintainer:          andygill@ku.edu-Copyright:           Copyright (c) 2012 The University of Kansas+Copyright:           Copyright (c) 2013 The University of Kansas Homepage:            http://ittc.ku.edu/csdl/fpg/Tools/BlankCanvas Category:            Graphics Build-type:          Simple@@ -42,13 +42,16 @@   default-language:    Haskell2010   build-depends:       base             >= 4.3.1        && < 5,                        aeson            == 0.6.*,-                       containers       >  0.5,-                       scotty           >= 0.4.6,+                       containers       == 0.5.*,+                       scotty           == 0.5.*,+                       wai              == 1.4.*,+                       http-types       == 0.8.*,                        text             == 0.11.*,-                       transformers     >= 0.2.2,+                       network          == 2.4.*,+                       transformers     == 0.3.*,                        wai-extra        == 1.3.*,                        warp             >= 1.3.1        && < 1.4,-                       stm              == 2.2.*+                       stm              >= 2.2		&& < 2.5    GHC-options:  -Wall -fno-warn-orphans