3
\$\begingroup\$

I have tried to generalize the concept of turning an IP address into a boolean.

The save format is an overly complicated way of storing consecutive IP addresses as strings of bits


Example usage:

fetchMany (Brute 2 $ Timeout second http) [read "127.0.0.0" .. read "127.0.1.0"]


Occy/Source.hs

-- Represents a way of turning ip
-- addresses into booleans
--
-- By default, fetchMany will do
-- all the requests in parallel
-- use Seq to prevent this

module Occy.Source where

import qualified Control.Monad.Parallel as P
import qualified Data.Bitstream         as BS
import Data.IP


type Data  = BS.Bitstream BS.Right
type Table = [(IPv4, Bool)]

class Source f where
  fetchOne  :: f ->  IPv4  -> IO  Bool
  fetchMany :: f -> [IPv4] -> IO [Bool]
  fetchOne  f = fmap head . fetchMany f . return
  fetchMany f = P.mapM $ fetchOne f

Occy/Source/Port.hs

-- Attempts to connect to some port
--
-- This might hang forever. Use
-- Timeout to prevent this

module Occy.Source.Port where

import Network
import Control.Exception
import System.IO
import Data.IP

import Occy.Source


newtype Port = Port PortNumber deriving Show

instance Source Port where
  fetchOne (Port p) ip =
    catch (connectTo (show ip) (PortNumber p) >>= hClose >> return True)
       $ \(SomeException _) -> return False


http = Port 80

Occy/Source/Timeout.hs

-- Evaluate a request to false
-- if it doesn't return within
-- some time limit

module Occy.Source.Timeout
  ( Timeout (..)
  , second, ms
  ) where

import System.Timeout
import Occy.Source


data Timeout f = Timeout Int f

instance Source f => Source (Timeout f) where
  fetchOne (Timeout n f) ip = do
    x <- timeout n $ fetchOne f ip

    case x of Just b -> return b
              _      -> return False


second = 10^6 :: Int
ms     = 10^3 :: Int

Occy/Source/Seq.hs

-- Limits a source to do N
-- requests at a time

module Occy.Source.Seq
  ( Seq (..)
  ) where

import Data.List.Split
import Control.Monad

import Occy.Source


data Seq f = Seq Int f

instance Source f => Source (Seq f) where
  fetchMany (Seq s f) = fmap join . mapM (fetchMany f) . chunksOf s

Occy/Source/Static.hs

-- Return values from a table,
-- or get it some other way

module Occy.Source.Static
  ( Static (..)
  , static
  ) where

import qualified Data.Map as M
import Data.IP

import Occy.Source


data Static f = Static (M.Map IPv4 Bool) f

instance Source f => Source (Static f) where
  fetchOne (Static t f) ip
    | Just x <- M.lookup ip t = return x
    | otherwise               = fetchOne f ip

static l = Static $ M.fromList l

Occy/Source/Brute.hs

-- Bruteforces request.
-- It will repeatedly send requests to
-- any IPs that returns false up
-- to N times

module Occy.Source.Brute
  ( Brute (..)
  ) where

import qualified Data.Map as M

import Occy.Source
import Occy.Source.Static


data Brute f = Brute Int f

instance Source f => Source (Brute f) where
  fetchMany (Brute n f) ips = do
    xs <- fetchMany f ips

    if n > 1
       then fetchMany (static (filter snd $ zip ips xs) $ Brute (n-1) f) ips
       else return xs

Occy/Source/Cache.hs

-- Caches replies so that they are
-- not requested twice

module Occy.Source.Cache
  ( Cache (..)
  , cache, cache'
  ) where

import qualified Data.Cache as C
import Data.IP
import Data.Hashable
import Control.Monad

import Occy.Source


data Cache f = Cache f (C.Cache IPv4 Bool)

instance Source f => Source (Cache f) where
  fetchOne (Cache f c) ip = do
    x <- C.lookup c ip

    case x of Just v  -> return v
              Nothing -> do
                v <- fetchOne f ip
                C.insert c ip v
                return v

instance Hashable IPv4 where
  hash = fromIntegral . toHostAddress
  hashWithSalt x = (+x) . hash


cache :: Source f => f -> IO (Cache f)
cache = cache' []

cache' :: Source f => Table -> f -> IO (Cache f)
cache' t f = do
  c <- C.newCache Nothing
  forM_ t . uncurry $ C.insert c
  return  $ Cache f c

Occy/Source/Identity.hs

-- The identity source

module Occy.Source.Identity
  ( Identity (..)
  , false
  ) where

import Occy.Source


newtype Identity = Identity Bool

instance Source Identity where
  fetchOne (Identity x) _ = return x


false = Identity False

Occy/Source/Disk.hs

-- Read / write to disk

module Occy.Source.Disk
  ( Disk
  , loadFile
  , disk, save
  ) where


