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:          example@example.com
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\$
  • \$\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 '17 at 9:29
  • \$\begingroup\$ @Zeta Added cabal and stack files \$\endgroup\$ – BlackCap Feb 15 '17 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 '17 at 10:24

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.