Randomorg.hs

{-# 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
       ]