import qualified Data.Bitstream as BS
import Data.List hiding (groupBy)
import Data.List.HT
import System.Directory
import Data.IP
import GHC.Word

import Occy.Source
import Occy.Source.Static


type Disk = Static

disk :: Source f => FilePath -> f -> IO (Disk f)
disk pth f = flip static f <$> loadFile pth

save :: FilePath -> Table -> IO ()
save pth = BS.writeFile pth . BS.concat . map writeBlock . blocks



loadFile :: FilePath -> IO Table
loadFile pth = do
  x <- doesFileExist pth
  if not x
    then return []
    else do
      src <- BS.readFile pth
      return . concatMap fst
             . takeWhile (not . BS.null . snd)
             $ iterate (readBlock.snd) ([], src)

readBlock :: Data -> (Table, Data)
readBlock bs | a <- BS.toBits $ BS.take 32 bs
             , b <- BS.toBits . BS.take 32 $ BS.drop 32 bs
             = ( take b
               . zip [fromHostAddress a ..]
               . BS.unpack . BS.take b $ BS.drop 64 bs
               , BS.drop (b+64) bs )


blocks :: Table -> [(IPv4, [Bool])]
blocks t = merge
         . map (\(x:xs) -> (fst x, snd x : map snd xs))
         . groupBy (\(a,_) (b,_) -> succ a == b)
         $ sortOn fst t

merge :: [(IPv4, [Bool])] -> [(IPv4, [Bool])]
merge = map (foldl1 $ \(a,ax) (b,bx) ->
                let (ah,at) = splitAt (fromIntegral $ toHostAddress b - toHostAddress a) ax
                    (bh,bt) = splitAt (length at) bx
                    ct      = drop    (length bt) at
                in ( a, ah
                     ++ zipWith (||) at bx
                     ++ if length at > length bh
                        then ct
                        else bt
                   )
            )
      . groupBy (\(a,xa) (b,xb) -> toHostAddress a + fromIntegral (length xa) >= toHostAddress b)

writeBlock :: (IPv4, [Bool]) -> Data
writeBlock (s, bs) =
  BS.concat [ BS.fromBits $ toHostAddress s
            , BS.fromBits (fromIntegral $ length bs :: Word32)
            , BS.pack bs ]

occy.cabal

name:                occy
version:             0.1.0.0
-- synopsis:
-- description:
homepage:            https://github.com/githubuser/occy#readme
license:             BSD3
license-file:        LICENSE
author:              Author name here
maintainer:          [email protected]
copyright:           2017 Author name here
category:            Web
build-type:          Simple
-- extra-source-files:  README.md
cabal-version:       >=1.10

library
  hs-source-dirs:      src
  exposed-modules:     Occy.Source, Occy.Source.Port
                     , Occy.Source.Seq, Occy.Source.Cache
                     , Occy.Source.Brute, Occy.Source.Timeout
                     , Occy.Source.Static, Occy.Source.Disk
                     , Occy.Source.Identity

  build-depends:       base >= 4.7 && < 5
                     , iproute
                     , bitstream
                     , directory
                     , bitwise
                     , mtl
                     , monad-loops
                     , utility-ht
                     , network
                     , monad-parallel
                     , cache
                     , hashable
                     , split
                     , containers
  default-language:    Haskell2010

source-repository head
  type:     git
  location: https://github.com/githubuser/occy

stack.yaml

flags: {}
extra-package-dbs: []
packages:
- '.'
extra-deps:
- appar-0.1.4
- base-unicode-symbols-0.2.2.4
- bitstream-0.2.0.4
- bitwise-0.1.1.1
- byteorder-1.0.4
- cache-0.1.0.0
- clock-0.7.2
- hashable-1.2.5.0
- iproute-1.7.1
- monad-loops-0.4.3
- monad-parallel-0.7.2.2
- mtl-2.2.1
- network-2.6.3.1
- parallel-3.2.1.0
- primitive-0.6.1.0
- split-0.2.3.1
- stm-2.4.4.1
- text-1.2.2.1
- transformers-compat-0.5.1.4
- unordered-containers-0.2.7.2
- utility-ht-0.0.12
- vector-0.10.12.3
resolver: ghc-7.10.2
\$\endgroup\$
3
  • \$\begingroup\$ This question is still missing the accompanying .cabal file. Where does Data.List.HT, Data.IP and Data.Bitstream come from? \$\endgroup\$
    – Zeta
    Feb 15, 2017 at 9:29
  • \$\begingroup\$ @Zeta Added cabal and stack files \$\endgroup\$
    – BlackCap
    Feb 15, 2017 at 10:17
  • \$\begingroup\$ Unfortunately, I don't have time for a full review, but here's an immediate critic item: no documentation of functions, types, modules or classes. One can "follow the types", but only so much. See the Haddock user guide for information about the haddock syntax. \$\endgroup\$
    – Zeta
    Feb 15, 2017 at 10:24

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.