snowflake-server (empty) → 0.1.0.0

raw patch · 4 files changed

+120/−0 lines, 4 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, mtl, random, snap-core, snap-server, snowflake-core

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• snowflake-server.cabal +32/−0
• src/Main.hs +56/−0

@@ -0,0 +1,30 @@+Copyright KaiJia (c) 2016++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 KaiJia 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,32 @@+Name:                snowflake-server+Version:             0.1.0.0+Synopsis:            snowflake http server+Description:         Please see README.md+License:             BSD3+license-file:        LICENSE+Author:              KaiJia+Maintainer:          jiakai0419@gmail.com+Category:            commercial+Build-type:          Simple+Cabal-version:       >=1.2++Executable snowflake-server+  hs-source-dirs: src+  main-is: Main.hs++  Build-depends:+    base                      >= 4     && < 5,+    bytestring                >= 0.9.1 && < 0.11,+    --MonadCatchIO-transformers >= 0.2.1 && < 0.4,+    mtl                       >= 2     && < 3,+    snap-core                 >= 1.0.0,+    snap-server               >= 1.0.0,+    snowflake-core            >= 0.1.0,+    containers,+    random++  if impl(ghc >= 6.12.0)+    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2+                 -fno-warn-unused-do-bind+  else+    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2

@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Main where+++import           Control.Applicative+import           Snap.Core+import           Snap.Util.FileServe+import           Snap.Http.Server+import           Snowflake+import qualified Data.ByteString.Char8 as B8+import           Data.Monoid+import qualified Data.Map as Map+import           Data.Maybe (fromJust)+import           Data.Int (Int64)+import           System.Random (random, newStdGen)+import           Control.Monad.Trans (liftIO)+import           Control.Concurrent.MVar (MVar, newMVar, putMVar, takeMVar, readMVar)+++type Pool = Map.Map Int64 (MVar IdWorker)++_N = 2^(_workerIdBits defaultConf)++initPool :: IO Pool+initPool = Map.fromList . zip workerIds <$> mapM (\x -> newMVar $ IdWorker 0 x 0 0 defaultConf) workerIds+  where workerIds = [0.._N-1]++takeIdWorker :: Pool -> Int64 -> IO IdWorker+takeIdWorker pool idx = takeMVar . fromJust . Map.lookup idx $ pool++putIdWorker :: Pool -> Int64 -> IdWorker -> IO ()+putIdWorker pool idx worker = let mwk = fromJust . Map.lookup idx $ pool in putMVar mwk worker++dispatchAndGen :: Pool -> Int -> IO [Int64]+dispatchAndGen pool n = do+  seed <- ((`mod` _N) . abs . fst . random) <$> newStdGen+  worker <- takeIdWorker pool seed+  (ids, newWorker) <- nexts worker n+  putIdWorker pool seed newWorker+  return ids++main :: IO ()+main = do+  pool <- initPool+  quickHttpServe $ site pool++site :: Pool -> Snap ()+site pool = ifTop (writeBS "Hello Snowflake") <|> route [ ("get", getHandler pool) ]++getHandler :: Pool -> Snap ()+getHandler pool = do+  n <- (fst . fromJust . B8.readInt . head . fromJust . Map.lookup "n" . rqParams) <$> getRequest+  ids <- liftIO $ dispatchAndGen pool n+  writeBS . B8.pack . show $ ids+