packages feed

snaplet-tasks (empty) → 0.1

raw patch · 7 files changed

+316/−0 lines, 7 filesdep +MissingHdep +basedep +bytestringsetup-changed

Dependencies added: MissingH, base, bytestring, containers, curl, data-hash, haskell98, mtl, network, snap, snap-core

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Kamil Ciemniewski++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Kamil Ciemniewski nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ snaplet-tasks.cabal view
@@ -0,0 +1,78 @@+-- snaplet-tasks.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                snaplet-tasks++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.1++-- A short (one-line) description of the package.+Synopsis:            Snaplet for Snap Framework enabling developers to administrative tasks akin to Rake tasks from Ruby On Rails framework.++-- A longer description of the package.+-- Description:         ++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Kamil Ciemniewski++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          ciemniewski.kamil@gmail.com++-- A copyright notice.+-- Copyright:           ++Category:            Web++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+cabal-version: >= 1.6++Library+  hs-source-dirs: src++  library+  exposed-modules:  Snap.Snaplet.Tasks,+                    Snap.Snaplet.Tasks.Utils++  other-modules:    Snap.Snaplet.Tasks.Internal,+                    Snap.Snaplet.Tasks.Types+  +  -- Packages needed in order to build this package.+  Build-depends:+    base >= 4 && < 5,+    bytestring >= 0.9.1 && < 0.10,+    network == 2.3.0.2,+    MissingH == 1.1.1.0,+    curl == 1.3.7,+    data-hash == 0.1.0.0,+    snap == 0.7.*,+    snap-core   == 0.7.*,+    mtl >= 2 && < 3,+    containers == 0.4.0.0,+    haskell98 == 1.1.0.1+  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:    +  +  extensions: +      OverloadedStrings+    , FlexibleInstances+    , TypeSynonymInstances+    , MultiParamTypeClasses +              +
+ src/Snap/Snaplet/Tasks.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}+-- | This module contains definition of a Tasks Snaplet for +--   Snap >= 0.7.*. It allows Snap app developers to create command +--   line tasks akin to "rake tasks" found in Ruby On Rails framework.+--   +--   Essenstially, this snaplet let's your other snaplet's to have +--   their administrative tasks that You'd call from command line +--   to - let's say create indexes in Your DB or screen scrape some +--   useful data from some service and save it in DB.+--+--   Every task is in fact just a handler for route. Those routes +--   are hashes for routes so that 'somens:other:cool:task' becomes+--   a valid route in app.+--   To create such task in one of Your snaplets (maybe in your app+--   snaplet) - define route for it using handy 'task' function+--   that this module reexports.+--+--   Running tasks is fairly simple: +--   yourapp T snaplet:super:cool arg1=v1 arg2=v2 [-p 1000]+--   This means that your task command always follows 'T'+--   If you're running Your app at default port You can specify+--   different port at the end by using standard -p argument.++module Snap.Snaplet.Tasks( tasksInit,+                           TasksSnaplet,+                           module Snap.Snaplet.Tasks.Utils ) where++import           Snap.Snaplet+import           Snap.Snaplet.Tasks.Internal+import           Snap.Snaplet.Tasks.Utils++import           Control.Monad.Reader+import           Control.Concurrent++data TasksSnaplet = TasksSnaplet++-- | This method spawns a new thread that waits till+--   server is ready and then fires given task.+tasksInit :: SnapletInit b TasksSnaplet+tasksInit = makeSnaplet "tasks" "Snap Tasks" Nothing $ do+  liftIO $ do+    mtask <- taskFromCommandLine+    case mtask of+      Nothing   -> return ()+      Just task -> (forkIO $ runTask task) >> return ()+  return $ TasksSnaplet
+ src/Snap/Snaplet/Tasks/Internal.hs view
@@ -0,0 +1,111 @@+module Snap.Snaplet.Tasks.Internal where++import           System( getArgs )+import           System.Exit++import           Snap.Snaplet.Tasks.Types++import           Control.Concurrent++import qualified Data.ByteString.Char8 as B+import           Data.List (intercalate)+import qualified Data.Map as Map+import qualified Data.List.Utils as U+import           Data.Hash++import           Network.Curl++-- | This function reads options from command line+--   and if it sees any options after "T" it+--   tries to compile them into task.+taskFromCommandLine :: IO (Maybe Task)+taskFromCommandLine = do+  taskArgs <- return . tail . dropWhile ((/=) "T") =<< getArgs+  case null taskArgs of+    True  -> return Nothing+    False -> return $ Just $ taskForArgs taskArgs+  where+    taskForArgs :: [String] -> Task+    taskForArgs args = Task+      (namespace heading)+      (name      heading)+      (taskargs  restargs)+      portFromArgs+      where+        heading :: [String]+        heading = U.split ":" $ head args++        portFromArgs :: String+        portFromArgs =+          case dropWhile ((/=) "-p") args of+            [] -> "8000"+            xs -> head $ tail xs++        restargs :: [(B.ByteString, B.ByteString)]+        restargs = map toKeyValue $ takeWhile ((/=) "-p") $ tail args+ +        toKeyValue :: String -> (B.ByteString, B.ByteString)+        toKeyValue s = (sp !! 0, sp !! 1)+         where+          sp = map B.pack $ U.split "=" s++        namespace :: [String] -> String+        namespace = head++        name :: [String] -> String+        name = (intercalate "/") . tail++        taskargs :: [(B.ByteString, B.ByteString)] -> Map.Map B.ByteString B.ByteString+        taskargs = Map.fromList++-- | This function lives in different thread than main app thread+--   and for given task it waits until app is ready to serve requests +--   and then it fires request described in that task.+--   +--   For example if you had a task with namespace 'supercool' and+--   name 'task' and params id=1234 number=12345 url=google.com+--   then it'd fire PUT request for url: +--   'localhost:[port]/supercool/task?id=1234&number=12345&url=google.com'+--   If 404 occurs it yells at user that such task does not exist.+--   For task name 'task:cool' url would start like:+--   'localhost/supercool/task/cool?id....' +runTask :: Task -> IO ()+runTask task = waitForApp >> requestTask+  where+    waitForApp = do+      (code, _) <- curlGetString "http://localhost" +                     [CurlPort $ read $ taskPort task]+      case code of+        CurlOK -> return ()+        _      -> threadDelay 100 >> waitForApp++    requestTask = do+      resp <- curlGetResponse taskUrl +                        [CurlPort $ read $ taskPort task]+      case respCurlCode resp of+        CurlOK -> putStrLn   "Task ended successfully"+        _      -> +          case respStatus resp of+            404 -> putStrLn   "No such task in application"+            _   -> putStrLn $ "Task request ended with HTTP code " +++                                (show $ respStatus resp)++    taskUrl :: URLString+    taskUrl = "http://localhost/" ++ (taskNamespace task) +++               "/" ++ nameForTask ++ argsToUrl++    nameForTask :: String+    nameForTask = hashString $ taskName task++    argsToUrl :: String+    argsToUrl = +      case Map.null $ taskArgs task of+        True  -> ""+        False -> "?" ++ (intercalate "&" $ map toArg $ Map.toList $ taskArgs task)+    +    toArg :: (B.ByteString, B.ByteString) -> String+    toArg (k, v) = (B.unpack k) ++ "=" ++ (B.unpack v)++-- | This function takes a string and returns a hash for it+hashString :: String -> String+hashString s = show $ asWord64 $ foldl combine (hashInt $ length s) $ map hash s
+ src/Snap/Snaplet/Tasks/Types.hs view
@@ -0,0 +1,21 @@+module Snap.Snaplet.Tasks.Types where++import           Data.ByteString+import qualified Data.Map as Map++-- | Formalized task given at command line by +--   user. +--   If you'd have "supercool" snaplet that would+--   register one of it's task through "/sometask"+--   route then at command line user would have to +--   run Snap App with: 'snapapp T supercool:sometask'+--   Params for that task would be given at command line+--   like this: 'snapapp T supercool:sometask param1=v1 param2=v2'+--   This means that everything after T at command line is+--   treated as task description.+data Task = Task {+  taskNamespace :: String,+  taskName      :: String,+  taskArgs      :: Map.Map ByteString ByteString,+  taskPort      :: String+} deriving (Show)
+ src/Snap/Snaplet/Tasks/Utils.hs view
@@ -0,0 +1,28 @@+module Snap.Snaplet.Tasks.Utils(task) where++import           Snap.Core+import           Snap.Snaplet+import           Snap.Snaplet.Tasks.Internal++import qualified Data.ByteString.Char8 as B+import qualified Data.List.Utils as U+import           Data.List (intercalate)++-- | Helper function for creating tasks in Snaplets routes+--   that are available through Tasks Snaplet interface+task :: String -> (Handler b v ()) -> (B.ByteString, Handler b v ())+task name handler = (B.pack $ hashString canonizedName, taskify handler)+  where+    canonizedName = intercalate "/" $ U.split ":" name++taskify :: Handler b v () -> Handler b v ()+taskify handler = do+   --now here we *must* check if our apps IP+   --is the same as request's IP and if it is+   --continue or else pass+  setTimeout $ 60*60*24*31 -- approx 31 days+  localIp   <- return . rqLocalAddr  =<< getRequest+  requestIp <- return . rqRemoteAddr =<< getRequest+  case localIp == requestIp of+    True  -> handler+    False -> pass