Factor out some new libraries

	word64-map:
		Data.Word64Map
	network-addr:
		Network.Address
	tox-crypto:
		Crypto.Tox
	lifted-concurrent:
		Control.Concurrent.Lifted.Instrument
		Control.Concurrent.Async.Lifted.Instrument
	psq-wrap:
		Data.Wrapper.PSQInt
		Data.Wrapper.PSQ
	minmax-psq:
		Data.MinMaxPSQ
        tasks:
                Control.Concurrent.Tasks
	kad:
		Network.Kademlia
		Network.Kademlia.Bootstrap
		Network.Kademlia.Routing
		Network.Kademlia.CommonAPI
		Network.Kademlia.Persistence
		Network.Kademlia.Search

1 files changed, 335 insertions, 0 deletions

diff --git a/dht/WifiHeader.hs b/dht/WifiHeader.hs
new file mode 100644
index 00000000..90e77003
--- /dev/null
+++ b/dht/WifiHeader.hs
@@ -0,0 +1,335 @@
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PatternSynonyms            #-}
+module WifiHeader where
+
+import Data.Bits
+import Data.Word
+
+import Net.Ethernet as Mac (Addr(..))
+import Net.Packet
+import Net.PacketParsing
+
+import LLCSNAP
+
+-- 802.11 Mac header
+--
+-- 23 bytes
+
+-- Wikipedia:
+--
+-- Frames are divided into very specific and standardized sections. Each frame
+-- consists of a MAC header, payload, and frame check sequence (FCS).
+--
+-- Data frames carry packets from web pages, files, etc. within the body.[51]
+-- The body begins with an IEEE 802.2 header, with the Destination Service
+-- Access Point (DSAP) specifying the protocol; however, if the DSAP is hex AA,
+-- the 802.2 header is followed by a Subnetwork Access Protocol (SNAP) header,
+-- with the Organizationally Unique Identifier (OUI) and protocol ID (PID)
+-- fields specifying the protocol. If the OUI is all zeroes, the protocol ID
+-- field is an EtherType value.[52] Almost all 802.11 data frames use 802.2 and
+-- SNAP headers, and most use an OUI of 00:00:00 and an EtherType value.
+--
+-- [51] http://www.wi-fiplanet.com/tutorials/article.php/1447501
+
+-- The first two bytes of the MAC header form a frame control field...
+--
+-- The next two bytes are reserved for the Duration ID field
+--
+-- An 802.11 frame can have up to four address fields. Each field can carry a
+-- MAC address.  The first 4 bits are used for the fragmentation number, and
+-- the last 12 bits are the sequence number.
+--
+-- The Sequence Control field is a two-byte section used for identifying
+-- message order as well as eliminating duplicate frames.
+--
+-- An optional two-byte Quality of Service control field that was added with
+-- 802.11e.
+--
+-- The payload or frame body field is variable in size, from 0 to 2304 bytes
+-- plus any overhead from security encapsulation, and contains information from
+-- higher layers
+--
+-- The Frame Check Sequence (FCS) is the last four bytes in the standard 802.11
+-- frame. Often referred to as the Cyclic Redundancy Check (CRC), it allows for
+-- integrity check of retrieved frames.
+
+-- 2 bits
+data Type = Management
+          | Control
+          | Data
+          | Reserved
+ deriving (Eq,Ord,Enum,Read,Show)
+
+-- 4 bits
+data SubType = AssociationRequest
+             | SubType1
+             | SubType2
+             | SubType3
+             | ProbeRequest
+             | SubType5
+             | SubType6
+             | SubType7
+
+             -- Any of the following used with type 'Data' means the optional
+             -- QoS field is present.
+             | Beacon
+             | SubType9
+             | Disassociation
+             | SubTypeB
+             | SubTypeC
+             | SubTypeD
+             | SubTypeE
+             | SubTypeF
+ deriving (Eq,Ord,Enum,Read,Show)
+
+-- Byte 0 (Frame Control Field 1)
+wifiTypeBits :: Word8 -> Maybe (Type,SubType)
+wifiTypeBits b
+    | version/=0 = Nothing
+    | otherwise  = Just (typ,subtyp)
+ where
+    version = b .&. 0x03
+    typ     = toEnum $ fromIntegral $ 0x03 .&. shiftR b 2
+    subtyp  = toEnum $ fromIntegral $ 0x0F .&. shiftR b 4
+
+
+
+-- Byte 1 (Frame Control Field 2)
+newtype Flags = Flags Word8
+ deriving (Eq,Ord,Bits,Read,Show)
+
+pattern ToDS            = Flags 0x01
+pattern FromDS          = Flags 0x02
+pattern MoreFragments   = Flags 0x04
+pattern Retry           = Flags 0x08
+pattern PowerManagement = Flags 0x10
+pattern MoreData        = Flags 0x20
+pattern Protected       = Flags 0x40
+pattern Order           = Flags 0x80
+
+flagNames :: [(Flags, String)]
+flagNames =
+    [( ToDS, "ToDS" )
+    ,( FromDS, "FromDS" )
+    ,( MoreFragments, "MoreFragments" )
+    ,( Retry, "Retry" )
+    ,( PowerManagement, "PowerManagement" )
+    ,( MoreData, "MoreData" )
+    ,( Protected, "Protected" )
+    ,( Order, "Order" )]
+
+-- Bytes 2,3
+-- Duration/ID field
+--
+-- This field is of size 16 bits. It carries following fields.
+--
+-- •  In control type frames of subtype Power Save (PS)-Poll, the Duration/ID
+-- field carries the association identity (AID) of the station that transmitted
+-- the frame in the 14 least significant bits (LSB), with the 2 most
+-- significant bits (MSB) both set to 1. AID value varies between values from 1
+-- to 2007.
+--
+-- •  In all the other frames, this field contains duration value as specified
+-- for each of the frame. For all the frames transmitted during the CFP
+-- (contention free time period) this field is set to 32,768. If the content of
+-- this field is less than 32768, it is used to update NAV (Network Allocation
+-- Vector).
+newtype DurationID = DurationID Word16
+ deriving (Eq,Ord,Read,Show)
+
+instance Parse DurationID where parse = DurationID <$> parse -- (big endian)
+
+
+
+-- Bytes 4-(21/27) (+18 or +24 bytes long)
+--
+-- Wikipedia claimed: Address 1 is the receiver, Address 2 is the transmitter,
+-- Address 3 is used for filtering purposes by the receiver.[dubious – discuss]
+--
+-- But http://www.rfwireless-world.com/Articles/WLAN-MAC-layer-protocol.html
+-- says:
+--
+-- ToDS   FromDS   addr1   addr2   addr3   addr4
+-- ----   ------   -----   -----   -----   -----
+-- 0      0        DA      SA      BSSID   -
+-- 0      1        DA      BSSID   SA      -
+-- 1      0        BSSID   SA      DA      -
+-- 1      1        RA      TA      DA      SA
+--
+-- DataFrames:
+--
+-- http://www.rfwireless-world.com/images/WLAN-MAC-Data-Frame.jpg
+--
+-- Note 1: The address-1 always holds the RA(Receiver Address) of the intended
+-- receiver or receivers(e.g. in multicast operation). Note 2 : The address-2
+-- always holds the address of STA which is transmitting the MAC frame.
+
+data Addresses = Addresses
+    { bssid   :: Maybe Mac.Addr -- BSSID
+    , srcAddr :: Mac.Addr       -- SA
+    , dstAddr :: Mac.Addr       -- DA
+    , txAddr  :: Maybe Mac.Addr -- TA
+    , rxAddr  :: Maybe Mac.Addr -- RA
+    }
+ deriving (Eq,Ord,Show)
+
+parseAddresses :: Flags -> PacketParser Addresses
+parseAddresses fc = case fc .&. (ToDS .|. FromDS) of
+    Flags 0 -> do
+        -- 0      0        DA      SA      BSSID   -
+        _da    <- parse
+        _sa    <- parse
+        _bssid <- parse
+        return Addresses
+            { bssid   = Just _bssid
+            , srcAddr = _sa
+            , dstAddr = _da
+            , txAddr  = Nothing
+            , rxAddr  = Nothing
+            }
+    FromDS -> do
+        -- 0      1        DA      BSSID   SA      -
+        _da    <- parse
+        _bssid <- parse
+        _sa    <- parse
+        return Addresses
+            { bssid   = Just _bssid
+            , srcAddr = _sa
+            , dstAddr = _da
+            , txAddr  = Nothing
+            , rxAddr  = Nothing
+            }
+    ToDS -> do
+        -- 1      0        BSSID   SA      DA      -
+        _bssid <- parse
+        _sa    <- parse
+        _da    <- parse
+        return Addresses
+            { bssid   = Just _bssid
+            , srcAddr = _sa
+            , dstAddr = _da
+            , txAddr  = Nothing
+            , rxAddr  = Nothing
+            }
+    Flags 0x03 -> do
+        -- 1      1        RA      TA      DA      SA
+        _ra    <- parse
+        _ta    <- parse
+        _da    <- parse
+        -- http://www.rfwireless-world.com/Articles/WLAN-MAC-layer-protocol-p2.html
+        -- indicates that there is a SequenceControl field here.
+        _sa    <- parse
+        return Addresses
+            { bssid   = Nothing
+            , srcAddr = _sa
+            , dstAddr = _da
+            , txAddr  = Just _ta
+            , rxAddr  = Just _ra
+            }
+
+-- Bytes 22/28-23/29 (2 bytes)
+--
+-- The Sequence Control field.
+--
+-- A two-byte section used for identifying message order as well as eliminating
+-- duplicate frames. The first 4 bits are used for the fragmentation number,
+-- and the last 12 bits are the sequence number.
+newtype SequenceControl = SequenceControl Word16
+ deriving (Eq,Ord,Read,Show)
+
+instance Parse SequenceControl where parse = SequenceControl <$> parse -- (big endian)
+
+-- Optional: Bytes 24/30 - 25/31
+--
+-- An optional two-byte Quality of Service control field that was added with 802.11e.
+newtype QoS = QoS Word16
+ deriving (Eq,Ord,Read,Show)
+
+-- Bytes 24/30 (802.11e maybe 26/32) - ? variable length
+--
+-- Frame Body
+
+-- Last 4 bytes.
+--
+-- FCS
+--
+--  Wikipedia cites https://wayback.archive.org/web/20090124151617/http://wifi.cs.st-andrews.ac.uk/wififrame.html
+--
+--  From http://www.rfwireless-world.com/Articles/WLAN-MAC-layer-protocol.html
+--
+--  The WLAN FCS field is a 32-bit field containing a 32-bit CRC. The FCS is
+--  calculated over all the fields of the MAC header and the Frame Body field.
+--  These are referred to as the calculation fields.
+--
+--  The FCS is calculated using the following standard generator polynomial of
+--  degree 32: G(x) = x³² + x²⁶ + x²³ + x²² + x¹⁶ + x¹² + x¹¹ + x¹⁰ + x⁸ + x⁷ +
+--  x⁵ + x⁴ + x² + x + 1
+--
+--  The FCS is the 1's complement of the sum (modulo 2) of the following:
+--
+--  •  The remainder of xk * (x³¹+x³⁰+x²⁹+...+x² + x + 1) divided (modulo 2) by
+--  G(x), where k is the number of bits in the calculation fields.
+--
+--  •  The remainder after multiplication of the contents (treated as a
+--  polynomial) of the calculation fields by x³² and then division by G(x)
+newtype FCS = FCS Word32
+ deriving (Eq,Ord,Read,Show)
+
+data Packet a = Packet
+    { wifiType        :: Type
+    , subtype         :: SubType
+    , flags           :: Flags
+    , duration        :: DurationID
+    , addresses       :: Addresses
+    , sequenceControl :: SequenceControl
+    , qos             :: Maybe QoS
+    , llcsnap         :: Maybe LLCSNAP
+    , content         :: a
+    , fcs             :: Maybe FCS
+    }
+ deriving (Eq,Ord,Show)
+
+-- Hardcoded flag to disable parsing FCS checksum.
+hasFCS :: Bool
+hasFCS = False -- DLT_IEEE802_11 has no trailing 4-byte FCS checksum
+               --
+               -- Other link types might include this:
+               -- See: DLT_IEEE802_11_RADIO
+               --   or DLT_IEEE802_11_RADIO_AVS
+
+instance Parse (Packet InPacket) where
+    parse = do
+        Just (typ,subtyp) <- wifiTypeBits <$> word8
+        flgs <- Flags <$> word8
+        durid <- DurationID <$> word16
+        addrs <- parseAddresses flgs
+        sc <- SequenceControl <$> word16 -- TODO: Sometimes this precedes the 4th address.
+        qos <- if typ == Data && subtyp > SubType7
+                then Just . QoS <$> parse
+                else return Nothing
+        llcsnap <- case typ of
+            Data -> Just <$> parse
+            _    -> return Nothing
+        rst <- therest
+        let (payload,fcs) = if hasFCS
+                then
+                    let payload = takeInPack (len rst - 4) rst
+                        fcshi = rst `wordAt` (len rst - 4)
+                        fcslo = rst `wordAt` (len rst - 2)
+                        fcs = FCS $ fromIntegral fcshi * 65536
+                                  + fromIntegral fcslo
+                    in (payload,Just fcs)
+                else (rst,Nothing)
+        return Packet
+            { wifiType        = typ
+            , subtype         = subtyp
+            , flags           = flgs
+            , duration        = durid
+            , addresses       = addrs
+            , sequenceControl = sc
+            , qos             = qos
+            , llcsnap         = llcsnap
+            , content         = payload
+            , fcs             = fcs
+            }