librandomorg (empty) → 0.0.1.0

raw patch · 4 files changed

+148/−0 lines, 4 filesdep +basedep +bytestringdep +curlsetup-changed

Dependencies added: base, bytestring, curl

Files

• LICENSE +19/−0
• Setup.hs +2/−0
• librandomorg.cabal +19/−0
• src/Network/Randomorg.hs +108/−0

@@ -0,0 +1,19 @@+Copyright (C) 2012 Matvey Aksenov++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

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

@@ -0,0 +1,19 @@+name:                librandomorg+version:             0.0.1.0+synopsis:            Wrapper to Random.org API+description:         Simple but complete wrapper to Random.org API+homepage:            https://github.com/supki/haskell-random.org+license:             MIT+license-file:        LICENSE+author:              Matvey Aksenov+maintainer:          matvey.aksenov@gmail.com+category:            Network APIs+build-type:          Simple+cabal-version:       >=1.8++library+  build-depends:       base >= 3 && < 5, curl == 1.3.7, bytestring == 0.9.*+  hs-source-dirs:      src+  exposed-modules:     Network.Randomorg+  GHC-options:         -Wall+                       -fno-warn-unused-do-bind

@@ -0,0 +1,108 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE ViewPatterns #-}+-- | Random.org API module+{-# OPTIONS_HADDOCK prune #-}+module Network.Randomorg+  ( RNG(..)+  , integers, shuffle, strings, quota+  ) where++import Control.Applicative ((<$>))+import Data.ByteString.Char8 (ByteString, readInteger, readInt)+import Data.List (intercalate)+import Data.Maybe (fromMaybe)+import Data.Word (Word8)+import Network.Curl+import Prelude hiding (max, min)+import qualified Data.ByteString.Char8 as B++-- | Specify the randomization method+data RNG = New -- ^ Truly random bitstream+         | Id String -- ^ Determine randomization from a large pool of pregenerated bits+         | Date String -- ^ Determine randomization based on one of the daily pregenerated files. The date must be in YYYY-MM-DD format or one of the two shorthand strings `today' or `yesterday'.++class Get α where+  get ∷ α → String+  getF ∷ (Functor μ, Get α) ⇒ μ α → μ String+  getF = fmap get++instance Get Int where+  get = show+instance Get Bool where+  get True = "on"+  get False = "off"+instance Get (Word8,Word8,Word8,Word8) where+  get (α,β,γ,δ) = intercalate "." . map show $ [α,β,γ,δ]+instance Get RNG where+  get New = "new"+  get (Id s) = "id." ++ s+  get (Date s) = "date." ++ s++-- | Generate random integers in configurable intervals+integers ∷ Int -- ^ Number of integers to generate ([1,1e4])+         → Int -- ^ Minimum value (-1e9,1e9)+         → Int -- ^ Maximum value (-1e9,1e9)+         → RNG+         → IO (Maybe [Int])+integers (get → n)+         (get → min)+         (get → max)+         (get → rng) =+  let url = "http://www.random.org/integers/?col=1&base=10&format=plain&"+      params = zip ["num","min","max","rnd"] [n, min, max, rng]+  in mapM (\l → fst <$> readInt l) . B.lines . respBody <$> query url params++-- | Shuffle integers in given interval+--+-- NOTE: Maintains the invariant `max - min + 1 <= 1e4'+--+-- NOTE: Doesn't maintain the invariant `max >= min'+shuffle ∷ Int -- ^ Minimum value (-1e9,1e9)+        → Int -- ^ Maximum value (-1e9,1e9)+        → RNG+        → IO (Maybe [Int])+shuffle min+        max+        (get → rng)+  | max - min + 1 <= 10000 =+    let url = "http://www.random.org/sequences/?col=1&format=plain&"+        params = zip ["min","max","rnd"] [get min, get max, rng]+    in mapM (\l → fst <$> readInt l) . B.lines . respBody <$> query url params+  | otherwise = return Nothing++-- | Generate random strings of various length and composition+strings ∷ Int -- ^ Number of strings to generate ([1,1e4])+        → Int -- ^ Length of each string ([1,20])+        → Bool -- ^ Allow digits+        → Bool -- ^ Allow uppercase alphabetic characters+        → Bool -- ^ Allow lowercase alphabetic characters+        → Bool -- ^ Whether all string should be unique+        → RNG+        → IO [String]+strings (get → n)+        (get → l)+        (get → digits)+        (get → upper)+        (get → lower)+        (get → unique)+        (get → rng) =+  let url = "http://www.random.org/strings/?format=plain&"+      params = zip ["num","len","digits","upperalpha","loweralpha","unique","rnd"] [n, l, digits, upper, lower, unique, rng]+  in map B.unpack . B.lines . respBody <$> query url params++-- | Examine quota for given IP address+quota ∷ Maybe (Word8, Word8, Word8, Word8)-- ^ Optional IP address. If not provided use IP of the caller+      → IO (Maybe Integer)+quota (getF → ip) =+  let url = "http://www.random.org/quota/?format=plain&"+      params = zip ["ip"] [fromMaybe "" ip]+  in (fst <$>) . readInteger . respBody <$> query url params++query ∷ String → [(String,String)] → IO (CurlResponse_ [(String, String)] ByteString)+query url (filter (not . null . snd) → params) =+  let ua = "Mozilla/5.0 (X11; Linux x86_64; rv:10.0) Gecko/20100101 Firefox/10.0 Iceweasel/10.0"+  in withCurlDo $ curlGetResponse_ (url ++ intercalate "&" (map (\(k,v) → k ++ "=" ++ v) params))+       [ CurlFailOnError False+       , CurlUserAgent ua+       ]